-- --
------------------------------------------------------------------------------
+pragma Ada_2012;
+
with ALI; use ALI;
with ALI.Util; use ALI.Util;
with Binderr; use Binderr;
with Csets; use Csets;
with Fname; use Fname;
with Gnatvsn; use Gnatvsn;
-with GNAT.OS_Lib; use GNAT.OS_Lib;
+with Makeutl; use Makeutl;
with Namet; use Namet;
with Opt; use Opt;
with Osint; use Osint;
with Osint.L; use Osint.L;
with Output; use Output;
-with Prj.Env; use Prj.Env;
with Rident; use Rident;
with Sdefault;
with Snames;
with Switch; use Switch;
with Types; use Types;
-with Ada.Command_Line; use Ada.Command_Line;
-
-with GNAT.Command_Line; use GNAT.Command_Line;
-with GNAT.Case_Util; use GNAT.Case_Util;
+with GNAT.Case_Util; use GNAT.Case_Util;
+with GNAT.Command_Line; use GNAT.Command_Line;
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
procedure Gnatls is
pragma Ident (Gnat_Static_Version_String);
-- Label displayed in verbose mode before the directories in the project
-- search path. Do not modify without checking NOTE above.
- Prj_Path : Prj.Env.Project_Search_Path;
+ Prj_Path : String_Access;
Max_Column : constant := 80;
end GNATDIST;
+ ------------------------------
+ -- Support for project path --
+ ------------------------------
+
+ package Prj_Env is
+
+ procedure Initialize_Default_Project_Path
+ (Self : in out String_Access;
+ Target_Name : String;
+ Runtime_Name : String := "");
+ -- Initialize Self. It will then contain the default project path on
+ -- the given target and runtime (including directories specified by the
+ -- environment variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and
+ -- ADA_PROJECT_PATH). If one of the directory or Target_Name is "-",
+ -- then the path contains only those directories specified by the
+ -- environment variables (except "-"). This does nothing if Self has
+ -- already been initialized.
+
+ procedure Add_Directories
+ (Self : in out String_Access;
+ Path : String;
+ Prepend : Boolean := False);
+ -- Add one or more directories to the path. Directories added with this
+ -- procedure are added in order after the current directory and before
+ -- the path given by the environment variable GPR_PROJECT_PATH. A value
+ -- of "-" will remove the default project directory from the project
+ -- path.
+ --
+ -- Calls to this subprogram must be performed before the first call to
+ -- Find_Project below, or PATH will be added at the end of the search
+ -- path.
+
+ function Get_Runtime_Path
+ (Self : String_Access;
+ Path : String) return String_Access;
+ -- Compute the full path for the project-based runtime name.
+ -- Path is simply searched on the project path.
+
+ end Prj_Env;
+
-----------------
-- Add_Lib_Dir --
-----------------
end if;
end Output_Unit;
+ package body Prj_Env is
+
+ Uninitialized_Prefix : constant String := '#' & Path_Separator;
+ -- Prefix to indicate that the project path has not been initialized
+ -- yet. Must be two characters long
+
+ ---------------------
+ -- Add_Directories --
+ ---------------------
+
+ procedure Add_Directories
+ (Self : in out String_Access;
+ Path : String;
+ Prepend : Boolean := False)
+ is
+ Tmp : String_Access;
+ begin
+ if Self = null then
+ Self := new String'(Uninitialized_Prefix & Path);
+ else
+ Tmp := Self;
+ if Prepend then
+ Self := new String'(Path & Path_Separator & Tmp.all);
+ else
+ Self := new String'(Tmp.all & Path_Separator & Path);
+ end if;
+ Free (Tmp);
+ end if;
+
+ end Add_Directories;
+
+ -------------------------------------
+ -- Initialize_Default_Project_Path --
+ -------------------------------------
+
+ procedure Initialize_Default_Project_Path
+ (Self : in out String_Access;
+ Target_Name : String;
+ Runtime_Name : String := "")
+ is
+ Add_Default_Dir : Boolean := Target_Name /= "-";
+ First : Positive;
+ Last : Positive;
+
+ Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
+ Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
+ Gpr_Project_Path_File : constant String := "GPR_PROJECT_PATH_FILE";
+ -- Names of alternate env. variables that contain path name(s) of
+ -- directories where project files may reside. They are taken into
+ -- account in this order: GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH,
+ -- ADA_PROJECT_PATH.
+
+ Gpr_Prj_Path_File : String_Access;
+ Gpr_Prj_Path : String_Access;
+ Ada_Prj_Path : String_Access;
+ -- The path name(s) of directories where project files may reside.
+ -- May be empty.
+
+ Prefix : String_Ptr;
+ Runtime : String_Ptr;
+
+ procedure Add_Target (Suffix : String);
+ -- Add :<prefix>/<target>/Suffix to the project path
+
+ FD : File_Descriptor;
+ Len : Integer;
+
+ ----------------
+ -- Add_Target --
+ ----------------
+
+ procedure Add_Target (Suffix : String) is
+ Extra_Sep : constant String :=
+ (if Target_Name (Target_Name'Last) = '/' then
+ ""
+ else
+ (1 => Directory_Separator));
+ -- Note: Target_Name has a trailing / when it comes from Sdefault
+ begin
+ Add_Str_To_Name_Buffer
+ (Path_Separator & Prefix.all & Target_Name & Extra_Sep & Suffix);
+ end Add_Target;
+
+ -- Start of processing for Initialize_Default_Project_Path
+
+ begin
+ if Self /= null
+ and then (Self'Length = 0
+ or else Self (Self'First) /= '#')
+ then
+ return;
+ end if;
+
+ -- 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 Self = null then
+ Self := new String'('.' & Path_Separator);
+ else
+ Self (Self'First) := '.';
+ end if;
+
+ -- Then the reset of the project path (if any) currently contains the
+ -- directories added through Add_Search_Project_Directory
+
+ -- If environment variables are defined and not empty, add their
+ -- content
+
+ Gpr_Prj_Path_File := Getenv (Gpr_Project_Path_File);
+ Gpr_Prj_Path := Getenv (Gpr_Project_Path);
+ Ada_Prj_Path := Getenv (Ada_Project_Path);
+
+ if Gpr_Prj_Path_File.all /= "" then
+
+ FD := Open_Read (Gpr_Prj_Path_File.all, GNAT.OS_Lib.Text);
+
+ if FD = Invalid_FD then
+ Osint.Fail ("warning: could not read project path file """ &
+ Gpr_Prj_Path_File.all & """");
+ end if;
+
+ Len := Integer (File_Length (FD));
+
+ declare
+ Buffer : String (1 .. Len);
+ Index : Positive := 1;
+ Last : Positive;
+ Tmp : String_Access;
+
+ begin
+ -- Read the file
+
+ Len := Read (FD, Buffer (1)'Address, Len);
+ Close (FD);
+
+ -- Scan the file line by line
+
+ while Index < Buffer'Last loop
+
+ -- Find the end of line
+
+ Last := Index;
+ while Last <= Buffer'Last
+ and then Buffer (Last) /= ASCII.LF
+ and then Buffer (Last) /= ASCII.CR
+ loop
+ Last := Last + 1;
+ end loop;
+
+ -- Ignore empty lines
+
+ if Last > Index then
+ Tmp := Self;
+ Self :=
+ new String'
+ (Tmp.all & Path_Separator &
+ Buffer (Index .. Last - 1));
+ Free (Tmp);
+ end if;
+
+ -- Find the beginning of the next line
+
+ Index := Last;
+ while Buffer (Index) = ASCII.CR or else
+ Buffer (Index) = ASCII.LF
+ loop
+ Index := Index + 1;
+ end loop;
+ end loop;
+ end;
+
+ end if;
+
+ if Gpr_Prj_Path.all /= "" then
+ Add_Directories (Self, Gpr_Prj_Path.all);
+ end if;
+
+ Free (Gpr_Prj_Path);
+
+ if Ada_Prj_Path.all /= "" then
+ Add_Directories (Self, Ada_Prj_Path.all);
+ end if;
+
+ Free (Ada_Prj_Path);
+
+ -- Copy to Name_Buffer, since we will need to manipulate the path
+
+ Name_Len := Self'Length;
+ Name_Buffer (1 .. Name_Len) := Self.all;
+
+ -- Scan the directory path to see if "-" is one of the directories.
+ -- Remove each occurrence of "-" and set Add_Default_Dir to False.
+ -- Also resolve relative paths and symbolic links.
+
+ First := 3;
+ loop
+ while First <= Name_Len
+ and then (Name_Buffer (First) = Path_Separator)
+ loop
+ First := First + 1;
+ end loop;
+
+ exit when First > Name_Len;
+
+ Last := First;
+
+ while Last < Name_Len
+ and then Name_Buffer (Last + 1) /= Path_Separator
+ loop
+ Last := Last + 1;
+ end loop;
+
+ -- If the directory is "-", set Add_Default_Dir to False and
+ -- remove from path.
+
+ if Name_Buffer (First .. Last) = "-" then
+ Add_Default_Dir := False;
+
+ for J in Last + 1 .. Name_Len loop
+ Name_Buffer (J - 2) :=
+ Name_Buffer (J);
+ end loop;
+
+ Name_Len := Name_Len - 2;
+
+ -- After removing the '-', go back one character to get the
+ -- next directory correctly.
+
+ Last := Last - 1;
+
+ else
+ declare
+ New_Dir : constant String :=
+ Normalize_Pathname
+ (Name_Buffer (First .. Last),
+ Resolve_Links => Opt.Follow_Links_For_Dirs);
+ New_Len : Positive;
+ New_Last : Positive;
+
+ begin
+ -- If the absolute path was resolved and is different from
+ -- the original, replace original with the resolved path.
+
+ if New_Dir /= Name_Buffer (First .. Last)
+ and then New_Dir'Length /= 0
+ then
+ New_Len := Name_Len + New_Dir'Length - (Last - First + 1);
+ New_Last := First + New_Dir'Length - 1;
+ Name_Buffer (New_Last + 1 .. New_Len) :=
+ Name_Buffer (Last + 1 .. Name_Len);
+ Name_Buffer (First .. New_Last) := New_Dir;
+ Name_Len := New_Len;
+ Last := New_Last;
+ end if;
+ end;
+ end if;
+
+ First := Last + 1;
+ end loop;
+
+ Free (Self);
+
+ -- Set the initial value of Current_Project_Path
+
+ if Add_Default_Dir then
+ if Sdefault.Search_Dir_Prefix = null then
+
+ -- gprbuild case
+
+ Prefix := new String'(Executable_Prefix_Path);
+
+ else
+ Prefix := new String'(Sdefault.Search_Dir_Prefix.all
+ & ".." & Dir_Separator
+ & ".." & Dir_Separator
+ & ".." & Dir_Separator
+ & ".." & Dir_Separator);
+ end if;
+
+ if Prefix.all /= "" then
+ if Target_Name /= "" then
+
+ if Runtime_Name /= "" then
+ if Base_Name (Runtime_Name) = Runtime_Name then
+
+ -- $prefix/$target/$runtime/lib/gnat
+ Add_Target
+ (Runtime_Name & Directory_Separator &
+ "lib" & Directory_Separator & "gnat");
+
+ -- $prefix/$target/$runtime/share/gpr
+ Add_Target
+ (Runtime_Name & Directory_Separator &
+ "share" & Directory_Separator & "gpr");
+
+ else
+ Runtime :=
+ new String'(Normalize_Pathname (Runtime_Name));
+
+ -- $runtime_dir/lib/gnat
+ Add_Str_To_Name_Buffer
+ (Path_Separator & Runtime.all & Directory_Separator &
+ "lib" & Directory_Separator & "gnat");
+
+ -- $runtime_dir/share/gpr
+ Add_Str_To_Name_Buffer
+ (Path_Separator & Runtime.all & Directory_Separator &
+ "share" & Directory_Separator & "gpr");
+ end if;
+ end if;
+
+ -- $prefix/$target/lib/gnat
+ Add_Target
+ ("lib" & Directory_Separator & "gnat");
+
+ -- $prefix/$target/share/gpr
+ Add_Target
+ ("share" & Directory_Separator & "gpr");
+ end if;
+
+ -- $prefix/share/gpr
+
+ Add_Str_To_Name_Buffer
+ (Path_Separator & Prefix.all & "share"
+ & Directory_Separator & "gpr");
+
+ -- $prefix/lib/gnat
+
+ Add_Str_To_Name_Buffer
+ (Path_Separator & Prefix.all & "lib"
+ & Directory_Separator & "gnat");
+ end if;
+
+ Free (Prefix);
+ end if;
+
+ Self := new String'(Name_Buffer (1 .. Name_Len));
+ end Initialize_Default_Project_Path;
+
+ -----------------------
+ -- Get_Runtime_Path --
+ -----------------------
+
+ function Get_Runtime_Path
+ (Self : String_Access;
+ Path : String) return String_Access
+ is
+ First : Natural;
+ Last : Natural;
+
+ begin
+
+ if Is_Absolute_Path (Path) then
+ if Is_Directory (Path) then
+ return new String'(Path);
+ else
+ return null;
+ end if;
+
+ else
+ -- Because we don't want to resolve symbolic links, we cannot
+ -- use Locate_Regular_File. So, we try each possible path
+ -- successively.
+
+ First := Self'First;
+ while First <= Self'Last loop
+ while First <= Self'Last
+ and then Self (First) = Path_Separator
+ loop
+ First := First + 1;
+ end loop;
+
+ exit when First > Self'Last;
+
+ Last := First;
+ while Last < Self'Last
+ and then Self (Last + 1) /= Path_Separator
+ loop
+ Last := Last + 1;
+ end loop;
+
+ Name_Len := 0;
+
+ if not Is_Absolute_Path (Self (First .. Last)) then
+ Add_Str_To_Name_Buffer (Get_Current_Dir); -- ??? System call
+ Add_Char_To_Name_Buffer (Directory_Separator);
+ end if;
+
+ Add_Str_To_Name_Buffer (Self (First .. Last));
+ Add_Char_To_Name_Buffer (Directory_Separator);
+ Add_Str_To_Name_Buffer (Path);
+
+ if Is_Directory (Name_Buffer (1 .. Name_Len)) then
+ return new String'(Name_Buffer (1 .. Name_Len));
+ end if;
+
+ First := Last + 1;
+ end loop;
+ end if;
+
+ return null;
+ end Get_Runtime_Path;
+
+ end Prj_Env;
+
-----------------
-- Reset_Print --
-----------------
if Src_Path /= null and then Lib_Path /= null then
Add_Search_Dirs (Src_Path, Include);
Add_Search_Dirs (Lib_Path, Objects);
- Initialize_Default_Project_Path
+ Prj_Env.Initialize_Default_Project_Path
(Prj_Path,
Target_Name => Sdefault.Target_Name.all,
Runtime_Name => Name);
-- Try to find the RTS on the project path. First setup the project path
- Initialize_Default_Project_Path
+ Prj_Env.Initialize_Default_Project_Path
(Prj_Path,
Target_Name => Sdefault.Target_Name.all,
Runtime_Name => Name);
- Rts_Full_Path := Get_Runtime_Path (Prj_Path, Name);
+ Rts_Full_Path := Prj_Env.Get_Runtime_Path (Prj_Path, Name);
if Rts_Full_Path /= null then
-- Processing for -aP<dir>
elsif Argv'Length > 3 and then Argv (1 .. 3) = "-aP" then
- Add_Directories (Prj_Path, Argv (4 .. Argv'Last));
+ Prj_Env.Add_Directories (Prj_Path, Argv (4 .. Argv'Last));
-- Processing for -nostdinc
Write_Str (" <Current_Directory>");
Write_Eol;
- Initialize_Default_Project_Path
+ Prj_Env.Initialize_Default_Project_Path
(Prj_Path, Target_Name => Sdefault.Target_Name.all);
declare
- Project_Path : String_Access;
First : Natural;
Last : Natural;
begin
- Get_Path (Prj_Path, Project_Path);
- if Project_Path.all /= "" then
- First := Project_Path'First;
+ if Prj_Path.all /= "" then
+ First := Prj_Path'First;
loop
- while First <= Project_Path'Last
- and then (Project_Path (First) = Path_Separator)
+ while First <= Prj_Path'Last
+ and then (Prj_Path (First) = Path_Separator)
loop
First := First + 1;
end loop;
- exit when First > Project_Path'Last;
+ exit when First > Prj_Path'Last;
Last := First;
- while Last < Project_Path'Last
- and then Project_Path (Last + 1) /= Path_Separator
+ while Last < Prj_Path'Last
+ and then Prj_Path (Last + 1) /= Path_Separator
loop
Last := Last + 1;
end loop;
- if First /= Last or else Project_Path (First) /= '.' then
+ if First /= Last or else Prj_Path (First) /= '.' then
-- If the directory is ".", skip it as it is the current
-- directory and it is already the first directory in the
Write_Str
(Normalize
(To_Host_Dir_Spec
- (Project_Path (First .. Last), True).all));
+ (Prj_Path (First .. Last), True).all));
Write_Eol;
end if;
if not More_Lib_Files then
if not Print_Usage and then not Verbose_Mode then
- if Argument_Count = 0 then
+ if Arg_Count = 1 then
Usage;
else
Try_Help;
projects / platform / upstream / gcc.git / commitdiff