-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 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 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";
- -- Name of the env. variable that contains path name(s) of directories
- -- where project files may reside.
+ -- 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.
Print_Object : Boolean := True;
-- Flags controlling the form of the output
- Dependable : Boolean := False; -- flag -d
- Also_Predef : Boolean := False;
-
- Very_Verbose_Mode : Boolean := False; -- flag -V
+ 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;
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
- ---------------------------------------
- -- GLADE specific output subprograms --
- ---------------------------------------
+ ------------------------------------------
+ -- GNATDIST specific output subprograms --
+ ------------------------------------------
- package GLADE is
+ package GNATDIST is
- -- Any modification to this subunit requires a synchronization
- -- with the GLADE implementation.
+ -- 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_ALI (A : ALI_Id);
procedure Output_No_ALI (Afile : File_Name_Type);
+ -- Comments required saying what this routine does ???
- end GLADE;
+ end GNATDIST;
-----------------
-- Add_Lib_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;
- -----------
- -- GLADE --
- -----------
+ --------------
+ -- GNATDIST --
+ --------------
- package body GLADE is
+ package body GNATDIST is
N_Flags : Natural;
N_Indents : Natural := 0;
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"));
+ (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.
+ -- 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 a specific format. That is several
- -- indentations and:
+ -- Output token using specific format. That is several indentations and:
--
-- T_No_ALI .. T_With : <token> & " =>" & NL
-- T_Source .. T_Kind : <token> & " => "
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 GLADE 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.
+ -- 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);
-- Output Name
- Output_Name (Units.Table (U).Uname);
+ Output_Name (Name_Id (Units.Table (U).Uname));
-- Output Kind
Output_Token (T_With);
N_Indents := N_Indents + 1;
- Output_Name (Withs.Table (W).Uname);
+ Output_Name (Name_Id (Withs.Table (W).Uname));
-- Output Kind
N_Indents := N_Indents - 1;
end Output_With;
- end GLADE;
+ 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);
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.SAL_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;
if U.Predefined then
Write_Str (" Predefined");
end if;
-
end if;
declare
Write_Str (" Restrictions violated =>");
-- For boolean restrictions, just display the name of the
- -- restriction; for valued restrictions, also display the
+ -- restriction. For valued restrictions, also display the
-- restriction value.
for Restriction in All_Restrictions loop
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
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;
-- Find the end of line
Last := Index;
-
while Last <= Buffer'Last
and then Buffer (Last) /= ASCII.LF
and then Buffer (Last) /= ASCII.CR
Add_File (Buffer (Index .. Last - 1));
end if;
- Index := Last;
-
-- Find the beginning of the next line
+ Index := Last;
while Buffer (Index) = ASCII.CR or else
Buffer (Index) = ASCII.LF
loop
"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 " &
end loop;
end Usage;
+ procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
+
-- Start of processing for Gnatls
begin
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_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);
Targparm.Get_Target_Parameters;
Write_Eol;
- Write_Str ("GNATLS ");
- Write_Str (Gnat_Version_String);
- Write_Eol;
- Write_Str ("Copyright 1997-2005 Free Software Foundation, Inc.");
- Write_Eol;
+ Display_Version ("GNATLS", "1997");
Write_Eol;
Write_Str ("Source Search Path:");
Write_Eol;
Write_Eol;
declare
- Project_Path : constant String_Access := Getenv (Ada_Project_Path);
+ Project_Path : String_Access := Getenv (Gpr_Project_Path);
- Lib : constant String :=
- Directory_Separator & "lib" & Directory_Separator;
+ Lib : constant String :=
+ Directory_Separator & "lib" & Directory_Separator;
First : Natural;
Last : Natural;
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)
exit when First > Project_Path'Last;
Last := First;
-
while Last < Project_Path'Last
and then Project_Path (Last + 1) /= Path_Separator
loop
end loop;
-- If the directory is No_Default_Project_Dir, set
- -- Add_Default_Dir to False
+ -- Add_Default_Dir to False.
if Project_Path (First .. Last) = No_Project_Default_Dir then
Add_Default_Dir := False;
-- project path.
Write_Str (" ");
- Write_Str (Project_Path (First .. Last));
+ Write_Str
+ (To_Host_Dir_Spec
+ (Project_Path (First .. Last), True).all);
Write_Eol;
end if;
-- 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_Str (Name_Buffer (1 .. Name_Len));
- Write_Str ("gnat");
- Write_Char (Directory_Separator);
- Write_Eol;
+ Write_Line
+ (To_Host_Dir_Spec (Name_Buffer (1 .. Name_Len), True).all);
end if;
end if;
end;
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;
if Ali_File = No_File then
if Very_Verbose_Mode then
- GLADE.Output_No_ALI (Lib_File_Name (Main_File));
+ GNATDIST.Output_No_ALI (Lib_File_Name (Main_File));
else
Write_Str ("Can't find library info for ");
if Very_Verbose_Mode then
for A in ALIs.First .. ALIs.Last loop
- GLADE.Output_ALI (A);
+ GNATDIST.Output_ALI (A);
end loop;
return;
projects / gcc.git / blobdiff