2391 lines
69 KiB
Ada
2391 lines
69 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- G N A T L S --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 1992-2020, 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 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 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. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
pragma Ada_2012;
|
|
|
|
with ALI; use ALI;
|
|
with ALI.Util; use ALI.Util;
|
|
with Binderr; use Binderr;
|
|
with Butil; use Butil;
|
|
with Csets;
|
|
with Fname; use Fname;
|
|
with Gnatvsn; use Gnatvsn;
|
|
with Make_Util; use Make_Util;
|
|
with Namet; use Namet;
|
|
with Opt; use Opt;
|
|
with Osint; use Osint;
|
|
with Osint.L; use Osint.L;
|
|
with Output; use Output;
|
|
with Rident; use Rident;
|
|
with Sdefault;
|
|
with Snames;
|
|
with Stringt;
|
|
with Switch; use Switch;
|
|
with Types; use Types;
|
|
|
|
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);
|
|
|
|
-- NOTE : The following string may be used by other tools, such as
|
|
-- GNAT Studio. 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.
|
|
|
|
Prj_Path : String_Access;
|
|
|
|
Max_Column : constant := 80;
|
|
|
|
No_Obj : aliased String := "<no_obj>";
|
|
|
|
No_Runtime : Boolean := False;
|
|
-- Set to True if there is no default runtime and --RTS= is not specified
|
|
|
|
type File_Status is (
|
|
OK, -- matching timestamp
|
|
Checksum_OK, -- only matching checksum
|
|
Not_Found, -- file not found on source PATH
|
|
Not_Same, -- neither checksum nor timestamp matching
|
|
Not_First_On_PATH); -- matching file hidden by Not_Same file on path
|
|
|
|
type Dir_Data;
|
|
type Dir_Ref is access Dir_Data;
|
|
|
|
type Dir_Data is record
|
|
Value : String_Access;
|
|
Next : Dir_Ref;
|
|
end record;
|
|
-- Simply linked list of dirs
|
|
|
|
First_Source_Dir : Dir_Ref;
|
|
Last_Source_Dir : Dir_Ref;
|
|
-- The list of source directories from the command line.
|
|
-- These directories are added using Osint.Add_Src_Search_Dir
|
|
-- after those of the GNAT Project File, if any.
|
|
|
|
First_Lib_Dir : Dir_Ref;
|
|
Last_Lib_Dir : Dir_Ref;
|
|
-- The list of object directories from the command line.
|
|
-- These directories are added using Osint.Add_Lib_Search_Dir
|
|
-- after those of the GNAT Project File, if any.
|
|
|
|
Main_File : File_Name_Type;
|
|
Ali_File : File_Name_Type;
|
|
Text : Text_Buffer_Ptr;
|
|
Next_Arg : Positive;
|
|
|
|
Too_Long : Boolean := False;
|
|
-- When True, lines are too long for multi-column output and each
|
|
-- item of information is on a different line.
|
|
|
|
Selective_Output : Boolean := False;
|
|
Print_Usage : Boolean := False;
|
|
Print_Unit : Boolean := True;
|
|
Print_Source : Boolean := True;
|
|
Print_Object : Boolean := True;
|
|
-- Flags controlling the form of the output
|
|
|
|
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;
|
|
Source_Start : Integer;
|
|
Source_End : Integer;
|
|
Object_Start : Integer;
|
|
Object_End : Integer;
|
|
-- Various column starts and ends
|
|
|
|
Spaces : constant String (1 .. Max_Column) := (others => ' ');
|
|
|
|
RTS_Specified : String_Access := null;
|
|
-- Used to detect multiple use of --RTS= switch
|
|
|
|
Exit_Status : Exit_Code_Type := E_Success;
|
|
-- Reset to E_Fatal if bad error found
|
|
|
|
-----------------------
|
|
-- Local Subprograms --
|
|
-----------------------
|
|
|
|
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);
|
|
-- 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 Find_Status
|
|
(FS : in out File_Name_Type;
|
|
Stamp : Time_Stamp_Type;
|
|
Checksum : Word;
|
|
Status : out File_Status);
|
|
-- Determine the file status (Status) of the file represented by FS with
|
|
-- the expected Stamp and checksum given as argument. FS will be updated
|
|
-- to the full file name if available.
|
|
|
|
function Corresponding_Sdep_Entry (A : ALI_Id; U : Unit_Id) return Sdep_Id;
|
|
-- Give the Sdep entry corresponding to the unit U in ali record A
|
|
|
|
procedure Output_Object (O : File_Name_Type);
|
|
-- Print out the name of the object when requested
|
|
|
|
procedure Output_Source (Sdep_I : Sdep_Id);
|
|
-- Print out the name and status of the source corresponding to this
|
|
-- sdep entry.
|
|
|
|
procedure Output_Status (FS : File_Status; Verbose : Boolean);
|
|
-- Print out FS either in a coded form if verbose is false or in an
|
|
-- expanded form otherwise.
|
|
|
|
procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id);
|
|
-- Print out information on the unit when requested
|
|
|
|
procedure Reset_Print;
|
|
-- Reset Print flags properly when selective output is chosen
|
|
|
|
procedure Scan_Ls_Arg (Argv : String);
|
|
-- Scan and process user specific arguments (Argv is a single argument)
|
|
|
|
procedure Search_RTS (Name : String);
|
|
-- Find include and objects path for the RTS name.
|
|
|
|
procedure Usage;
|
|
-- Print usage message
|
|
|
|
procedure Output_License_Information;
|
|
pragma No_Return (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
|
|
|
|
function Normalize (Path : String) return String;
|
|
-- Returns a normalized path name. On Windows, the directory separators are
|
|
-- set to '\' in Normalize_Pathname.
|
|
|
|
------------------------------------------
|
|
-- 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;
|
|
|
|
------------------------------
|
|
-- 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 --
|
|
-----------------
|
|
|
|
procedure Add_Lib_Dir (Dir : String) is
|
|
begin
|
|
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;
|
|
end Add_Lib_Dir;
|
|
|
|
--------------------
|
|
-- Add_Source_Dir --
|
|
--------------------
|
|
|
|
procedure Add_Source_Dir (Dir : String) is
|
|
begin
|
|
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;
|
|
end Add_Source_Dir;
|
|
|
|
------------------------------
|
|
-- Corresponding_Sdep_Entry --
|
|
------------------------------
|
|
|
|
function Corresponding_Sdep_Entry
|
|
(A : ALI_Id;
|
|
U : Unit_Id) return Sdep_Id
|
|
is
|
|
begin
|
|
for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
|
|
if Sdep.Table (D).Sfile = Units.Table (U).Sfile then
|
|
return D;
|
|
end if;
|
|
end loop;
|
|
|
|
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 {");
|
|
Exit_Program (E_Fatal);
|
|
return No_Sdep_Id;
|
|
end Corresponding_Sdep_Entry;
|
|
|
|
-------------------------
|
|
-- Find_General_Layout --
|
|
-------------------------
|
|
|
|
procedure Find_General_Layout is
|
|
Max_Unit_Length : Integer := 11;
|
|
Max_Src_Length : Integer := 11;
|
|
Max_Obj_Length : Integer := 11;
|
|
|
|
Len : Integer;
|
|
FS : File_Name_Type;
|
|
|
|
begin
|
|
-- Compute maximum of each column
|
|
|
|
for Id in ALIs.First .. ALIs.Last loop
|
|
Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
|
|
if Also_Predef or else not Is_Internal_Unit then
|
|
|
|
if Print_Unit then
|
|
Len := Name_Len - 1;
|
|
Max_Unit_Length := Integer'Max (Max_Unit_Length, Len);
|
|
end if;
|
|
|
|
if Print_Source then
|
|
FS := Full_Source_Name (ALIs.Table (Id).Sfile);
|
|
|
|
if FS = No_File then
|
|
Get_Name_String (ALIs.Table (Id).Sfile);
|
|
Name_Len := Name_Len + 13;
|
|
else
|
|
Get_Name_String (FS);
|
|
end if;
|
|
|
|
Max_Src_Length := Integer'Max (Max_Src_Length, Name_Len + 1);
|
|
end if;
|
|
|
|
if Print_Object then
|
|
if ALIs.Table (Id).No_Object then
|
|
Max_Obj_Length :=
|
|
Integer'Max (Max_Obj_Length, No_Obj'Length);
|
|
else
|
|
Get_Name_String (ALIs.Table (Id).Ofile_Full_Name);
|
|
Max_Obj_Length := Integer'Max (Max_Obj_Length, Name_Len + 1);
|
|
end if;
|
|
end if;
|
|
end if;
|
|
end loop;
|
|
|
|
-- Verify is output is not wider than maximum number of columns
|
|
|
|
Too_Long :=
|
|
Verbose_Mode
|
|
or else
|
|
(Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column;
|
|
|
|
-- Set start and end of columns
|
|
|
|
Object_Start := 1;
|
|
Object_End := Object_Start - 1;
|
|
|
|
if Print_Object then
|
|
Object_End := Object_Start + Max_Obj_Length;
|
|
end if;
|
|
|
|
Unit_Start := Object_End + 1;
|
|
Unit_End := Unit_Start - 1;
|
|
|
|
if Print_Unit then
|
|
Unit_End := Unit_Start + Max_Unit_Length;
|
|
end if;
|
|
|
|
Source_Start := Unit_End + 1;
|
|
|
|
if Source_Start > Spaces'Last then
|
|
Source_Start := Spaces'Last;
|
|
end if;
|
|
|
|
Source_End := Source_Start - 1;
|
|
|
|
if Print_Source then
|
|
Source_End := Source_Start + Max_Src_Length;
|
|
end if;
|
|
end Find_General_Layout;
|
|
|
|
-----------------
|
|
-- Find_Status --
|
|
-----------------
|
|
|
|
procedure Find_Status
|
|
(FS : in out File_Name_Type;
|
|
Stamp : Time_Stamp_Type;
|
|
Checksum : Word;
|
|
Status : out File_Status)
|
|
is
|
|
Tmp1 : File_Name_Type;
|
|
Tmp2 : File_Name_Type;
|
|
|
|
begin
|
|
Tmp1 := Full_Source_Name (FS);
|
|
|
|
if Tmp1 = No_File then
|
|
Status := Not_Found;
|
|
|
|
elsif File_Stamp (Tmp1) = Stamp then
|
|
FS := Tmp1;
|
|
Status := OK;
|
|
|
|
elsif Checksums_Match (Get_File_Checksum (FS), Checksum) then
|
|
FS := Tmp1;
|
|
Status := Checksum_OK;
|
|
|
|
else
|
|
Tmp2 := Matching_Full_Source_Name (FS, Stamp);
|
|
|
|
if Tmp2 = No_File then
|
|
Status := Not_Same;
|
|
FS := Tmp1;
|
|
|
|
else
|
|
Status := Not_First_On_PATH;
|
|
FS := Tmp2;
|
|
end if;
|
|
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
|
|
case T is
|
|
when T_No_ALI .. T_Flags =>
|
|
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;
|
|
|
|
when T_Preelaborated .. T_Body =>
|
|
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);
|
|
end case;
|
|
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 --
|
|
-----------
|
|
|
|
function Image (Restriction : Restriction_Id) return String is
|
|
Result : String := Restriction'Img;
|
|
Skip : Boolean := True;
|
|
|
|
begin
|
|
for J in Result'Range loop
|
|
if Skip then
|
|
Skip := False;
|
|
Result (J) := To_Upper (Result (J));
|
|
|
|
elsif Result (J) = '_' then
|
|
Skip := True;
|
|
|
|
else
|
|
Result (J) := To_Lower (Result (J));
|
|
end if;
|
|
end loop;
|
|
|
|
return Result;
|
|
end Image;
|
|
|
|
---------------
|
|
-- Normalize --
|
|
---------------
|
|
|
|
function Normalize (Path : String) return String is
|
|
begin
|
|
return Normalize_Pathname (Path);
|
|
end Normalize;
|
|
|
|
--------------------------------
|
|
-- Output_License_Information --
|
|
--------------------------------
|
|
|
|
procedure Output_License_Information is
|
|
begin
|
|
case Build_Type is
|
|
when others =>
|
|
Write_Str ("Please refer to file COPYING in your distribution"
|
|
& " for license terms.");
|
|
Write_Eol;
|
|
end case;
|
|
|
|
Exit_Program (E_Success);
|
|
end Output_License_Information;
|
|
|
|
-------------------
|
|
-- Output_Object --
|
|
-------------------
|
|
|
|
procedure Output_Object (O : File_Name_Type) is
|
|
Object_Name : String_Access;
|
|
|
|
begin
|
|
if Print_Object then
|
|
if O /= No_File then
|
|
Get_Name_String (O);
|
|
Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
|
|
else
|
|
Object_Name := No_Obj'Unchecked_Access;
|
|
end if;
|
|
|
|
Write_Str (Object_Name.all);
|
|
|
|
if Print_Source or else Print_Unit then
|
|
if Too_Long then
|
|
Write_Eol;
|
|
Write_Str (" ");
|
|
else
|
|
Write_Str (Spaces
|
|
(Object_Start + Object_Name'Length .. Object_End));
|
|
end if;
|
|
end if;
|
|
end if;
|
|
end Output_Object;
|
|
|
|
-------------------
|
|
-- Output_Source --
|
|
-------------------
|
|
|
|
procedure Output_Source (Sdep_I : Sdep_Id) is
|
|
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);
|
|
|
|
Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
|
|
|
|
if Verbose_Mode then
|
|
Write_Str (" Source => ");
|
|
Write_Str (Object_Name.all);
|
|
|
|
if not Too_Long then
|
|
Write_Str
|
|
(Spaces (Source_Start + Object_Name'Length .. Source_End));
|
|
end if;
|
|
|
|
Output_Status (Status, Verbose => True);
|
|
Write_Eol;
|
|
Write_Str (" ");
|
|
|
|
else
|
|
if not Selective_Output then
|
|
Output_Status (Status, Verbose => False);
|
|
end if;
|
|
|
|
Write_Str (Object_Name.all);
|
|
end if;
|
|
end if;
|
|
end Output_Source;
|
|
|
|
-------------------
|
|
-- Output_Status --
|
|
-------------------
|
|
|
|
procedure Output_Status (FS : File_Status; Verbose : Boolean) is
|
|
begin
|
|
if Verbose then
|
|
case FS is
|
|
when OK =>
|
|
Write_Str (" unchanged");
|
|
|
|
when Checksum_OK =>
|
|
Write_Str (" slightly modified");
|
|
|
|
when Not_Found =>
|
|
Write_Str (" file not found");
|
|
|
|
when Not_Same =>
|
|
Write_Str (" modified");
|
|
|
|
when Not_First_On_PATH =>
|
|
Write_Str (" unchanged version not first on PATH");
|
|
end case;
|
|
|
|
else
|
|
case FS is
|
|
when OK =>
|
|
Write_Str (" OK ");
|
|
|
|
when Checksum_OK =>
|
|
Write_Str (" MOK ");
|
|
|
|
when Not_Found =>
|
|
Write_Str (" ??? ");
|
|
|
|
when Not_Same =>
|
|
Write_Str (" DIF ");
|
|
|
|
when Not_First_On_PATH =>
|
|
Write_Str (" HID ");
|
|
end case;
|
|
end if;
|
|
end Output_Status;
|
|
|
|
-----------------
|
|
-- Output_Unit --
|
|
-----------------
|
|
|
|
procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id) is
|
|
Kind : Character;
|
|
U : Unit_Record renames Units.Table (U_Id);
|
|
|
|
begin
|
|
if Print_Unit then
|
|
Get_Name_String (U.Uname);
|
|
Kind := Name_Buffer (Name_Len);
|
|
Name_Len := Name_Len - 2;
|
|
|
|
if not Verbose_Mode then
|
|
Write_Str (Name_Buffer (1 .. Name_Len));
|
|
|
|
else
|
|
Write_Str ("Unit => ");
|
|
Write_Eol;
|
|
Write_Str (" Name => ");
|
|
Write_Str (Name_Buffer (1 .. Name_Len));
|
|
Write_Eol;
|
|
Write_Str (" Kind => ");
|
|
|
|
if Units.Table (U_Id).Unit_Kind = 'p' then
|
|
Write_Str ("package ");
|
|
else
|
|
Write_Str ("subprogram ");
|
|
end if;
|
|
|
|
if Kind = 's' then
|
|
Write_Str ("spec");
|
|
else
|
|
Write_Str ("body");
|
|
end if;
|
|
end if;
|
|
|
|
if Verbose_Mode then
|
|
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 =>");
|
|
|
|
if U.Preelab then
|
|
Write_Str (" Preelaborable");
|
|
end if;
|
|
|
|
if U.No_Elab then
|
|
Write_Str (" No_Elab_Code");
|
|
end if;
|
|
|
|
if U.Pure then
|
|
Write_Str (" Pure");
|
|
end if;
|
|
|
|
if U.Dynamic_Elab then
|
|
Write_Str (" Dynamic_Elab");
|
|
end if;
|
|
|
|
if U.Has_RACW then
|
|
Write_Str (" Has_RACW");
|
|
end if;
|
|
|
|
if U.Remote_Types then
|
|
Write_Str (" Remote_Types");
|
|
end if;
|
|
|
|
if U.Shared_Passive then
|
|
Write_Str (" Shared_Passive");
|
|
end if;
|
|
|
|
if U.RCI then
|
|
Write_Str (" RCI");
|
|
end if;
|
|
|
|
if U.Predefined then
|
|
Write_Str (" Predefined");
|
|
end if;
|
|
|
|
if U.Internal then
|
|
Write_Str (" Internal");
|
|
end if;
|
|
|
|
if U.Is_Generic then
|
|
Write_Str (" Is_Generic");
|
|
end if;
|
|
|
|
if U.Init_Scalars then
|
|
Write_Str (" Init_Scalars");
|
|
end if;
|
|
|
|
if U.SAL_Interface then
|
|
Write_Str (" SAL_Interface");
|
|
end if;
|
|
|
|
if U.Body_Needed_For_SAL then
|
|
Write_Str (" Body_Needed_For_SAL");
|
|
end if;
|
|
|
|
if U.Elaborate_Body then
|
|
Write_Str (" Elaborate Body");
|
|
end if;
|
|
|
|
if U.Remote_Types then
|
|
Write_Str (" Remote_Types");
|
|
end if;
|
|
|
|
if U.Shared_Passive then
|
|
Write_Str (" Shared_Passive");
|
|
end if;
|
|
|
|
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 (" pragma Restrictions =>");
|
|
|
|
-- 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.Set (Restriction) then
|
|
Write_Eol;
|
|
Write_Str (" ");
|
|
Write_Str (Image (Restriction));
|
|
|
|
if Restriction in All_Parameter_Restrictions then
|
|
Write_Str (" =>");
|
|
Write_Str (Restrictions.Value (Restriction)'Img);
|
|
end if;
|
|
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 (" ");
|
|
else
|
|
Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
|
|
end if;
|
|
end if;
|
|
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 is
|
|
-- not 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 do not want to resolve symbolic links, we cannot
|
|
-- use Locate_Regular_File. Instead 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 --
|
|
-----------------
|
|
|
|
procedure Reset_Print is
|
|
begin
|
|
if not Selective_Output then
|
|
Selective_Output := True;
|
|
Print_Source := False;
|
|
Print_Object := False;
|
|
Print_Unit := False;
|
|
end if;
|
|
end Reset_Print;
|
|
|
|
----------------
|
|
-- Search_RTS --
|
|
----------------
|
|
|
|
procedure Search_RTS (Name : String) is
|
|
Src_Path : String_Ptr;
|
|
Lib_Path : String_Ptr;
|
|
-- Paths for source and include subdirs
|
|
|
|
Rts_Full_Path : String_Access;
|
|
-- Full path for RTS project
|
|
|
|
begin
|
|
-- Try to find the RTS
|
|
|
|
Src_Path := Get_RTS_Search_Dir (Name, Include);
|
|
Lib_Path := Get_RTS_Search_Dir (Name, Objects);
|
|
|
|
-- For non-project RTS, both the include and the objects directories
|
|
-- must be present.
|
|
|
|
if Src_Path /= null and then Lib_Path /= null then
|
|
Add_Search_Dirs (Src_Path, Include);
|
|
Add_Search_Dirs (Lib_Path, Objects);
|
|
Prj_Env.Initialize_Default_Project_Path
|
|
(Prj_Path,
|
|
Target_Name => Sdefault.Target_Name.all,
|
|
Runtime_Name => Name);
|
|
return;
|
|
end if;
|
|
|
|
if Lib_Path /= null then
|
|
Osint.Fail ("RTS path not valid: missing adainclude directory");
|
|
elsif Src_Path /= null then
|
|
Osint.Fail ("RTS path not valid: missing adalib directory");
|
|
end if;
|
|
|
|
-- Try to find the RTS on the project path. First setup the project path
|
|
|
|
Prj_Env.Initialize_Default_Project_Path
|
|
(Prj_Path,
|
|
Target_Name => Sdefault.Target_Name.all,
|
|
Runtime_Name => Name);
|
|
|
|
Rts_Full_Path := Prj_Env.Get_Runtime_Path (Prj_Path, Name);
|
|
|
|
if Rts_Full_Path /= null then
|
|
|
|
-- Directory name was found on the project path. Look for the
|
|
-- include subdirectory(s).
|
|
|
|
Src_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Include);
|
|
|
|
if Src_Path /= null then
|
|
Add_Search_Dirs (Src_Path, Include);
|
|
|
|
-- Add the lib subdirectory if it exists
|
|
|
|
Lib_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Objects);
|
|
|
|
if Lib_Path /= null then
|
|
Add_Search_Dirs (Lib_Path, Objects);
|
|
end if;
|
|
|
|
return;
|
|
end if;
|
|
end if;
|
|
|
|
Osint.Fail
|
|
("RTS path not valid: missing adainclude and adalib directories");
|
|
end Search_RTS;
|
|
|
|
-------------------
|
|
-- Scan_Ls_Arg --
|
|
-------------------
|
|
|
|
procedure Scan_Ls_Arg (Argv : String) is
|
|
FD : File_Descriptor;
|
|
Len : Integer;
|
|
OK : Boolean;
|
|
|
|
begin
|
|
pragma Assert (Argv'First = 1);
|
|
|
|
if Argv'Length = 0 then
|
|
return;
|
|
end if;
|
|
|
|
OK := True;
|
|
if Argv (1) = '-' then
|
|
if Argv'Length = 1 then
|
|
Fail ("switch character cannot be followed by a blank");
|
|
|
|
-- Processing for -I-
|
|
|
|
elsif Argv (2 .. Argv'Last) = "I-" then
|
|
Opt.Look_In_Primary_Dir := False;
|
|
|
|
-- Forbid -?- or -??- where ? is any character
|
|
|
|
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.");
|
|
|
|
-- Processing for -Idir
|
|
|
|
elsif Argv (2) = 'I' then
|
|
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));
|
|
|
|
-- Processing for -aOdir
|
|
|
|
elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
|
|
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));
|
|
|
|
-- Processing for -aP<dir>
|
|
|
|
elsif Argv'Length > 3 and then Argv (1 .. 3) = "-aP" then
|
|
Prj_Env.Add_Directories (Prj_Path, Argv (4 .. Argv'Last));
|
|
|
|
-- Processing for -nostdinc
|
|
|
|
elsif Argv (2 .. Argv'Last) = "nostdinc" then
|
|
Opt.No_Stdinc := True;
|
|
|
|
-- Processing for one character switches
|
|
|
|
elsif Argv'Length = 2 then
|
|
case Argv (2) is
|
|
when 'a' => Also_Predef := True;
|
|
when 'h' => Print_Usage := True;
|
|
when 'u' => Reset_Print; Print_Unit := True;
|
|
when 's' => Reset_Print; Print_Source := True;
|
|
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 => OK := False;
|
|
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
|
|
if Argv'Length <= 6 or else Argv (6) /= '='then
|
|
Osint.Fail ("missing path for --RTS");
|
|
|
|
else
|
|
-- Check that it is the first time we see this switch or, if
|
|
-- it is not the first time, the same path is specified.
|
|
|
|
if RTS_Specified = null then
|
|
RTS_Specified := new String'(Argv (7 .. Argv'Last));
|
|
|
|
elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
|
|
Osint.Fail ("--RTS cannot be specified multiple times");
|
|
end if;
|
|
|
|
-- Valid --RTS switch
|
|
|
|
Opt.No_Stdinc := True;
|
|
Opt.RTS_Switch := True;
|
|
end if;
|
|
|
|
else
|
|
OK := False;
|
|
end if;
|
|
|
|
-- If not a switch, it must be a file name
|
|
|
|
else
|
|
Add_File (Argv);
|
|
end if;
|
|
|
|
if not OK then
|
|
Write_Str ("warning: unknown switch """);
|
|
Write_Str (Argv);
|
|
Write_Line ("""");
|
|
end if;
|
|
|
|
end Scan_Ls_Arg;
|
|
|
|
-----------
|
|
-- Usage --
|
|
-----------
|
|
|
|
procedure Usage is
|
|
begin
|
|
-- Usage line
|
|
|
|
Write_Str ("Usage: ");
|
|
Osint.Write_Program_Name;
|
|
Write_Str (" switches [list of object files]");
|
|
Write_Eol;
|
|
Write_Eol;
|
|
|
|
-- GNATLS switches
|
|
|
|
Write_Str ("switches:");
|
|
Write_Eol;
|
|
|
|
Display_Usage_Version_And_Help;
|
|
|
|
-- Line for -a
|
|
|
|
Write_Str (" -a also output relevant predefined units");
|
|
Write_Eol;
|
|
|
|
-- Line for -u
|
|
|
|
Write_Str (" -u output only relevant unit names");
|
|
Write_Eol;
|
|
|
|
-- Line for -h
|
|
|
|
Write_Str (" -h output this help message");
|
|
Write_Eol;
|
|
|
|
-- Line for -s
|
|
|
|
Write_Str (" -s output only relevant source names");
|
|
Write_Eol;
|
|
|
|
-- Line for -o
|
|
|
|
Write_Str (" -o output only relevant object names");
|
|
Write_Eol;
|
|
|
|
-- Line for -d
|
|
|
|
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_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_Eol;
|
|
|
|
-- Line for -aO switch
|
|
|
|
Write_Str (" -aOdir specify object files search path");
|
|
Write_Eol;
|
|
|
|
-- Line for -aP switch
|
|
|
|
Write_Str (" -aPdir specify project search path");
|
|
Write_Eol;
|
|
|
|
-- Line for -I switch
|
|
|
|
Write_Str (" -Idir like -aIdir -aOdir");
|
|
Write_Eol;
|
|
|
|
-- Line for -I- switch
|
|
|
|
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 (" in the system default directory");
|
|
Write_Eol;
|
|
|
|
-- Line for --RTS
|
|
|
|
Write_Str (" --RTS=dir specify the default source and object search"
|
|
& " path");
|
|
Write_Eol;
|
|
|
|
-- File Status explanation
|
|
|
|
Write_Eol;
|
|
Write_Str (" file status can be:");
|
|
Write_Eol;
|
|
|
|
for ST in File_Status loop
|
|
Write_Str (" ");
|
|
Output_Status (ST, Verbose => False);
|
|
Write_Str (" ==> ");
|
|
Output_Status (ST, Verbose => True);
|
|
Write_Eol;
|
|
end loop;
|
|
end Usage;
|
|
|
|
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;
|
|
Stringt.Initialize;
|
|
|
|
-- First check for --version or --help
|
|
|
|
Check_Version_And_Help ("GNATLS", "1992");
|
|
|
|
-- Loop to scan out arguments
|
|
|
|
Next_Arg := 1;
|
|
Scan_Args : while Next_Arg < Arg_Count loop
|
|
declare
|
|
Next_Argv : String (1 .. Len_Arg (Next_Arg));
|
|
begin
|
|
Fill_Arg (Next_Argv'Address, Next_Arg);
|
|
Scan_Ls_Arg (Next_Argv);
|
|
end;
|
|
|
|
Next_Arg := Next_Arg + 1;
|
|
end loop Scan_Args;
|
|
|
|
-- If -l (output license information) is given, it must be the only switch
|
|
|
|
if License then
|
|
if Arg_Count = 2 then
|
|
Output_License_Information;
|
|
Exit_Program (E_Success);
|
|
|
|
else
|
|
Set_Standard_Error;
|
|
Write_Str ("Can't use -l with another switch");
|
|
Write_Eol;
|
|
Try_Help;
|
|
Exit_Program (E_Fatal);
|
|
end if;
|
|
end if;
|
|
|
|
-- Handle --RTS switch
|
|
|
|
if RTS_Specified /= null then
|
|
Search_RTS (RTS_Specified.all);
|
|
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);
|
|
First_Source_Dir := First_Source_Dir.Next;
|
|
end loop;
|
|
|
|
while First_Lib_Dir /= null loop
|
|
Add_Lib_Search_Dir (First_Lib_Dir.Value.all);
|
|
First_Lib_Dir := First_Lib_Dir.Next;
|
|
end loop;
|
|
|
|
-- Finally, add the default directories
|
|
|
|
Osint.Add_Default_Search_Dirs;
|
|
|
|
-- If --RTS= is not specified, check if there is a default runtime
|
|
|
|
if RTS_Specified = null then
|
|
declare
|
|
FD : File_Descriptor;
|
|
Text : Source_Buffer_Ptr;
|
|
Hi : Source_Ptr;
|
|
|
|
begin
|
|
Name_Buffer (1 .. 10) := "system.ads";
|
|
Name_Len := 10;
|
|
|
|
Read_Source_File (Name_Find, 0, Hi, Text, FD);
|
|
|
|
if Null_Source_Buffer_Ptr (Text) then
|
|
No_Runtime := True;
|
|
end if;
|
|
end;
|
|
end if;
|
|
|
|
if Verbose_Mode then
|
|
Write_Eol;
|
|
Display_Version ("GNATLS", "1997");
|
|
Write_Eol;
|
|
|
|
if No_Runtime then
|
|
Write_Str
|
|
("Default runtime not available. Use --RTS= with a valid runtime");
|
|
Write_Eol;
|
|
Write_Eol;
|
|
Exit_Status := E_Warnings;
|
|
end if;
|
|
|
|
Write_Str ("Source Search Path:");
|
|
Write_Eol;
|
|
|
|
for J in 1 .. Nb_Dir_In_Src_Search_Path loop
|
|
Write_Str (" ");
|
|
|
|
if Dir_In_Src_Search_Path (J)'Length = 0 then
|
|
Write_Str ("<Current_Directory>");
|
|
Write_Eol;
|
|
|
|
elsif not No_Runtime then
|
|
Write_Str
|
|
(Normalize
|
|
(To_Host_Dir_Spec
|
|
(Dir_In_Src_Search_Path (J).all, True).all));
|
|
Write_Eol;
|
|
end if;
|
|
end loop;
|
|
|
|
Write_Eol;
|
|
Write_Eol;
|
|
Write_Str ("Object Search Path:");
|
|
Write_Eol;
|
|
|
|
for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
|
|
Write_Str (" ");
|
|
|
|
if Dir_In_Obj_Search_Path (J)'Length = 0 then
|
|
Write_Str ("<Current_Directory>");
|
|
Write_Eol;
|
|
|
|
elsif not No_Runtime then
|
|
Write_Str
|
|
(Normalize
|
|
(To_Host_Dir_Spec
|
|
(Dir_In_Obj_Search_Path (J).all, True).all));
|
|
Write_Eol;
|
|
end if;
|
|
end loop;
|
|
|
|
Write_Eol;
|
|
Write_Eol;
|
|
Write_Str (Project_Search_Path);
|
|
Write_Eol;
|
|
Write_Str (" <Current_Directory>");
|
|
Write_Eol;
|
|
|
|
Prj_Env.Initialize_Default_Project_Path
|
|
(Prj_Path, Target_Name => Sdefault.Target_Name.all);
|
|
|
|
declare
|
|
First : Natural;
|
|
Last : Natural;
|
|
|
|
begin
|
|
|
|
if Prj_Path.all /= "" then
|
|
First := Prj_Path'First;
|
|
loop
|
|
while First <= Prj_Path'Last
|
|
and then (Prj_Path (First) = Path_Separator)
|
|
loop
|
|
First := First + 1;
|
|
end loop;
|
|
|
|
exit when First > Prj_Path'Last;
|
|
|
|
Last := First;
|
|
while Last < Prj_Path'Last
|
|
and then Prj_Path (Last + 1) /= Path_Separator
|
|
loop
|
|
Last := Last + 1;
|
|
end loop;
|
|
|
|
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
|
|
-- project path.
|
|
|
|
Write_Str (" ");
|
|
Write_Str
|
|
(Normalize
|
|
(To_Host_Dir_Spec
|
|
(Prj_Path (First .. Last), True).all));
|
|
Write_Eol;
|
|
end if;
|
|
|
|
First := Last + 1;
|
|
end loop;
|
|
end if;
|
|
end;
|
|
|
|
Write_Eol;
|
|
end if;
|
|
|
|
-- Output usage information when requested
|
|
|
|
if Print_Usage then
|
|
Usage;
|
|
end if;
|
|
|
|
if not More_Lib_Files then
|
|
if not Print_Usage and then not Verbose_Mode then
|
|
if Arg_Count = 1 then
|
|
Usage;
|
|
else
|
|
Try_Help;
|
|
Exit_Status := E_Fatal;
|
|
end if;
|
|
end if;
|
|
|
|
Exit_Program (Exit_Status);
|
|
end if;
|
|
|
|
Initialize_ALI;
|
|
Initialize_ALI_Source;
|
|
|
|
-- Print out all libraries for which no ALI files can be located
|
|
|
|
while More_Lib_Files loop
|
|
Main_File := Next_Main_Lib_File;
|
|
Ali_File := Full_Lib_File_Name (Lib_File_Name (Main_File));
|
|
|
|
if Ali_File = No_File then
|
|
if Very_Verbose_Mode then
|
|
GNATDIST.Output_No_ALI (Lib_File_Name (Main_File));
|
|
|
|
else
|
|
Set_Standard_Error;
|
|
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;
|
|
Exit_Status := E_Fatal;
|
|
end if;
|
|
|
|
else
|
|
Ali_File := Strip_Directory (Ali_File);
|
|
|
|
if Get_Name_Table_Int (Ali_File) = 0 then
|
|
Text := Read_Library_Info (Ali_File, True);
|
|
|
|
declare
|
|
Discard : ALI_Id;
|
|
begin
|
|
Discard :=
|
|
Scan_ALI
|
|
(Ali_File,
|
|
Text,
|
|
Ignore_ED => False,
|
|
Err => False,
|
|
Ignore_Errors => True);
|
|
end;
|
|
|
|
Free (Text);
|
|
end if;
|
|
end if;
|
|
end loop;
|
|
|
|
-- Reset default output file descriptor, if needed
|
|
|
|
Set_Standard_Output;
|
|
|
|
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
|
|
declare
|
|
Last_U : Unit_Id;
|
|
|
|
begin
|
|
Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
|
|
|
|
if Also_Predef or else not Is_Internal_Unit then
|
|
if ALIs.Table (Id).No_Object then
|
|
Output_Object (No_File);
|
|
else
|
|
Output_Object (ALIs.Table (Id).Ofile_Full_Name);
|
|
end if;
|
|
|
|
-- In verbose mode print all main units in the ALI file, otherwise
|
|
-- just print the first one to ease columnwise printout
|
|
|
|
if Verbose_Mode then
|
|
Last_U := ALIs.Table (Id).Last_Unit;
|
|
else
|
|
Last_U := ALIs.Table (Id).First_Unit;
|
|
end if;
|
|
|
|
for U in ALIs.Table (Id).First_Unit .. Last_U loop
|
|
if U /= ALIs.Table (Id).First_Unit
|
|
and then Selective_Output
|
|
and then Print_Unit
|
|
then
|
|
Write_Eol;
|
|
end if;
|
|
|
|
Output_Unit (Id, U);
|
|
|
|
-- Output source now, unless if it will be done as part of
|
|
-- outputing dependencies.
|
|
|
|
if not (Dependable and then Print_Source) then
|
|
Output_Source (Corresponding_Sdep_Entry (Id, U));
|
|
end if;
|
|
end loop;
|
|
|
|
-- Print out list of units on which this unit depends (D lines)
|
|
|
|
if Dependable and then Print_Source then
|
|
if Verbose_Mode then
|
|
Write_Str ("depends upon");
|
|
Write_Eol;
|
|
Write_Str (" ");
|
|
else
|
|
Write_Eol;
|
|
end if;
|
|
|
|
for D in
|
|
ALIs.Table (Id).First_Sdep .. ALIs.Table (Id).Last_Sdep
|
|
loop
|
|
if Also_Predef
|
|
or else not Is_Internal_File_Name (Sdep.Table (D).Sfile)
|
|
then
|
|
if Verbose_Mode then
|
|
Write_Str (" ");
|
|
Output_Source (D);
|
|
|
|
elsif Too_Long then
|
|
Write_Str (" ");
|
|
Output_Source (D);
|
|
Write_Eol;
|
|
|
|
else
|
|
Write_Str (Spaces (1 .. Source_Start - 2));
|
|
Output_Source (D);
|
|
Write_Eol;
|
|
end if;
|
|
end if;
|
|
end loop;
|
|
end if;
|
|
|
|
Write_Eol;
|
|
end if;
|
|
end;
|
|
end loop;
|
|
|
|
-- All done. Set proper exit status
|
|
|
|
Namet.Finalize;
|
|
Exit_Program (Exit_Status);
|
|
end Gnatls;
|