-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-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, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, 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 Osint.L; use Osint.L;
with Output; use Output;
with Rident; use Rident;
+with Sdefault;
with Snames;
+with Switch; use Switch;
with Targparm; use Targparm;
with Types; use Types;
procedure Gnatls is
pragma Ident (Gnat_Static_Version_String);
+ Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
+ Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
+ -- Names of the env. variables that contains path name(s) of directories
+ -- where project files may reside. If GPR_PROJECT_PATH is defined, its
+ -- value is used, otherwise ADA_PROJECT_PATH is used, if defined.
+
+ -- NOTE : The following string may be used by other tools, such as GPS. So
+ -- it can only be modified if these other uses are checked and coordinated.
+
+ Project_Search_Path : constant String := "Project Search Path:";
+ -- Label displayed in verbose mode before the directories in the project
+ -- search path. Do not modify without checking NOTE above.
+
+ No_Project_Default_Dir : constant String := "-";
+
Max_Column : constant := 80;
No_Obj : aliased String := "<no_obj>";
Print_Object : Boolean := True;
-- Flags controlling the form of the output
- Dependable : Boolean := False; -- flag -d
- Also_Predef : Boolean := False;
+ Also_Predef : Boolean := False; -- -a
+ Dependable : Boolean := False; -- -d
+ License : Boolean := False; -- -l
+ Very_Verbose_Mode : Boolean := False; -- -V
+ -- Command line flags
Unit_Start : Integer;
Unit_End : Integer;
-- Local Subprograms --
-----------------------
- procedure Add_Lib_Dir (Dir : String; And_Save : Boolean);
- -- Add an object directory, using Osint.Add_Lib_Search_Dir
- -- if And_Save is False or keeping in the list First_Lib_Dir,
- -- Last_Lib_Dir if And_Save is True.
+ procedure Add_Lib_Dir (Dir : String);
+ -- Add an object directory in the list First_Lib_Dir-Last_Lib_Dir
- procedure Add_Source_Dir (Dir : String; And_Save : Boolean);
- -- Add a source directory, using Osint.Add_Src_Search_Dir
- -- if And_Save is False or keeping in the list First_Source_Dir,
- -- Last_Source_Dir if And_Save is True.
+ procedure Add_Source_Dir (Dir : String);
+ -- Add a source directory in the list First_Source_Dir-Last_Source_Dir
procedure Find_General_Layout;
-- Determine the structure of the output (multi columns or not, etc)
procedure Reset_Print;
-- Reset Print flags properly when selective output is chosen
- procedure Scan_Ls_Arg (Argv : String; And_Save : Boolean);
+ procedure Scan_Ls_Arg (Argv : String);
-- Scan and process lser specific arguments. Argv is a single argument
procedure Usage;
-- Print usage message
+ procedure Output_License_Information;
+ -- Output license statement, and if not found, output reference to
+ -- COPYING.
+
function Image (Restriction : Restriction_Id) return String;
-- Returns the capitalized image of Restriction
+ ------------------------------------------
+ -- GNATDIST specific output subprograms --
+ ------------------------------------------
+
+ package GNATDIST is
+
+ -- Any modification to this subunit requires synchronization with the
+ -- GNATDIST sources.
+
+ procedure Output_ALI (A : ALI_Id);
+ -- Comment required saying what this routine does ???
+
+ procedure Output_No_ALI (Afile : File_Name_Type);
+ -- Comments required saying what this routine does ???
+
+ end GNATDIST;
+
-----------------
-- Add_Lib_Dir --
-----------------
- procedure Add_Lib_Dir (Dir : String; And_Save : Boolean) is
+ procedure Add_Lib_Dir (Dir : String) is
begin
- if And_Save then
- if First_Lib_Dir = null then
- First_Lib_Dir :=
- new Dir_Data'
- (Value => new String'(Dir),
- Next => null);
- Last_Lib_Dir := First_Lib_Dir;
-
- else
- Last_Lib_Dir.Next :=
- new Dir_Data'
- (Value => new String'(Dir),
- Next => null);
- Last_Lib_Dir := Last_Lib_Dir.Next;
- end if;
+ if First_Lib_Dir = null then
+ First_Lib_Dir :=
+ new Dir_Data'
+ (Value => new String'(Dir),
+ Next => null);
+ Last_Lib_Dir := First_Lib_Dir;
else
- Add_Lib_Search_Dir (Dir);
+ Last_Lib_Dir.Next :=
+ new Dir_Data'
+ (Value => new String'(Dir),
+ Next => null);
+ Last_Lib_Dir := Last_Lib_Dir.Next;
end if;
end Add_Lib_Dir;
-- Add_Source_Dir --
--------------------
- procedure Add_Source_Dir (Dir : String; And_Save : Boolean) is
+ procedure Add_Source_Dir (Dir : String) is
begin
- if And_Save then
- if First_Source_Dir = null then
- First_Source_Dir :=
- new Dir_Data'
- (Value => new String'(Dir),
- Next => null);
- Last_Source_Dir := First_Source_Dir;
-
- else
- Last_Source_Dir.Next :=
- new Dir_Data'
- (Value => new String'(Dir),
- Next => null);
- Last_Source_Dir := Last_Source_Dir.Next;
- end if;
+ if First_Source_Dir = null then
+ First_Source_Dir :=
+ new Dir_Data'
+ (Value => new String'(Dir),
+ Next => null);
+ Last_Source_Dir := First_Source_Dir;
else
- Add_Src_Search_Dir (Dir);
+ Last_Source_Dir.Next :=
+ new Dir_Data'
+ (Value => new String'(Dir),
+ Next => null);
+ Last_Source_Dir := Last_Source_Dir.Next;
end if;
end Add_Source_Dir;
end if;
end loop;
- Error_Msg_Name_1 := Units.Table (U).Uname;
- Error_Msg_Name_2 := ALIs.Table (A).Afile;
+ Error_Msg_Unit_1 := Units.Table (U).Uname;
+ Error_Msg_File_1 := ALIs.Table (A).Afile;
Write_Eol;
- Error_Msg ("wrong ALI format, can't find dependency line for & in %");
+ Error_Msg ("wrong ALI format, can't find dependency line for $ in {");
Exit_Program (E_Fatal);
+ return No_Sdep_Id;
end Corresponding_Sdep_Entry;
-------------------------
Source_End := Source_Start - 1;
if Print_Source then
- Source_End := Source_Start + Max_Src_Length;
+ Source_End := Source_Start + Max_Src_Length;
end if;
end Find_General_Layout;
end if;
end Find_Status;
+ --------------
+ -- GNATDIST --
+ --------------
+
+ package body GNATDIST is
+
+ N_Flags : Natural;
+ N_Indents : Natural := 0;
+
+ type Token_Type is
+ (T_No_ALI,
+ T_ALI,
+ T_Unit,
+ T_With,
+ T_Source,
+ T_Afile,
+ T_Ofile,
+ T_Sfile,
+ T_Name,
+ T_Main,
+ T_Kind,
+ T_Flags,
+ T_Preelaborated,
+ T_Pure,
+ T_Has_RACW,
+ T_Remote_Types,
+ T_Shared_Passive,
+ T_RCI,
+ T_Predefined,
+ T_Internal,
+ T_Is_Generic,
+ T_Procedure,
+ T_Function,
+ T_Package,
+ T_Subprogram,
+ T_Spec,
+ T_Body);
+
+ Image : constant array (Token_Type) of String_Access :=
+ (T_No_ALI => new String'("No_ALI"),
+ T_ALI => new String'("ALI"),
+ T_Unit => new String'("Unit"),
+ T_With => new String'("With"),
+ T_Source => new String'("Source"),
+ T_Afile => new String'("Afile"),
+ T_Ofile => new String'("Ofile"),
+ T_Sfile => new String'("Sfile"),
+ T_Name => new String'("Name"),
+ T_Main => new String'("Main"),
+ T_Kind => new String'("Kind"),
+ T_Flags => new String'("Flags"),
+ T_Preelaborated => new String'("Preelaborated"),
+ T_Pure => new String'("Pure"),
+ T_Has_RACW => new String'("Has_RACW"),
+ T_Remote_Types => new String'("Remote_Types"),
+ T_Shared_Passive => new String'("Shared_Passive"),
+ T_RCI => new String'("RCI"),
+ T_Predefined => new String'("Predefined"),
+ T_Internal => new String'("Internal"),
+ T_Is_Generic => new String'("Is_Generic"),
+ T_Procedure => new String'("procedure"),
+ T_Function => new String'("function"),
+ T_Package => new String'("package"),
+ T_Subprogram => new String'("subprogram"),
+ T_Spec => new String'("spec"),
+ T_Body => new String'("body"));
+
+ procedure Output_Name (N : Name_Id);
+ -- Remove any encoding info (%b and %s) and output N
+
+ procedure Output_Afile (A : File_Name_Type);
+ procedure Output_Ofile (O : File_Name_Type);
+ procedure Output_Sfile (S : File_Name_Type);
+ -- Output various names. Check that the name is different from no name.
+ -- Otherwise, skip the output.
+
+ procedure Output_Token (T : Token_Type);
+ -- Output token using specific format. That is several indentations and:
+ --
+ -- T_No_ALI .. T_With : <token> & " =>" & NL
+ -- T_Source .. T_Kind : <token> & " => "
+ -- T_Flags : <token> & " =>"
+ -- T_Preelab .. T_Body : " " & <token>
+
+ procedure Output_Sdep (S : Sdep_Id);
+ procedure Output_Unit (U : Unit_Id);
+ procedure Output_With (W : With_Id);
+ -- Output this entry as a global section (like ALIs)
+
+ ------------------
+ -- Output_Afile --
+ ------------------
+
+ procedure Output_Afile (A : File_Name_Type) is
+ begin
+ if A /= No_File then
+ Output_Token (T_Afile);
+ Write_Name (A);
+ Write_Eol;
+ end if;
+ end Output_Afile;
+
+ ----------------
+ -- Output_ALI --
+ ----------------
+
+ procedure Output_ALI (A : ALI_Id) is
+ begin
+ Output_Token (T_ALI);
+ N_Indents := N_Indents + 1;
+
+ Output_Afile (ALIs.Table (A).Afile);
+ Output_Ofile (ALIs.Table (A).Ofile_Full_Name);
+ Output_Sfile (ALIs.Table (A).Sfile);
+
+ -- Output Main
+
+ if ALIs.Table (A).Main_Program /= None then
+ Output_Token (T_Main);
+
+ if ALIs.Table (A).Main_Program = Proc then
+ Output_Token (T_Procedure);
+ else
+ Output_Token (T_Function);
+ end if;
+
+ Write_Eol;
+ end if;
+
+ -- Output Units
+
+ for U in ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit loop
+ Output_Unit (U);
+ end loop;
+
+ -- Output Sdeps
+
+ for S in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
+ Output_Sdep (S);
+ end loop;
+
+ N_Indents := N_Indents - 1;
+ end Output_ALI;
+
+ -------------------
+ -- Output_No_ALI --
+ -------------------
+
+ procedure Output_No_ALI (Afile : File_Name_Type) is
+ begin
+ Output_Token (T_No_ALI);
+ N_Indents := N_Indents + 1;
+ Output_Afile (Afile);
+ N_Indents := N_Indents - 1;
+ end Output_No_ALI;
+
+ -----------------
+ -- Output_Name --
+ -----------------
+
+ procedure Output_Name (N : Name_Id) is
+ begin
+ -- Remove any encoding info (%s or %b)
+
+ Get_Name_String (N);
+
+ if Name_Len > 2
+ and then Name_Buffer (Name_Len - 1) = '%'
+ then
+ Name_Len := Name_Len - 2;
+ end if;
+
+ Output_Token (T_Name);
+ Write_Str (Name_Buffer (1 .. Name_Len));
+ Write_Eol;
+ end Output_Name;
+
+ ------------------
+ -- Output_Ofile --
+ ------------------
+
+ procedure Output_Ofile (O : File_Name_Type) is
+ begin
+ if O /= No_File then
+ Output_Token (T_Ofile);
+ Write_Name (O);
+ Write_Eol;
+ end if;
+ end Output_Ofile;
+
+ -----------------
+ -- Output_Sdep --
+ -----------------
+
+ procedure Output_Sdep (S : Sdep_Id) is
+ begin
+ Output_Token (T_Source);
+ Write_Name (Sdep.Table (S).Sfile);
+ Write_Eol;
+ end Output_Sdep;
+
+ ------------------
+ -- Output_Sfile --
+ ------------------
+
+ procedure Output_Sfile (S : File_Name_Type) is
+ FS : File_Name_Type := S;
+
+ begin
+ if FS /= No_File then
+
+ -- We want to output the full source name
+
+ FS := Full_Source_Name (FS);
+
+ -- There is no full source name. This occurs for instance when a
+ -- withed unit has a spec file but no body file. This situation is
+ -- not a problem for GNATDIST since the unit may be located on a
+ -- partition we do not want to build. However, we need to locate
+ -- the spec file and to find its full source name. Replace the
+ -- body file name with the spec file name used to compile the
+ -- current unit when possible.
+
+ if FS = No_File then
+ Get_Name_String (S);
+
+ if Name_Len > 4
+ and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb"
+ then
+ Name_Buffer (Name_Len) := 's';
+ FS := Full_Source_Name (Name_Find);
+ end if;
+ end if;
+ end if;
+
+ if FS /= No_File then
+ Output_Token (T_Sfile);
+ Write_Name (FS);
+ Write_Eol;
+ end if;
+ end Output_Sfile;
+
+ ------------------
+ -- Output_Token --
+ ------------------
+
+ procedure Output_Token (T : Token_Type) is
+ begin
+ if T in T_No_ALI .. T_Flags then
+ for J in 1 .. N_Indents loop
+ Write_Str (" ");
+ end loop;
+
+ Write_Str (Image (T).all);
+
+ for J in Image (T)'Length .. 12 loop
+ Write_Char (' ');
+ end loop;
+
+ Write_Str ("=>");
+
+ if T in T_No_ALI .. T_With then
+ Write_Eol;
+ elsif T in T_Source .. T_Name then
+ Write_Char (' ');
+ end if;
+
+ elsif T in T_Preelaborated .. T_Body then
+ if T in T_Preelaborated .. T_Is_Generic then
+ if N_Flags = 0 then
+ Output_Token (T_Flags);
+ end if;
+
+ N_Flags := N_Flags + 1;
+ end if;
+
+ Write_Char (' ');
+ Write_Str (Image (T).all);
+
+ else
+ Write_Str (Image (T).all);
+ end if;
+ end Output_Token;
+
+ -----------------
+ -- Output_Unit --
+ -----------------
+
+ procedure Output_Unit (U : Unit_Id) is
+ begin
+ Output_Token (T_Unit);
+ N_Indents := N_Indents + 1;
+
+ -- Output Name
+
+ Output_Name (Name_Id (Units.Table (U).Uname));
+
+ -- Output Kind
+
+ Output_Token (T_Kind);
+
+ if Units.Table (U).Unit_Kind = 'p' then
+ Output_Token (T_Package);
+ else
+ Output_Token (T_Subprogram);
+ end if;
+
+ if Name_Buffer (Name_Len) = 's' then
+ Output_Token (T_Spec);
+ else
+ Output_Token (T_Body);
+ end if;
+
+ Write_Eol;
+
+ -- Output source file name
+
+ Output_Sfile (Units.Table (U).Sfile);
+
+ -- Output Flags
+
+ N_Flags := 0;
+
+ if Units.Table (U).Preelab then
+ Output_Token (T_Preelaborated);
+ end if;
+
+ if Units.Table (U).Pure then
+ Output_Token (T_Pure);
+ end if;
+
+ if Units.Table (U).Has_RACW then
+ Output_Token (T_Has_RACW);
+ end if;
+
+ if Units.Table (U).Remote_Types then
+ Output_Token (T_Remote_Types);
+ end if;
+
+ if Units.Table (U).Shared_Passive then
+ Output_Token (T_Shared_Passive);
+ end if;
+
+ if Units.Table (U).RCI then
+ Output_Token (T_RCI);
+ end if;
+
+ if Units.Table (U).Predefined then
+ Output_Token (T_Predefined);
+ end if;
+
+ if Units.Table (U).Internal then
+ Output_Token (T_Internal);
+ end if;
+
+ if Units.Table (U).Is_Generic then
+ Output_Token (T_Is_Generic);
+ end if;
+
+ if N_Flags > 0 then
+ Write_Eol;
+ end if;
+
+ -- Output Withs
+
+ for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop
+ Output_With (W);
+ end loop;
+
+ N_Indents := N_Indents - 1;
+ end Output_Unit;
+
+ -----------------
+ -- Output_With --
+ -----------------
+
+ procedure Output_With (W : With_Id) is
+ begin
+ Output_Token (T_With);
+ N_Indents := N_Indents + 1;
+
+ Output_Name (Name_Id (Withs.Table (W).Uname));
+
+ -- Output Kind
+
+ Output_Token (T_Kind);
+
+ if Name_Buffer (Name_Len) = 's' then
+ Output_Token (T_Spec);
+ else
+ Output_Token (T_Body);
+ end if;
+
+ Write_Eol;
+
+ Output_Afile (Withs.Table (W).Afile);
+ Output_Sfile (Withs.Table (W).Sfile);
+
+ N_Indents := N_Indents - 1;
+ end Output_With;
+
+ end GNATDIST;
+
-----------
-- Image --
-----------
return Result;
end Image;
+ --------------------------------
+ -- Output_License_Information --
+ --------------------------------
+
+ procedure Output_License_Information is
+ Params_File_Name : constant String := "gnatlic.adl";
+ -- Name of license file
+
+ Lo : constant Source_Ptr := 1;
+ Hi : Source_Ptr;
+ Text : Source_Buffer_Ptr;
+
+ begin
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Params_File_Name);
+ Read_Source_File (Name_Find, Lo, Hi, Text);
+
+ if Text /= null then
+
+ -- Omit last character (end-of-file marker) in output
+
+ Write_Str (String (Text (Lo .. Hi - 1)));
+ Write_Eol;
+
+ -- The following condition is determined at compile time: disable
+ -- "condition is always true/false" warning.
+
+ pragma Warnings (Off);
+ elsif Build_Type /= GPL and then Build_Type /= FSF then
+ pragma Warnings (On);
+
+ Write_Str ("License file missing, please contact AdaCore.");
+ Write_Eol;
+
+ else
+ Write_Str ("Please refer to file COPYING in your distribution"
+ & " for license terms.");
+ Write_Eol;
+
+ end if;
+
+ Exit_Program (E_Success);
+ end Output_License_Information;
+
-------------------
-- Output_Object --
-------------------
-------------------
procedure Output_Source (Sdep_I : Sdep_Id) is
- Stamp : constant Time_Stamp_Type := Sdep.Table (Sdep_I).Stamp;
- Checksum : constant Word := Sdep.Table (Sdep_I).Checksum;
- FS : File_Name_Type := Sdep.Table (Sdep_I).Sfile;
+ Stamp : Time_Stamp_Type;
+ Checksum : Word;
+ FS : File_Name_Type;
Status : File_Status;
Object_Name : String_Access;
begin
+ if Sdep_I = No_Sdep_Id then
+ return;
+ end if;
+
+ Stamp := Sdep.Table (Sdep_I).Stamp;
+ Checksum := Sdep.Table (Sdep_I).Checksum;
+ FS := Sdep.Table (Sdep_I).Sfile;
+
if Print_Source then
Find_Status (FS, Stamp, Checksum, Status);
Get_Name_String (FS);
else
Write_Str ("Unit => ");
- Write_Eol; Write_Str (" Name => ");
+ Write_Eol;
+ Write_Str (" Name => ");
Write_Str (Name_Buffer (1 .. Name_Len));
- Write_Eol; Write_Str (" Kind => ");
+ Write_Eol;
+ Write_Str (" Kind => ");
if Units.Table (U_Id).Unit_Kind = 'p' then
Write_Str ("package ");
end if;
if Verbose_Mode then
- if U.Preelab or
- U.No_Elab or
- U.Pure or
- U.Dynamic_Elab or
- U.Has_RACW or
- U.Remote_Types or
- U.Shared_Passive or
- U.RCI or
- U.Predefined or
- U.Internal or
- U.Is_Generic or
- U.Init_Scalars or
- U.Interface or
- U.Body_Needed_For_SAL or
+ if U.Preelab or else
+ U.No_Elab or else
+ U.Pure or else
+ U.Dynamic_Elab or else
+ U.Has_RACW or else
+ U.Remote_Types or else
+ U.Shared_Passive or else
+ U.RCI or else
+ U.Predefined or else
+ U.Internal or else
+ U.Is_Generic or else
+ U.Init_Scalars or else
+ U.SAL_Interface or else
+ U.Body_Needed_For_SAL or else
U.Elaborate_Body
then
- Write_Eol; Write_Str (" Flags =>");
+ Write_Eol;
+ Write_Str (" Flags =>");
if U.Preelab then
Write_Str (" Preelaborable");
Write_Str (" Init_Scalars");
end if;
- if U.Interface then
- Write_Str (" Interface");
+ if U.SAL_Interface then
+ Write_Str (" SAL_Interface");
end if;
if U.Body_Needed_For_SAL then
if U.Predefined then
Write_Str (" Predefined");
end if;
-
end if;
declare
Restrictions : constant Restrictions_Info :=
ALIs.Table (ALI).Restrictions;
+
begin
-- If the source was compiled with pragmas Restrictions,
-- Display these restrictions.
if Restrictions.Set /= (All_Restrictions => False) then
- Write_Eol; Write_Str (" Restrictions =>");
+ Write_Eol;
+ Write_Str (" pragma Restrictions =>");
-- For boolean restrictions, just display the name of the
-- restriction; for valued restrictions, also display the
end if;
end loop;
end if;
+
+ -- If the unit violates some Restrictions, display the list of
+ -- these restrictions.
+
+ if Restrictions.Violated /= (All_Restrictions => False) then
+ Write_Eol;
+ Write_Str (" Restrictions violated =>");
+
+ -- For boolean restrictions, just display the name of the
+ -- restriction. For valued restrictions, also display the
+ -- restriction value.
+
+ for Restriction in All_Restrictions loop
+ if Restrictions.Violated (Restriction) then
+ Write_Eol;
+ Write_Str (" ");
+ Write_Str (Image (Restriction));
+
+ if Restriction in All_Parameter_Restrictions then
+ if Restrictions.Count (Restriction) > 0 then
+ Write_Str (" =>");
+
+ if Restrictions.Unknown (Restriction) then
+ Write_Str (" at least");
+ end if;
+
+ Write_Str (Restrictions.Count (Restriction)'Img);
+ end if;
+ end if;
+ end if;
+ end loop;
+ end if;
end;
end if;
if Print_Source then
if Too_Long then
- Write_Eol; Write_Str (" ");
+ Write_Eol;
+ Write_Str (" ");
else
Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
end if;
-- Scan_Ls_Arg --
-------------------
- procedure Scan_Ls_Arg (Argv : String; And_Save : Boolean) is
+ procedure Scan_Ls_Arg (Argv : String) is
+ FD : File_Descriptor;
+ Len : Integer;
+
begin
pragma Assert (Argv'First = 1);
end if;
if Argv (1) = '-' then
-
if Argv'Length = 1 then
Fail ("switch character cannot be followed by a blank");
elsif (Argv'Length = 3 and then Argv (3) = '-')
or else (Argv'Length = 4 and then Argv (4) = '-')
then
- Fail ("Trailing ""-"" at the end of ", Argv, " forbidden.");
+ Fail ("Trailing ""-"" at the end of " & Argv & " forbidden.");
-- Processing for -Idir
elsif Argv (2) = 'I' then
- Add_Source_Dir (Argv (3 .. Argv'Last), And_Save);
- Add_Lib_Dir (Argv (3 .. Argv'Last), And_Save);
+ Add_Source_Dir (Argv (3 .. Argv'Last));
+ Add_Lib_Dir (Argv (3 .. Argv'Last));
-- Processing for -aIdir (to gcc this is like a -I switch)
elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
- Add_Source_Dir (Argv (4 .. Argv'Last), And_Save);
+ Add_Source_Dir (Argv (4 .. Argv'Last));
-- Processing for -aOdir
elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
- Add_Lib_Dir (Argv (4 .. Argv'Last), And_Save);
+ Add_Lib_Dir (Argv (4 .. Argv'Last));
-- Processing for -aLdir (to gnatbind this is like a -aO switch)
elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
- Add_Lib_Dir (Argv (4 .. Argv'Last), And_Save);
+ Add_Lib_Dir (Argv (4 .. Argv'Last));
-- Processing for -nostdinc
when 'o' => Reset_Print; Print_Object := True;
when 'v' => Verbose_Mode := True;
when 'd' => Dependable := True;
+ when 'l' => License := True;
+ when 'V' => Very_Verbose_Mode := True;
when others => null;
end case;
+ -- Processing for -files=file
+
+ elsif Argv'Length > 7 and then Argv (1 .. 7) = "-files=" then
+ FD := Open_Read (Argv (8 .. Argv'Last), GNAT.OS_Lib.Text);
+
+ if FD = Invalid_FD then
+ Osint.Fail ("could not find text file """ &
+ Argv (8 .. Argv'Last) & '"');
+ end if;
+
+ Len := Integer (File_Length (FD));
+
+ declare
+ Buffer : String (1 .. Len + 1);
+ Index : Positive := 1;
+ Last : Positive;
+
+ begin
+ -- Read the file
+
+ Len := Read (FD, Buffer (1)'Address, Len);
+ Buffer (Buffer'Last) := ASCII.NUL;
+ 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
+ Add_File (Buffer (Index .. Last - 1));
+ 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;
+
-- Processing for --RTS=path
elsif Argv'Length >= 5 and then Argv (1 .. 5) = "--RTS" then
-----------
procedure Usage is
-
- -- Start of processing for Usage
-
begin
-- Usage line
-- Line for -a
- Write_Str (" -a also output relevant predefined units");
+ Write_Str (" -a also output relevant predefined units");
Write_Eol;
-- Line for -u
- Write_Str (" -u output only relevant unit names");
+ Write_Str (" -u output only relevant unit names");
Write_Eol;
-- Line for -h
- Write_Str (" -h output this help message");
+ Write_Str (" -h output this help message");
Write_Eol;
-- Line for -s
- Write_Str (" -s output only relevant source names");
+ Write_Str (" -s output only relevant source names");
Write_Eol;
-- Line for -o
- Write_Str (" -o output only relevant object names");
+ Write_Str (" -o output only relevant object names");
Write_Eol;
-- Line for -d
- Write_Str (" -d output sources on which specified units depend");
+ Write_Str (" -d output sources on which specified units " &
+ "depend");
+ Write_Eol;
+
+ -- Line for -l
+
+ Write_Str (" -l output license information");
Write_Eol;
-- Line for -v
- Write_Str (" -v verbose output, full path and unit information");
+ Write_Str (" -v verbose output, full path and unit " &
+ "information");
Write_Eol;
Write_Eol;
+ -- Line for -files=
+
+ Write_Str (" -files=fil files are listed in text file 'fil'");
+ Write_Eol;
+
-- Line for -aI switch
- Write_Str (" -aIdir specify source files search path");
+ Write_Str (" -aIdir specify source files search path");
Write_Eol;
-- Line for -aO switch
- Write_Str (" -aOdir specify object files search path");
+ Write_Str (" -aOdir specify object files search path");
Write_Eol;
-- Line for -I switch
- Write_Str (" -Idir like -aIdir -aOdir");
+ Write_Str (" -Idir like -aIdir -aOdir");
Write_Eol;
-- Line for -I- switch
- Write_Str (" -I- do not look for sources & object files");
+ Write_Str (" -I- do not look for sources & object files");
Write_Str (" in the default directory");
Write_Eol;
-- Line for -nostdinc
- Write_Str (" -nostdinc do not look for source files");
+ Write_Str (" -nostdinc do not look for source files");
Write_Str (" in the system default directory");
Write_Eol;
-- Line for --RTS
- Write_Str (" --RTS=dir specify the default source and object search"
+ Write_Str (" --RTS=dir specify the default source and object search"
& " path");
Write_Eol;
Output_Status (ST, Verbose => True);
Write_Eol;
end loop;
-
end Usage;
- -- Start of processing for Gnatls
+ procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
+
+-- Start of processing for Gnatls
begin
-- Initialize standard packages
Csets.Initialize;
Snames.Initialize;
+ -- First check for --version or --help
+
+ Check_Version_And_Help ("GNATLS", "1997");
+
-- Loop to scan out arguments
Next_Arg := 1;
Next_Argv : String (1 .. Len_Arg (Next_Arg));
begin
Fill_Arg (Next_Argv'Address, Next_Arg);
- Scan_Ls_Arg (Next_Argv, And_Save => True);
+ Scan_Ls_Arg (Next_Argv);
end;
Next_Arg := Next_Arg + 1;
end loop Scan_Args;
- -- Add the source and object directories specified on the
- -- command line, if any, to the searched directories.
+ -- If -l (output license information) is given, it must be the only switch
+
+ if License and then Arg_Count /= 2 then
+ Write_Str ("Can't use -l with another switch");
+ Write_Eol;
+ Usage;
+ Exit_Program (E_Fatal);
+ end if;
+
+ -- Add the source and object directories specified on the command line, if
+ -- any, to the searched directories.
while First_Source_Dir /= null loop
Add_Src_Search_Dir (First_Source_Dir.Value.all);
if Verbose_Mode then
Targparm.Get_Target_Parameters;
- -- WARNING: the output of gnatls -v is used during the compilation
- -- and installation of GLADE to recreate sdefault.adb and locate
- -- the libgnat.a to use. Any change in the output of gnatls -v must
- -- be synchronized with the GLADE Dist/config.sdefault shell script.
-
- Write_Eol;
- Write_Str ("GNATLS ");
- Write_Str (Gnat_Version_String);
- Write_Str (" Copyright 1997-2004 Free Software Foundation, Inc.");
Write_Eol;
+ Display_Version ("GNATLS", "1997");
Write_Eol;
Write_Str ("Source Search Path:");
Write_Eol;
Write_Eol;
end loop;
+ Write_Eol;
+ Write_Eol;
+ Write_Str (Project_Search_Path);
+ Write_Eol;
+ Write_Str (" <Current_Directory>");
+ Write_Eol;
+
+ declare
+ Project_Path : String_Access := Getenv (Gpr_Project_Path);
+
+ Lib : constant String :=
+ Directory_Separator & "lib" & Directory_Separator;
+
+ First : Natural;
+ Last : Natural;
+
+ Add_Default_Dir : Boolean := True;
+
+ begin
+ -- If there is a project path, display each directory in the path
+
+ if Project_Path.all = "" then
+ Project_Path := Getenv (Ada_Project_Path);
+ end if;
+
+ if Project_Path.all /= "" then
+ First := Project_Path'First;
+ loop
+ while First <= Project_Path'Last
+ and then (Project_Path (First) = Path_Separator)
+ loop
+ First := First + 1;
+ end loop;
+
+ exit when First > Project_Path'Last;
+
+ Last := First;
+ while Last < Project_Path'Last
+ and then Project_Path (Last + 1) /= Path_Separator
+ loop
+ Last := Last + 1;
+ end loop;
+
+ -- If the directory is No_Default_Project_Dir, set
+ -- Add_Default_Dir to False.
+
+ if Project_Path (First .. Last) = No_Project_Default_Dir then
+ Add_Default_Dir := False;
+
+ elsif First /= Last or else Project_Path (First) /= '.' then
+
+ -- If the directory is ".", skip it as it is the current
+ -- directory and it is already the first directory in the
+ -- project path.
+
+ Write_Str (" ");
+ Write_Str
+ (To_Host_Dir_Spec
+ (Project_Path (First .. Last), True).all);
+ Write_Eol;
+ end if;
+
+ First := Last + 1;
+ end loop;
+ end if;
+
+ -- Add the default dir, except if "-" was one of the "directories"
+ -- specified in ADA_PROJECT_DIR.
+
+ if Add_Default_Dir then
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Sdefault.Search_Dir_Prefix.all);
+
+ -- On Windows, make sure that all directory separators are '\'
+
+ if Directory_Separator /= '/' then
+ for J in 1 .. Name_Len loop
+ if Name_Buffer (J) = '/' then
+ Name_Buffer (J) := Directory_Separator;
+ end if;
+ end loop;
+ end if;
+
+ -- Find the sequence "/lib/"
+
+ while Name_Len >= Lib'Length
+ and then Name_Buffer (Name_Len - 4 .. Name_Len) /= Lib
+ loop
+ Name_Len := Name_Len - 1;
+ end loop;
+
+ -- If the sequence "/lib"/ was found, display the default
+ -- directory <prefix>/lib/gnat/.
+
+ if Name_Len >= 5 then
+ Name_Buffer (Name_Len + 1 .. Name_Len + 4) := "gnat";
+ Name_Buffer (Name_Len + 5) := Directory_Separator;
+ Name_Len := Name_Len + 5;
+ Write_Str (" ");
+ Write_Line
+ (To_Host_Dir_Spec (Name_Buffer (1 .. Name_Len), True).all);
+ end if;
+ end if;
+ end;
+
Write_Eol;
end if;
Usage;
end if;
+ -- Output license information when requested
+
+ if License then
+ Output_License_Information;
+ Exit_Program (E_Success);
+ end if;
+
if not More_Lib_Files then
if not Print_Usage and then not Verbose_Mode then
Usage;
while More_Lib_Files loop
Main_File := Next_Main_Lib_File;
- Ali_File := Full_Lib_File_Name (Lib_File_Name (Main_File));
+ Ali_File := Full_Lib_File_Name (Lib_File_Name (Main_File));
if Ali_File = No_File then
- Write_Str ("Can't find library info for ");
- Get_Name_String (Main_File);
- Write_Char ('"');
- Write_Str (Name_Buffer (1 .. Name_Len));
- Write_Char ('"');
- Write_Eol;
+ if Very_Verbose_Mode then
+ GNATDIST.Output_No_ALI (Lib_File_Name (Main_File));
+
+ else
+ Write_Str ("Can't find library info for ");
+ Get_Name_String (Main_File);
+ Write_Char ('"'); -- "
+ Write_Str (Name_Buffer (1 .. Name_Len));
+ Write_Char ('"'); -- "
+ Write_Eol;
+ end if;
else
Ali_File := Strip_Directory (Ali_File);
end if;
end loop;
+ if Very_Verbose_Mode then
+ for A in ALIs.First .. ALIs.Last loop
+ GNATDIST.Output_ALI (A);
+ end loop;
+
+ return;
+ end if;
+
Find_General_Layout;
for Id in ALIs.First .. ALIs.Last loop
Write_Str ("depends upon");
Write_Eol;
Write_Str (" ");
-
else
Write_Eol;
end if;
projects / gcc.git / blobdiff