-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
+with System.OS_Lib; use System.OS_Lib;
with Hostparm;
-with Makeutl; use Makeutl;
-with Output; use Output;
-with Osint; use Osint;
+with Makeutl; use Makeutl;
+with Opt;
+with Osint; use Osint;
+with Prj.Tree; use Prj.Tree;
with Sdefault;
-with Table;
-
-with GNAT.HTable;
package body Prj.Ext is
- Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
- -- Name of alternate env. variable that contain path name(s) of directories
- -- where project files may reside. GPR_PROJECT_PATH has precedence over
- -- ADA_PROJECT_PATH.
-
- Gpr_Prj_Path : constant String_Access := Getenv (Gpr_Project_Path);
- Ada_Prj_Path : constant String_Access := Getenv (Ada_Project_Path);
- -- The path name(s) of directories where project files may reside.
- -- May be empty.
-
No_Project_Default_Dir : constant String := "-";
+ -- Indicator in the project path to indicate that the default search
+ -- directories should not be added to the path
- Current_Project_Path : String_Access;
- -- The project path. Initialized by procedure Initialize_Project_Path
- -- below.
+ Uninitialized_Prefix : constant String := '#' & Path_Separator;
+ -- Prefix to indicate that the project path has not been initilized yet.
+ -- Must be two characters long
- procedure Initialize_Project_Path;
+ procedure Initialize_Project_Path (Tree : Prj.Tree.Project_Node_Tree_Ref);
-- Initialize Current_Project_Path
- package Htable is new GNAT.HTable.Simple_HTable
- (Header_Num => Header_Num,
- Element => Name_Id,
- No_Element => No_Name,
- Key => Name_Id,
- Hash => Hash,
- Equal => "=");
- -- External references are stored in this hash table, either by procedure
- -- Add (directly or through a call to function Check) or by function
- -- Value_Of when an environment variable is found non empty. Value_Of
- -- first for external reference in this table, before checking the
- -- environment. Htable is emptied (reset) by procedure Reset.
-
---------
- package Search_Directories is new Table.Table
- (Table_Component_Type => Name_Id,
- Table_Index_Type => Natural,
- Table_Low_Bound => 1,
- Table_Initial => 4,
- Table_Increment => 100,
- Table_Name => "Prj.Ext.Search_Directories");
- -- The table for the directories specified with -aP switches
-
-- Add --
---------
procedure Add
- (External_Name : String;
+ (Tree : Prj.Tree.Project_Node_Tree_Ref;
+ External_Name : String;
Value : String)
is
The_Key : Name_Id;
Name_Buffer (1 .. Name_Len) := External_Name;
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
The_Key := Name_Find;
- Htable.Set (The_Key, The_Value);
+ Name_To_Name_HTable.Set (Tree.External_References, The_Key, The_Value);
end Add;
- -----------
----------------------------------
-- Add_Search_Project_Directory --
----------------------------------
- procedure Add_Search_Project_Directory (Path : String) is
+ procedure Add_Search_Project_Directory
+ (Tree : Prj.Tree.Project_Node_Tree_Ref;
+ Path : String)
+ is
+ Tmp : String_Access;
begin
- Name_Len := 0;
- Add_Str_To_Name_Buffer (Path);
- Search_Directories.Append (Name_Find);
+ if Tree.Project_Path = null then
+ Tree.Project_Path := new String'(Uninitialized_Prefix & Path);
+ else
+ Tmp := Tree.Project_Path;
+ Tree.Project_Path := new String'(Tmp.all & Path_Separator & Path);
+ Free (Tmp);
+ end if;
end Add_Search_Project_Directory;
+ -----------
-- Check --
-----------
- function Check (Declaration : String) return Boolean is
+ function Check
+ (Tree : Prj.Tree.Project_Node_Tree_Ref;
+ Declaration : String) return Boolean
+ is
begin
for Equal_Pos in Declaration'Range loop
if Declaration (Equal_Pos) = '=' then
exit when Equal_Pos = Declaration'First;
- exit when Equal_Pos = Declaration'Last;
Add
- (External_Name =>
+ (Tree => Tree,
+ External_Name =>
Declaration (Declaration'First .. Equal_Pos - 1),
- Value =>
+ Value =>
Declaration (Equal_Pos + 1 .. Declaration'Last));
return True;
end if;
-- Initialize_Project_Path --
-----------------------------
- procedure Initialize_Project_Path is
+ procedure Initialize_Project_Path (Tree : Prj.Tree.Project_Node_Tree_Ref) is
Add_Default_Dir : Boolean := True;
First : Positive;
Last : Positive;
New_Len : Positive;
New_Last : Positive;
- Prj_Path : String_Access := Gpr_Prj_Path;
-
- begin
- if Get_Mode = Ada_Only then
- if Gpr_Prj_Path.all /= "" then
- -- Warn if both environment variables are defined
+ Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
+ Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
+ -- Name of alternate env. variable that contain path name(s) of
+ -- directories where project files may reside. GPR_PROJECT_PATH has
+ -- precedence over ADA_PROJECT_PATH.
- if Ada_Prj_Path.all /= "" then
- Write_Line
- ("Warning: ADA_PROJECT_PATH is not taken into account");
- Write_Line (" when GPR_PROJECT_PATH is defined");
- end if;
+ Gpr_Prj_Path : String_Access := Getenv (Gpr_Project_Path);
+ Ada_Prj_Path : String_Access := Getenv (Ada_Project_Path);
+ -- The path name(s) of directories where project files may reside.
+ -- May be empty.
- else
- Prj_Path := Ada_Prj_Path;
- end if;
+ begin
+ -- The current directory is always first in the search path. Since the
+ -- Project_Path currently starts with '#:' as a sign that it isn't
+ -- initialized, we simply replace '#' with '.'
+
+ if Tree.Project_Path = null then
+ Tree.Project_Path := new String'('.' & Path_Separator);
+ else
+ Tree.Project_Path (Tree.Project_Path'First) := '.';
end if;
- -- The current directory is always first
+ -- Then the reset of the project path (if any) currently contains the
+ -- directories added through Add_Search_Project_Directory
- Name_Len := 1;
- Name_Buffer (Name_Len) := '.';
+ -- If environment variables are defined and not empty, add their content
- -- If there are directories in the Search_Directories table, add them
+ if Gpr_Prj_Path.all /= "" then
+ Add_Search_Project_Directory (Tree, Gpr_Prj_Path.all);
+ end if;
- for J in 1 .. Search_Directories.Last loop
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Path_Separator;
- Add_Str_To_Name_Buffer
- (Get_Name_String (Search_Directories.Table (J)));
- end loop;
+ Free (Gpr_Prj_Path);
- -- If environment variable is defined and not empty, add its content
+ if Ada_Prj_Path.all /= "" then
+ Add_Search_Project_Directory (Tree, Ada_Prj_Path.all);
+ end if;
- if Prj_Path.all /= "" then
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Path_Separator;
+ Free (Ada_Prj_Path);
- Add_Str_To_Name_Buffer (Prj_Path.all);
- end if;
+ -- Copy to Name_Buffer, since we will need to manipulate the path
+
+ Name_Len := Tree.Project_Path'Length;
+ Name_Buffer (1 .. Name_Len) := Tree.Project_Path.all;
-- Scan the directory path to see if "-" is one of the directories.
- -- Remove each occurence of "-" and set Add_Default_Dir to False.
+ -- Remove each occurrence of "-" and set Add_Default_Dir to False.
-- Also resolve relative paths and symbolic links.
First := 3;
Name_Len := Name_Len - No_Project_Default_Dir'Length - 1;
-- After removing the '-', go back one character to get the next
- -- directory corectly.
+ -- directory correctly.
Last := Last - 1;
declare
New_Dir : constant String :=
- Normalize_Pathname (Name_Buffer (First .. Last));
+ Normalize_Pathname
+ (Name_Buffer (First .. Last),
+ Resolve_Links => Opt.Follow_Links_For_Dirs);
begin
-- If the absolute path was resolved and is different from
First := Last + 1;
end loop;
+ Free (Tree.Project_Path);
+
-- Set the initial value of Current_Project_Path
if Add_Default_Dir then
declare
Prefix : String_Ptr := Sdefault.Search_Dir_Prefix;
+
begin
if Prefix = null then
Prefix := new String'(Executable_Prefix_Path);
if Prefix.all /= "" then
- if Get_Mode = Ada_Only then
- Current_Project_Path :=
- new String'(Name_Buffer (1 .. Name_Len) &
- Path_Separator &
- Prefix.all & Directory_Separator & "gnat");
-
- else
- Current_Project_Path :=
- new String'(Name_Buffer (1 .. Name_Len) &
- Path_Separator &
- Prefix.all & Directory_Separator &
- "share" & Directory_Separator & "gpr");
- end if;
+ Add_Str_To_Name_Buffer
+ (Path_Separator & Prefix.all &
+ "share" & Directory_Separator & "gpr");
+ Add_Str_To_Name_Buffer
+ (Path_Separator & Prefix.all &
+ Directory_Separator & "lib" &
+ Directory_Separator & "gnat");
end if;
else
- Current_Project_Path :=
+ Tree.Project_Path :=
new String'(Name_Buffer (1 .. Name_Len) & Path_Separator &
Prefix.all &
".." & Directory_Separator &
".." & Directory_Separator &
".." & Directory_Separator & "gnat");
end if;
+
+ Free (Prefix);
end;
end if;
- if Current_Project_Path = null then
- Current_Project_Path := new String'(Name_Buffer (1 .. Name_Len));
+ if Tree.Project_Path = null then
+ Tree.Project_Path := new String'(Name_Buffer (1 .. Name_Len));
end if;
end Initialize_Project_Path;
-- Project_Path --
------------------
- function Project_Path return String is
+ function Project_Path (Tree : Project_Node_Tree_Ref) return String is
begin
- if Current_Project_Path = null then
- Initialize_Project_Path;
+ if Tree.Project_Path = null
+ or else Tree.Project_Path (Tree.Project_Path'First) = '#'
+ then
+ Initialize_Project_Path (Tree);
end if;
- return Current_Project_Path.all;
+ return Tree.Project_Path.all;
end Project_Path;
-----------
-- Reset --
-----------
- procedure Reset is
+ procedure Reset (Tree : Prj.Tree.Project_Node_Tree_Ref) is
begin
- Htable.Reset;
+ Name_To_Name_HTable.Reset (Tree.External_References);
end Reset;
----------------------
-- Set_Project_Path --
----------------------
- procedure Set_Project_Path (New_Path : String) is
+ procedure Set_Project_Path
+ (Tree : Project_Node_Tree_Ref;
+ New_Path : String) is
begin
- Free (Current_Project_Path);
- Current_Project_Path := new String'(New_Path);
+ Free (Tree.Project_Path);
+ Tree.Project_Path := new String'(New_Path);
end Set_Project_Path;
--------------
--------------
function Value_Of
- (External_Name : Name_Id;
+ (Tree : Prj.Tree.Project_Node_Tree_Ref;
+ External_Name : Name_Id;
With_Default : Name_Id := No_Name)
return Name_Id
is
Canonical_Case_File_Name (Name);
Name_Len := Name'Length;
Name_Buffer (1 .. Name_Len) := Name;
- The_Value := Htable.Get (Name_Find);
+ The_Value :=
+ Name_To_Name_HTable.Get (Tree.External_References, Name_Find);
if The_Value /= No_Name then
return The_Value;
Name_Len := Env_Value'Length;
Name_Buffer (1 .. Name_Len) := Env_Value.all;
The_Value := Name_Find;
- Htable.Set (External_Name, The_Value);
+ Name_To_Name_HTable.Set
+ (Tree.External_References, External_Name, The_Value);
Free (Env_Value);
return The_Value;
OSDN Git Service
