-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, 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, 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 Rident; use Rident;
with Sdefault;
with Snames;
+with Switch; use Switch;
with Targparm; use Targparm;
with Types; use Types;
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 --
Write_Eol;
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);
N_Indents := N_Indents - 1;
end Output_With;
- end GLADE;
+ end GNATDIST;
-----------
-- Image --
-------------------
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
-- 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
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;
Exit_Program (E_Fatal);
end if;
- -- Add the source and object directories specified on the
- -- command line, if any, to the searched directories.
+ -- 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-" &
- Current_Year &
- ", Free Software Foundation, Inc.");
- Write_Eol;
+ Display_Version ("GNATLS", "1997");
Write_Eol;
Write_Str ("Source Search Path:");
Write_Eol;
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;