1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
29 with ALI
.Util
; use ALI
.Util
;
30 with Binderr
; use Binderr
;
31 with Butil
; use Butil
;
33 with Fname
; use Fname
;
34 with Gnatvsn
; use Gnatvsn
;
35 with Make_Util
; use Make_Util
;
36 with Namet
; use Namet
;
38 with Osint
; use Osint
;
39 with Osint
.L
; use Osint
.L
;
40 with Output
; use Output
;
41 with Rident
; use Rident
;
45 with Switch
; use Switch
;
46 with Types
; use Types
;
48 with GNAT
.Case_Util
; use GNAT
.Case_Util
;
49 with GNAT
.Command_Line
; use GNAT
.Command_Line
;
50 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
51 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
54 pragma Ident
(Gnat_Static_Version_String
);
56 -- NOTE : The following string may be used by other tools, such as
57 -- GNAT Studio. So it can only be modified if these other uses are checked
60 Project_Search_Path
: constant String := "Project Search Path:";
61 -- Label displayed in verbose mode before the directories in the project
62 -- search path. Do not modify without checking NOTE above.
64 Prj_Path
: String_Access
;
66 Max_Column
: constant := 80;
68 No_Obj
: aliased String := "<no_obj>";
70 No_Runtime
: Boolean := False;
71 -- Set to True if there is no default runtime and --RTS= is not specified
74 OK
, -- matching timestamp
75 Checksum_OK
, -- only matching checksum
76 Not_Found
, -- file not found on source PATH
77 Not_Same
, -- neither checksum nor timestamp matching
78 Not_First_On_PATH
); -- matching file hidden by Not_Same file on path
81 type Dir_Ref
is access Dir_Data
;
83 type Dir_Data
is record
84 Value
: String_Access
;
87 -- Simply linked list of dirs
89 First_Source_Dir
: Dir_Ref
;
90 Last_Source_Dir
: Dir_Ref
;
91 -- The list of source directories from the command line.
92 -- These directories are added using Osint.Add_Src_Search_Dir
93 -- after those of the GNAT Project File, if any.
95 First_Lib_Dir
: Dir_Ref
;
96 Last_Lib_Dir
: Dir_Ref
;
97 -- The list of object directories from the command line.
98 -- These directories are added using Osint.Add_Lib_Search_Dir
99 -- after those of the GNAT Project File, if any.
101 Main_File
: File_Name_Type
;
102 Ali_File
: File_Name_Type
;
103 Text
: Text_Buffer_Ptr
;
106 Too_Long
: Boolean := False;
107 -- When True, lines are too long for multi-column output and each
108 -- item of information is on a different line.
110 Selective_Output
: Boolean := False;
111 Print_Usage
: Boolean := False;
112 Print_Unit
: Boolean := True;
113 Print_Source
: Boolean := True;
114 Print_Object
: Boolean := True;
115 -- Flags controlling the form of the output
117 Also_Predef
: Boolean := False; -- -a
118 Dependable
: Boolean := False; -- -d
119 License
: Boolean := False; -- -l
120 Very_Verbose_Mode
: Boolean := False; -- -V
121 -- Command line flags
123 Unit_Start
: Integer;
125 Source_Start
: Integer;
126 Source_End
: Integer;
127 Object_Start
: Integer;
128 Object_End
: Integer;
129 -- Various column starts and ends
131 Spaces
: constant String (1 .. Max_Column
) := (others => ' ');
133 RTS_Specified
: String_Access
:= null;
134 -- Used to detect multiple use of --RTS= switch
136 Exit_Status
: Exit_Code_Type
:= E_Success
;
137 -- Reset to E_Fatal if bad error found
139 -----------------------
140 -- Local Subprograms --
141 -----------------------
143 procedure Add_Lib_Dir
(Dir
: String);
144 -- Add an object directory in the list First_Lib_Dir-Last_Lib_Dir
146 procedure Add_Source_Dir
(Dir
: String);
147 -- Add a source directory in the list First_Source_Dir-Last_Source_Dir
149 procedure Find_General_Layout
;
150 -- Determine the structure of the output (multi columns or not, etc)
152 procedure Find_Status
153 (FS
: in out File_Name_Type
;
154 Stamp
: Time_Stamp_Type
;
156 Status
: out File_Status
);
157 -- Determine the file status (Status) of the file represented by FS with
158 -- the expected Stamp and checksum given as argument. FS will be updated
159 -- to the full file name if available.
161 function Corresponding_Sdep_Entry
(A
: ALI_Id
; U
: Unit_Id
) return Sdep_Id
;
162 -- Give the Sdep entry corresponding to the unit U in ali record A
164 procedure Output_Object
(O
: File_Name_Type
);
165 -- Print out the name of the object when requested
167 procedure Output_Source
(Sdep_I
: Sdep_Id
);
168 -- Print out the name and status of the source corresponding to this
171 procedure Output_Status
(FS
: File_Status
; Verbose
: Boolean);
172 -- Print out FS either in a coded form if verbose is false or in an
173 -- expanded form otherwise.
175 procedure Output_Unit
(ALI
: ALI_Id
; U_Id
: Unit_Id
);
176 -- Print out information on the unit when requested
178 procedure Reset_Print
;
179 -- Reset Print flags properly when selective output is chosen
181 procedure Scan_Ls_Arg
(Argv
: String);
182 -- Scan and process user specific arguments (Argv is a single argument)
184 procedure Search_RTS
(Name
: String);
185 -- Find include and objects path for the RTS name.
188 -- Print usage message
190 procedure Output_License_Information
;
191 pragma No_Return
(Output_License_Information
);
192 -- Output license statement, and if not found, output reference to COPYING
194 function Image
(Restriction
: Restriction_Id
) return String;
195 -- Returns the capitalized image of Restriction
197 function Normalize
(Path
: String) return String;
198 -- Returns a normalized path name. On Windows, the directory separators are
199 -- set to '\' in Normalize_Pathname.
201 ------------------------------------------
202 -- GNATDIST specific output subprograms --
203 ------------------------------------------
207 -- Any modification to this subunit requires synchronization with the
210 procedure Output_ALI
(A
: ALI_Id
);
211 -- Comment required saying what this routine does ???
213 procedure Output_No_ALI
(Afile
: File_Name_Type
);
214 -- Comments required saying what this routine does ???
218 ------------------------------
219 -- Support for project path --
220 ------------------------------
224 procedure Initialize_Default_Project_Path
225 (Self
: in out String_Access
;
226 Target_Name
: String;
227 Runtime_Name
: String := "");
228 -- Initialize Self. It will then contain the default project path on
229 -- the given target and runtime (including directories specified by the
230 -- environment variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and
231 -- ADA_PROJECT_PATH). If one of the directory or Target_Name is "-",
232 -- then the path contains only those directories specified by the
233 -- environment variables (except "-"). This does nothing if Self has
234 -- already been initialized.
236 procedure Add_Directories
237 (Self
: in out String_Access
;
239 Prepend
: Boolean := False);
240 -- Add one or more directories to the path. Directories added with this
241 -- procedure are added in order after the current directory and before
242 -- the path given by the environment variable GPR_PROJECT_PATH. A value
243 -- of "-" will remove the default project directory from the project
246 -- Calls to this subprogram must be performed before the first call to
247 -- Find_Project below, or PATH will be added at the end of the search
250 function Get_Runtime_Path
251 (Self
: String_Access
;
252 Path
: String) return String_Access
;
253 -- Compute the full path for the project-based runtime name.
254 -- Path is simply searched on the project path.
262 procedure Add_Lib_Dir
(Dir
: String) is
264 if First_Lib_Dir
= null then
267 (Value => new String'(Dir
),
269 Last_Lib_Dir
:= First_Lib_Dir
;
274 (Value => new String'(Dir
),
276 Last_Lib_Dir
:= Last_Lib_Dir
.Next
;
284 procedure Add_Source_Dir
(Dir
: String) is
286 if First_Source_Dir
= null then
289 (Value => new String'(Dir
),
291 Last_Source_Dir
:= First_Source_Dir
;
294 Last_Source_Dir
.Next
:=
296 (Value => new String'(Dir
),
298 Last_Source_Dir
:= Last_Source_Dir
.Next
;
302 ------------------------------
303 -- Corresponding_Sdep_Entry --
304 ------------------------------
306 function Corresponding_Sdep_Entry
308 U
: Unit_Id
) return Sdep_Id
311 for D
in ALIs
.Table
(A
).First_Sdep
.. ALIs
.Table
(A
).Last_Sdep
loop
312 if Sdep
.Table
(D
).Sfile
= Units
.Table
(U
).Sfile
then
317 Error_Msg_Unit_1
:= Units
.Table
(U
).Uname
;
318 Error_Msg_File_1
:= ALIs
.Table
(A
).Afile
;
320 Error_Msg
("wrong ALI format, can't find dependency line for $ in {");
321 Exit_Program
(E_Fatal
);
323 end Corresponding_Sdep_Entry
;
325 -------------------------
326 -- Find_General_Layout --
327 -------------------------
329 procedure Find_General_Layout
is
330 Max_Unit_Length
: Integer := 11;
331 Max_Src_Length
: Integer := 11;
332 Max_Obj_Length
: Integer := 11;
338 -- Compute maximum of each column
340 for Id
in ALIs
.First
.. ALIs
.Last
loop
341 Get_Name_String
(Units
.Table
(ALIs
.Table
(Id
).First_Unit
).Uname
);
342 if Also_Predef
or else not Is_Internal_Unit
then
346 Max_Unit_Length
:= Integer'Max (Max_Unit_Length
, Len
);
350 FS
:= Full_Source_Name
(ALIs
.Table
(Id
).Sfile
);
353 Get_Name_String
(ALIs
.Table
(Id
).Sfile
);
354 Name_Len
:= Name_Len
+ 13;
356 Get_Name_String
(FS
);
359 Max_Src_Length
:= Integer'Max (Max_Src_Length
, Name_Len
+ 1);
363 if ALIs
.Table
(Id
).No_Object
then
365 Integer'Max (Max_Obj_Length
, No_Obj
'Length);
367 Get_Name_String
(ALIs
.Table
(Id
).Ofile_Full_Name
);
368 Max_Obj_Length
:= Integer'Max (Max_Obj_Length
, Name_Len
+ 1);
374 -- Verify is output is not wider than maximum number of columns
379 (Max_Unit_Length
+ Max_Src_Length
+ Max_Obj_Length
) > Max_Column
;
381 -- Set start and end of columns
384 Object_End
:= Object_Start
- 1;
387 Object_End
:= Object_Start
+ Max_Obj_Length
;
390 Unit_Start
:= Object_End
+ 1;
391 Unit_End
:= Unit_Start
- 1;
394 Unit_End
:= Unit_Start
+ Max_Unit_Length
;
397 Source_Start
:= Unit_End
+ 1;
399 if Source_Start
> Spaces
'Last then
400 Source_Start
:= Spaces
'Last;
403 Source_End
:= Source_Start
- 1;
406 Source_End
:= Source_Start
+ Max_Src_Length
;
408 end Find_General_Layout
;
414 procedure Find_Status
415 (FS
: in out File_Name_Type
;
416 Stamp
: Time_Stamp_Type
;
418 Status
: out File_Status
)
420 Tmp1
: File_Name_Type
;
421 Tmp2
: File_Name_Type
;
424 Tmp1
:= Full_Source_Name
(FS
);
426 if Tmp1
= No_File
then
429 elsif File_Stamp
(Tmp1
) = Stamp
then
433 elsif Checksums_Match
(Get_File_Checksum
(FS
), Checksum
) then
435 Status
:= Checksum_OK
;
438 Tmp2
:= Matching_Full_Source_Name
(FS
, Stamp
);
440 if Tmp2
= No_File
then
445 Status
:= Not_First_On_PATH
;
455 package body GNATDIST
is
458 N_Indents
: Natural := 0;
489 Image
: constant array (Token_Type
) of String_Access
:=
490 (T_No_ALI
=> new String'("No_ALI"),
491 T_ALI => new String'("ALI"),
492 T_Unit
=> new String'("Unit"),
493 T_With => new String'("With"),
494 T_Source
=> new String'("Source"),
495 T_Afile => new String'("Afile"),
496 T_Ofile
=> new String'("Ofile"),
497 T_Sfile => new String'("Sfile"),
498 T_Name
=> new String'("Name"),
499 T_Main => new String'("Main"),
500 T_Kind
=> new String'("Kind"),
501 T_Flags => new String'("Flags"),
502 T_Preelaborated
=> new String'("Preelaborated"),
503 T_Pure => new String'("Pure"),
504 T_Has_RACW
=> new String'("Has_RACW"),
505 T_Remote_Types => new String'("Remote_Types"),
506 T_Shared_Passive
=> new String'("Shared_Passive"),
507 T_RCI => new String'("RCI"),
508 T_Predefined
=> new String'("Predefined"),
509 T_Internal => new String'("Internal"),
510 T_Is_Generic
=> new String'("Is_Generic"),
511 T_Procedure => new String'("procedure"),
512 T_Function
=> new String'("function"),
513 T_Package => new String'("package"),
514 T_Subprogram
=> new String'("subprogram"),
515 T_Spec => new String'("spec"),
516 T_Body
=> new String'("body"));
518 procedure Output_Name (N : Name_Id);
519 -- Remove any encoding info (%b and %s) and output N
521 procedure Output_Afile (A : File_Name_Type);
522 procedure Output_Ofile (O : File_Name_Type);
523 procedure Output_Sfile (S : File_Name_Type);
524 -- Output various names. Check that the name is different from no name.
525 -- Otherwise, skip the output.
527 procedure Output_Token (T : Token_Type);
528 -- Output token using specific format. That is several indentations and:
530 -- T_No_ALI .. T_With : <token> & " =>" & NL
531 -- T_Source .. T_Kind : <token> & " => "
532 -- T_Flags : <token> & " =>"
533 -- T_Preelab .. T_Body : " " & <token>
535 procedure Output_Sdep (S : Sdep_Id);
536 procedure Output_Unit (U : Unit_Id);
537 procedure Output_With (W : With_Id);
538 -- Output this entry as a global section (like ALIs)
544 procedure Output_Afile (A : File_Name_Type) is
547 Output_Token (T_Afile);
557 procedure Output_ALI (A : ALI_Id) is
559 Output_Token (T_ALI);
560 N_Indents := N_Indents + 1;
562 Output_Afile (ALIs.Table (A).Afile);
563 Output_Ofile (ALIs.Table (A).Ofile_Full_Name);
564 Output_Sfile (ALIs.Table (A).Sfile);
568 if ALIs.Table (A).Main_Program /= None then
569 Output_Token (T_Main);
571 if ALIs.Table (A).Main_Program = Proc then
572 Output_Token (T_Procedure);
574 Output_Token (T_Function);
582 for U in ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit loop
588 for S in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
592 N_Indents := N_Indents - 1;
599 procedure Output_No_ALI (Afile : File_Name_Type) is
601 Output_Token (T_No_ALI);
602 N_Indents := N_Indents + 1;
603 Output_Afile (Afile);
604 N_Indents := N_Indents - 1;
611 procedure Output_Name (N : Name_Id) is
613 -- Remove any encoding info (%s or %b)
618 and then Name_Buffer (Name_Len - 1) = '%'
620 Name_Len := Name_Len - 2;
623 Output_Token (T_Name);
624 Write_Str (Name_Buffer (1 .. Name_Len));
632 procedure Output_Ofile (O : File_Name_Type) is
635 Output_Token (T_Ofile);
645 procedure Output_Sdep (S : Sdep_Id) is
647 Output_Token (T_Source);
648 Write_Name (Sdep.Table (S).Sfile);
656 procedure Output_Sfile (S : File_Name_Type) is
657 FS : File_Name_Type := S;
660 if FS /= No_File then
662 -- We want to output the full source name
664 FS := Full_Source_Name (FS);
666 -- There is no full source name. This occurs for instance when a
667 -- withed unit has a spec file but no body file. This situation is
668 -- not a problem for GNATDIST since the unit may be located on a
669 -- partition we do not want to build. However, we need to locate
670 -- the spec file and to find its full source name. Replace the
671 -- body file name with the spec file name used to compile the
672 -- current unit when possible.
678 and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb"
680 Name_Buffer (Name_Len) := 's
';
681 FS := Full_Source_Name (Name_Find);
686 if FS /= No_File then
687 Output_Token (T_Sfile);
697 procedure Output_Token (T : Token_Type) is
700 when T_No_ALI .. T_Flags =>
701 for J in 1 .. N_Indents loop
705 Write_Str (Image (T).all);
707 for J in Image (T)'Length .. 12 loop
713 if T in T_No_ALI .. T_With then
715 elsif T in T_Source .. T_Name then
719 when T_Preelaborated .. T_Body =>
720 if T in T_Preelaborated .. T_Is_Generic then
722 Output_Token (T_Flags);
725 N_Flags := N_Flags + 1;
729 Write_Str (Image (T).all);
737 procedure Output_Unit (U : Unit_Id) is
739 Output_Token (T_Unit);
740 N_Indents := N_Indents + 1;
744 Output_Name (Name_Id (Units.Table (U).Uname));
748 Output_Token (T_Kind);
750 if Units.Table (U).Unit_Kind = 'p
' then
751 Output_Token (T_Package);
753 Output_Token (T_Subprogram);
756 if Name_Buffer (Name_Len) = 's
' then
757 Output_Token (T_Spec);
759 Output_Token (T_Body);
764 -- Output source file name
766 Output_Sfile (Units.Table (U).Sfile);
772 if Units.Table (U).Preelab then
773 Output_Token (T_Preelaborated);
776 if Units.Table (U).Pure then
777 Output_Token (T_Pure);
780 if Units.Table (U).Has_RACW then
781 Output_Token (T_Has_RACW);
784 if Units.Table (U).Remote_Types then
785 Output_Token (T_Remote_Types);
788 if Units.Table (U).Shared_Passive then
789 Output_Token (T_Shared_Passive);
792 if Units.Table (U).RCI then
793 Output_Token (T_RCI);
796 if Units.Table (U).Predefined then
797 Output_Token (T_Predefined);
800 if Units.Table (U).Internal then
801 Output_Token (T_Internal);
804 if Units.Table (U).Is_Generic then
805 Output_Token (T_Is_Generic);
814 for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop
818 N_Indents := N_Indents - 1;
825 procedure Output_With (W : With_Id) is
827 Output_Token (T_With);
828 N_Indents := N_Indents + 1;
830 Output_Name (Name_Id (Withs.Table (W).Uname));
834 Output_Token (T_Kind);
836 if Name_Buffer (Name_Len) = 's
' then
837 Output_Token (T_Spec);
839 Output_Token (T_Body);
844 Output_Afile (Withs.Table (W).Afile);
845 Output_Sfile (Withs.Table (W).Sfile);
847 N_Indents := N_Indents - 1;
856 function Image (Restriction : Restriction_Id) return String is
857 Result : String := Restriction'Img;
858 Skip : Boolean := True;
861 for J in Result'Range loop
864 Result (J) := To_Upper (Result (J));
866 elsif Result (J) = '_
' then
870 Result (J) := To_Lower (Result (J));
881 function Normalize (Path : String) return String is
883 return Normalize_Pathname (Path);
886 --------------------------------
887 -- Output_License_Information --
888 --------------------------------
890 procedure Output_License_Information is
894 Write_Str ("Please refer to file COPYING in your distribution"
895 & " for license terms.");
899 Exit_Program (E_Success);
900 end Output_License_Information;
906 procedure Output_Object (O : File_Name_Type) is
907 Object_Name : String_Access;
913 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
915 Object_Name := No_Obj'Unchecked_Access;
918 Write_Str (Object_Name.all);
920 if Print_Source or else Print_Unit then
926 (Object_Start + Object_Name'Length .. Object_End));
936 procedure Output_Source (Sdep_I : Sdep_Id) is
937 Stamp : Time_Stamp_Type;
940 Status : File_Status;
941 Object_Name : String_Access;
944 if Sdep_I = No_Sdep_Id then
948 Stamp := Sdep.Table (Sdep_I).Stamp;
949 Checksum := Sdep.Table (Sdep_I).Checksum;
950 FS := Sdep.Table (Sdep_I).Sfile;
953 Find_Status (FS, Stamp, Checksum, Status);
954 Get_Name_String (FS);
956 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
959 Write_Str (" Source => ");
960 Write_Str (Object_Name.all);
964 (Spaces (Source_Start + Object_Name'Length .. Source_End));
967 Output_Status (Status, Verbose => True);
972 if not Selective_Output then
973 Output_Status (Status, Verbose => False);
976 Write_Str (Object_Name.all);
985 procedure Output_Status (FS : File_Status; Verbose : Boolean) is
990 Write_Str (" unchanged");
993 Write_Str (" slightly modified");
996 Write_Str (" file not found");
999 Write_Str (" modified");
1001 when Not_First_On_PATH =>
1002 Write_Str (" unchanged version not first on PATH");
1011 Write_Str (" MOK ");
1014 Write_Str (" ??? ");
1017 Write_Str (" DIF ");
1019 when Not_First_On_PATH =>
1020 Write_Str (" HID ");
1029 procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id) is
1031 U : Unit_Record renames Units.Table (U_Id);
1035 Get_Name_String (U.Uname);
1036 Kind := Name_Buffer (Name_Len);
1037 Name_Len := Name_Len - 2;
1039 if not Verbose_Mode then
1040 Write_Str (Name_Buffer (1 .. Name_Len));
1043 Write_Str ("Unit => ");
1045 Write_Str (" Name => ");
1046 Write_Str (Name_Buffer (1 .. Name_Len));
1048 Write_Str (" Kind => ");
1050 if Units.Table (U_Id).Unit_Kind = 'p
' then
1051 Write_Str ("package ");
1053 Write_Str ("subprogram ");
1063 if Verbose_Mode then
1064 if U.Preelab or else
1067 U.Dynamic_Elab or else
1069 U.Remote_Types or else
1070 U.Shared_Passive or else
1072 U.Predefined or else
1074 U.Is_Generic or else
1075 U.Init_Scalars or else
1076 U.SAL_Interface or else
1077 U.Body_Needed_For_SAL or else
1081 Write_Str (" Flags =>");
1084 Write_Str (" Preelaborable");
1088 Write_Str (" No_Elab_Code");
1092 Write_Str (" Pure");
1095 if U.Dynamic_Elab then
1096 Write_Str (" Dynamic_Elab");
1100 Write_Str (" Has_RACW");
1103 if U.Remote_Types then
1104 Write_Str (" Remote_Types");
1107 if U.Shared_Passive then
1108 Write_Str (" Shared_Passive");
1115 if U.Predefined then
1116 Write_Str (" Predefined");
1120 Write_Str (" Internal");
1123 if U.Is_Generic then
1124 Write_Str (" Is_Generic");
1127 if U.Init_Scalars then
1128 Write_Str (" Init_Scalars");
1131 if U.SAL_Interface then
1132 Write_Str (" SAL_Interface");
1135 if U.Body_Needed_For_SAL then
1136 Write_Str (" Body_Needed_For_SAL");
1139 if U.Elaborate_Body then
1140 Write_Str (" Elaborate Body");
1143 if U.Remote_Types then
1144 Write_Str (" Remote_Types");
1147 if U.Shared_Passive then
1148 Write_Str (" Shared_Passive");
1151 if U.Predefined then
1152 Write_Str (" Predefined");
1157 Restrictions : constant Restrictions_Info :=
1158 ALIs.Table (ALI).Restrictions;
1161 -- If the source was compiled with pragmas Restrictions,
1162 -- Display these restrictions.
1164 if Restrictions.Set /= (All_Restrictions => False) then
1166 Write_Str (" pragma Restrictions =>");
1168 -- For boolean restrictions, just display the name of the
1169 -- restriction; for valued restrictions, also display the
1170 -- restriction value.
1172 for Restriction in All_Restrictions loop
1173 if Restrictions.Set (Restriction) then
1176 Write_Str (Image (Restriction));
1178 if Restriction in All_Parameter_Restrictions then
1180 Write_Str (Restrictions.Value (Restriction)'Img);
1186 -- If the unit violates some Restrictions, display the list of
1187 -- these restrictions.
1189 if Restrictions.Violated /= (All_Restrictions => False) then
1191 Write_Str (" Restrictions violated =>");
1193 -- For boolean restrictions, just display the name of the
1194 -- restriction. For valued restrictions, also display the
1195 -- restriction value.
1197 for Restriction in All_Restrictions loop
1198 if Restrictions.Violated (Restriction) then
1201 Write_Str (Image (Restriction));
1203 if Restriction in All_Parameter_Restrictions then
1204 if Restrictions.Count (Restriction) > 0 then
1207 if Restrictions.Unknown (Restriction) then
1208 Write_Str (" at least");
1211 Write_Str (Restrictions.Count (Restriction)'Img);
1220 if Print_Source then
1225 Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
1231 package body Prj_Env is
1233 Uninitialized_Prefix : constant String := '#
' & Path_Separator;
1234 -- Prefix to indicate that the project path has not been initialized
1235 -- yet. Must be two characters long.
1237 ---------------------
1238 -- Add_Directories --
1239 ---------------------
1241 procedure Add_Directories
1242 (Self : in out String_Access;
1244 Prepend : Boolean := False)
1246 Tmp : String_Access;
1250 Self := new String'(Uninitialized_Prefix
& Path
);
1254 Self
:= new String'(Path & Path_Separator & Tmp.all);
1256 Self := new String'(Tmp
.all & Path_Separator
& Path
);
1260 end Add_Directories
;
1262 -------------------------------------
1263 -- Initialize_Default_Project_Path --
1264 -------------------------------------
1266 procedure Initialize_Default_Project_Path
1267 (Self
: in out String_Access
;
1268 Target_Name
: String;
1269 Runtime_Name
: String := "")
1271 Add_Default_Dir
: Boolean := Target_Name
/= "-";
1275 Ada_Project_Path
: constant String := "ADA_PROJECT_PATH";
1276 Gpr_Project_Path
: constant String := "GPR_PROJECT_PATH";
1277 Gpr_Project_Path_File
: constant String := "GPR_PROJECT_PATH_FILE";
1278 -- Names of alternate env. variables that contain path name(s) of
1279 -- directories where project files may reside. They are taken into
1280 -- account in this order: GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH,
1281 -- ADA_PROJECT_PATH.
1283 Gpr_Prj_Path_File
: String_Access
;
1284 Gpr_Prj_Path
: String_Access
;
1285 Ada_Prj_Path
: String_Access
;
1286 -- The path name(s) of directories where project files may reside.
1289 Prefix
: String_Ptr
;
1290 Runtime
: String_Ptr
;
1292 procedure Add_Target
(Suffix
: String);
1293 -- Add :<prefix>/<target>/Suffix to the project path
1295 FD
: File_Descriptor
;
1302 procedure Add_Target
(Suffix
: String) is
1303 Extra_Sep
: constant String :=
1304 (if Target_Name
(Target_Name
'Last) = '/' then
1307 (1 => Directory_Separator
));
1308 -- Note: Target_Name has a trailing / when it comes from Sdefault
1311 Add_Str_To_Name_Buffer
1312 (Path_Separator
& Prefix
.all & Target_Name
& Extra_Sep
& Suffix
);
1315 -- Start of processing for Initialize_Default_Project_Path
1319 and then (Self
'Length = 0
1320 or else Self
(Self
'First) /= '#')
1325 -- The current directory is always first in the search path. Since
1326 -- the Project_Path currently starts with '#:' as a sign that it is
1327 -- not initialized, we simply replace '#' with '.'
1330 Self
:= new String'('.' & Path_Separator);
1332 Self (Self'First) := '.';
1335 -- Then the reset of the project path (if any) currently contains the
1336 -- directories added through Add_Search_Project_Directory
1338 -- If environment variables are defined and not empty, add their
1341 Gpr_Prj_Path_File := Getenv (Gpr_Project_Path_File);
1342 Gpr_Prj_Path := Getenv (Gpr_Project_Path);
1343 Ada_Prj_Path := Getenv (Ada_Project_Path);
1345 if Gpr_Prj_Path_File.all /= "" then
1346 FD := Open_Read (Gpr_Prj_Path_File.all, GNAT.OS_Lib.Text);
1348 if FD = Invalid_FD then
1350 ("warning: could not read project path file """
1351 & Gpr_Prj_Path_File.all & """");
1354 Len := Integer (File_Length (FD));
1357 Buffer : String (1 .. Len);
1358 Index : Positive := 1;
1360 Tmp : String_Access;
1365 Len := Read (FD, Buffer (1)'Address, Len);
1368 -- Scan the file line by line
1370 while Index < Buffer'Last loop
1372 -- Find the end of line
1375 while Last <= Buffer'Last
1376 and then Buffer (Last) /= ASCII.LF
1377 and then Buffer (Last) /= ASCII.CR
1382 -- Ignore empty lines
1384 if Last > Index then
1388 (Tmp
.all & Path_Separator
&
1389 Buffer
(Index
.. Last
- 1));
1393 -- Find the beginning of the next line
1396 while Buffer
(Index
) = ASCII
.CR
or else
1397 Buffer
(Index
) = ASCII
.LF
1406 if Gpr_Prj_Path
.all /= "" then
1407 Add_Directories
(Self
, Gpr_Prj_Path
.all);
1410 Free
(Gpr_Prj_Path
);
1412 if Ada_Prj_Path
.all /= "" then
1413 Add_Directories
(Self
, Ada_Prj_Path
.all);
1416 Free
(Ada_Prj_Path
);
1418 -- Copy to Name_Buffer, since we will need to manipulate the path
1420 Name_Len
:= Self
'Length;
1421 Name_Buffer
(1 .. Name_Len
) := Self
.all;
1423 -- Scan the directory path to see if "-" is one of the directories.
1424 -- Remove each occurrence of "-" and set Add_Default_Dir to False.
1425 -- Also resolve relative paths and symbolic links.
1429 while First
<= Name_Len
1430 and then (Name_Buffer
(First
) = Path_Separator
)
1435 exit when First
> Name_Len
;
1439 while Last
< Name_Len
1440 and then Name_Buffer
(Last
+ 1) /= Path_Separator
1445 -- If the directory is "-", set Add_Default_Dir to False and
1446 -- remove from path.
1448 if Name_Buffer
(First
.. Last
) = "-" then
1449 Add_Default_Dir
:= False;
1451 for J
in Last
+ 1 .. Name_Len
loop
1452 Name_Buffer
(J
- 2) := Name_Buffer
(J
);
1455 Name_Len
:= Name_Len
- 2;
1457 -- After removing the '-', go back one character to get the
1458 -- next directory correctly.
1464 New_Dir
: constant String :=
1466 (Name_Buffer
(First
.. Last
),
1467 Resolve_Links
=> Opt
.Follow_Links_For_Dirs
);
1469 New_Last
: Positive;
1472 -- If the absolute path was resolved and is different from
1473 -- the original, replace original with the resolved path.
1475 if New_Dir
/= Name_Buffer
(First
.. Last
)
1476 and then New_Dir
'Length /= 0
1478 New_Len
:= Name_Len
+ New_Dir
'Length - (Last
- First
+ 1);
1479 New_Last
:= First
+ New_Dir
'Length - 1;
1480 Name_Buffer
(New_Last
+ 1 .. New_Len
) :=
1481 Name_Buffer
(Last
+ 1 .. Name_Len
);
1482 Name_Buffer
(First
.. New_Last
) := New_Dir
;
1483 Name_Len
:= New_Len
;
1494 -- Set the initial value of Current_Project_Path
1496 if Add_Default_Dir
then
1497 if Sdefault
.Search_Dir_Prefix
= null then
1501 Prefix
:= new String'(Executable_Prefix_Path);
1504 Prefix := new String'(Sdefault
.Search_Dir_Prefix
.all
1505 & ".." & Dir_Separator
1506 & ".." & Dir_Separator
1507 & ".." & Dir_Separator
1508 & ".." & Dir_Separator
);
1511 if Prefix
.all /= "" then
1512 if Target_Name
/= "" then
1514 if Runtime_Name
/= "" then
1515 if Base_Name
(Runtime_Name
) = Runtime_Name
then
1517 -- $prefix/$target/$runtime/lib/gnat
1520 (Runtime_Name
& Directory_Separator
&
1521 "lib" & Directory_Separator
& "gnat");
1523 -- $prefix/$target/$runtime/share/gpr
1526 (Runtime_Name
& Directory_Separator
&
1527 "share" & Directory_Separator
& "gpr");
1531 new String'(Normalize_Pathname (Runtime_Name));
1533 -- $runtime_dir/lib/gnat
1535 Add_Str_To_Name_Buffer
1536 (Path_Separator & Runtime.all & Directory_Separator &
1537 "lib" & Directory_Separator & "gnat");
1539 -- $runtime_dir/share/gpr
1541 Add_Str_To_Name_Buffer
1542 (Path_Separator & Runtime.all & Directory_Separator &
1543 "share" & Directory_Separator & "gpr");
1547 -- $prefix/$target/lib/gnat
1550 ("lib" & Directory_Separator & "gnat");
1552 -- $prefix/$target/share/gpr
1555 ("share" & Directory_Separator & "gpr");
1558 -- $prefix/share/gpr
1560 Add_Str_To_Name_Buffer
1561 (Path_Separator & Prefix.all & "share"
1562 & Directory_Separator & "gpr");
1566 Add_Str_To_Name_Buffer
1567 (Path_Separator & Prefix.all & "lib"
1568 & Directory_Separator & "gnat");
1574 Self := new String'(Name_Buffer
(1 .. Name_Len
));
1575 end Initialize_Default_Project_Path
;
1577 -----------------------
1578 -- Get_Runtime_Path --
1579 -----------------------
1581 function Get_Runtime_Path
1582 (Self
: String_Access
;
1583 Path
: String) return String_Access
1590 if Is_Absolute_Path
(Path
) then
1591 if Is_Directory
(Path
) then
1592 return new String'(Path);
1598 -- Because we do not want to resolve symbolic links, we cannot
1599 -- use Locate_Regular_File. Instead we try each possible path
1602 First := Self'First;
1603 while First <= Self'Last loop
1604 while First <= Self'Last
1605 and then Self (First) = Path_Separator
1610 exit when First > Self'Last;
1613 while Last < Self'Last
1614 and then Self (Last + 1) /= Path_Separator
1621 if not Is_Absolute_Path (Self (First .. Last)) then
1622 Add_Str_To_Name_Buffer (Get_Current_Dir); -- ??? System call
1623 Add_Char_To_Name_Buffer (Directory_Separator);
1626 Add_Str_To_Name_Buffer (Self (First .. Last));
1627 Add_Char_To_Name_Buffer (Directory_Separator);
1628 Add_Str_To_Name_Buffer (Path);
1630 if Is_Directory (Name_Buffer (1 .. Name_Len)) then
1631 return new String'(Name_Buffer
(1 .. Name_Len
));
1639 end Get_Runtime_Path
;
1647 procedure Reset_Print
is
1649 if not Selective_Output
then
1650 Selective_Output
:= True;
1651 Print_Source
:= False;
1652 Print_Object
:= False;
1653 Print_Unit
:= False;
1661 procedure Search_RTS
(Name
: String) is
1662 Src_Path
: String_Ptr
;
1663 Lib_Path
: String_Ptr
;
1664 -- Paths for source and include subdirs
1666 Rts_Full_Path
: String_Access
;
1667 -- Full path for RTS project
1670 -- Try to find the RTS
1672 Src_Path
:= Get_RTS_Search_Dir
(Name
, Include
);
1673 Lib_Path
:= Get_RTS_Search_Dir
(Name
, Objects
);
1675 -- For non-project RTS, both the include and the objects directories
1678 if Src_Path
/= null and then Lib_Path
/= null then
1679 Add_Search_Dirs
(Src_Path
, Include
);
1680 Add_Search_Dirs
(Lib_Path
, Objects
);
1681 Prj_Env
.Initialize_Default_Project_Path
1683 Target_Name
=> Sdefault
.Target_Name
.all,
1684 Runtime_Name
=> Name
);
1688 if Lib_Path
/= null then
1689 Osint
.Fail
("RTS path not valid: missing adainclude directory");
1690 elsif Src_Path
/= null then
1691 Osint
.Fail
("RTS path not valid: missing adalib directory");
1694 -- Try to find the RTS on the project path. First setup the project path
1696 Prj_Env
.Initialize_Default_Project_Path
1698 Target_Name
=> Sdefault
.Target_Name
.all,
1699 Runtime_Name
=> Name
);
1701 Rts_Full_Path
:= Prj_Env
.Get_Runtime_Path
(Prj_Path
, Name
);
1703 if Rts_Full_Path
/= null then
1705 -- Directory name was found on the project path. Look for the
1706 -- include subdirectory(s).
1708 Src_Path
:= Get_RTS_Search_Dir
(Rts_Full_Path
.all, Include
);
1710 if Src_Path
/= null then
1711 Add_Search_Dirs
(Src_Path
, Include
);
1713 -- Add the lib subdirectory if it exists
1715 Lib_Path
:= Get_RTS_Search_Dir
(Rts_Full_Path
.all, Objects
);
1717 if Lib_Path
/= null then
1718 Add_Search_Dirs
(Lib_Path
, Objects
);
1726 ("RTS path not valid: missing adainclude and adalib directories");
1733 procedure Scan_Ls_Arg
(Argv
: String) is
1734 FD
: File_Descriptor
;
1739 pragma Assert
(Argv
'First = 1);
1741 if Argv
'Length = 0 then
1746 if Argv
(1) = '-' then
1747 if Argv
'Length = 1 then
1748 Fail
("switch character cannot be followed by a blank");
1750 -- Processing for -I-
1752 elsif Argv
(2 .. Argv
'Last) = "I-" then
1753 Opt
.Look_In_Primary_Dir
:= False;
1755 -- Forbid -?- or -??- where ? is any character
1757 elsif (Argv
'Length = 3 and then Argv
(3) = '-')
1758 or else (Argv
'Length = 4 and then Argv
(4) = '-')
1760 Fail
("Trailing ""-"" at the end of " & Argv
& " forbidden.");
1762 -- Processing for -Idir
1764 elsif Argv
(2) = 'I' then
1765 Add_Source_Dir
(Argv
(3 .. Argv
'Last));
1766 Add_Lib_Dir
(Argv
(3 .. Argv
'Last));
1768 -- Processing for -aIdir (to gcc this is like a -I switch)
1770 elsif Argv
'Length >= 3 and then Argv
(2 .. 3) = "aI" then
1771 Add_Source_Dir
(Argv
(4 .. Argv
'Last));
1773 -- Processing for -aOdir
1775 elsif Argv
'Length >= 3 and then Argv
(2 .. 3) = "aO" then
1776 Add_Lib_Dir
(Argv
(4 .. Argv
'Last));
1778 -- Processing for -aLdir (to gnatbind this is like a -aO switch)
1780 elsif Argv
'Length >= 3 and then Argv
(2 .. 3) = "aL" then
1781 Add_Lib_Dir
(Argv
(4 .. Argv
'Last));
1783 -- Processing for -aP<dir>
1785 elsif Argv
'Length > 3 and then Argv
(1 .. 3) = "-aP" then
1786 Prj_Env
.Add_Directories
(Prj_Path
, Argv
(4 .. Argv
'Last));
1788 -- Processing for -nostdinc
1790 elsif Argv
(2 .. Argv
'Last) = "nostdinc" then
1791 Opt
.No_Stdinc
:= True;
1793 -- Processing for one character switches
1795 elsif Argv
'Length = 2 then
1797 when 'a' => Also_Predef
:= True;
1798 when 'h' => Print_Usage
:= True;
1799 when 'u' => Reset_Print
; Print_Unit
:= True;
1800 when 's' => Reset_Print
; Print_Source
:= True;
1801 when 'o' => Reset_Print
; Print_Object
:= True;
1802 when 'v' => Verbose_Mode
:= True;
1803 when 'd' => Dependable
:= True;
1804 when 'l' => License
:= True;
1805 when 'V' => Very_Verbose_Mode
:= True;
1807 when others => OK
:= False;
1810 -- Processing for -files=file
1812 elsif Argv
'Length > 7 and then Argv
(1 .. 7) = "-files=" then
1813 FD
:= Open_Read
(Argv
(8 .. Argv
'Last), GNAT
.OS_Lib
.Text
);
1815 if FD
= Invalid_FD
then
1816 Osint
.Fail
("could not find text file """ &
1817 Argv
(8 .. Argv
'Last) & '"');
1820 Len
:= Integer (File_Length
(FD
));
1823 Buffer
: String (1 .. Len
+ 1);
1824 Index
: Positive := 1;
1830 Len
:= Read
(FD
, Buffer
(1)'Address, Len
);
1831 Buffer
(Buffer
'Last) := ASCII
.NUL
;
1834 -- Scan the file line by line
1836 while Index
< Buffer
'Last loop
1838 -- Find the end of line
1841 while Last
<= Buffer
'Last
1842 and then Buffer
(Last
) /= ASCII
.LF
1843 and then Buffer
(Last
) /= ASCII
.CR
1848 -- Ignore empty lines
1850 if Last
> Index
then
1851 Add_File
(Buffer
(Index
.. Last
- 1));
1854 -- Find the beginning of the next line
1857 while Buffer
(Index
) = ASCII
.CR
or else
1858 Buffer
(Index
) = ASCII
.LF
1865 -- Processing for --RTS=path
1867 elsif Argv
'Length >= 5 and then Argv
(1 .. 5) = "--RTS" then
1868 if Argv
'Length <= 6 or else Argv
(6) /= '='then
1869 Osint
.Fail
("missing path for --RTS");
1872 -- Check that it is the first time we see this switch or, if
1873 -- it is not the first time, the same path is specified.
1875 if RTS_Specified
= null then
1876 RTS_Specified
:= new String'(Argv (7 .. Argv'Last));
1878 elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
1879 Osint.Fail ("--RTS cannot be specified multiple times");
1882 -- Valid --RTS switch
1884 Opt.No_Stdinc := True;
1885 Opt.RTS_Switch := True;
1892 -- If not a switch, it must be a file name
1899 Write_Str ("warning: unknown switch """);
1914 Write_Str ("Usage: ");
1915 Osint.Write_Program_Name;
1916 Write_Str (" switches [list of object files]");
1922 Write_Str ("switches:");
1925 Display_Usage_Version_And_Help;
1929 Write_Str (" -a also output relevant predefined units");
1934 Write_Str (" -u output only relevant unit names");
1939 Write_Str (" -h output this help message");
1944 Write_Str (" -s output only relevant source names");
1949 Write_Str (" -o output only relevant object names");
1954 Write_Str (" -d output sources on which specified units " &
1960 Write_Str (" -l output license information");
1965 Write_Str (" -v verbose output, full path and unit " &
1972 Write_Str (" -files=fil files are listed in text file 'fil
'");
1975 -- Line for -aI switch
1977 Write_Str (" -aIdir specify source files search path");
1980 -- Line for -aO switch
1982 Write_Str (" -aOdir specify object files search path");
1985 -- Line for -aP switch
1987 Write_Str (" -aPdir specify project search path");
1990 -- Line for -I switch
1992 Write_Str (" -Idir like -aIdir -aOdir");
1995 -- Line for -I- switch
1997 Write_Str (" -I- do not look for sources & object files");
1998 Write_Str (" in the default directory");
2001 -- Line for -nostdinc
2003 Write_Str (" -nostdinc do not look for source files");
2004 Write_Str (" in the system default directory");
2009 Write_Str (" --RTS=dir specify the default source and object search"
2013 -- File Status explanation
2016 Write_Str (" file status can be:");
2019 for ST in File_Status loop
2021 Output_Status (ST, Verbose => False);
2022 Write_Str (" ==> ");
2023 Output_Status (ST, Verbose => True);
2028 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
2030 -- Start of processing for Gnatls
2033 -- Initialize standard packages
2039 -- First check for --version or --help
2041 Check_Version_And_Help ("GNATLS", "1992");
2043 -- Loop to scan out arguments
2046 Scan_Args : while Next_Arg < Arg_Count loop
2048 Next_Argv : String (1 .. Len_Arg (Next_Arg));
2050 Fill_Arg (Next_Argv'Address, Next_Arg);
2051 Scan_Ls_Arg (Next_Argv);
2054 Next_Arg := Next_Arg + 1;
2057 -- If -l (output license information) is given, it must be the only switch
2060 if Arg_Count = 2 then
2061 Output_License_Information;
2062 Exit_Program (E_Success);
2066 Write_Str ("Can't use -l with another switch");
2069 Exit_Program (E_Fatal);
2073 -- Handle --RTS switch
2075 if RTS_Specified /= null then
2076 Search_RTS (RTS_Specified.all);
2079 -- Add the source and object directories specified on the command line, if
2080 -- any, to the searched directories.
2082 while First_Source_Dir /= null loop
2083 Add_Src_Search_Dir (First_Source_Dir.Value.all);
2084 First_Source_Dir := First_Source_Dir.Next;
2087 while First_Lib_Dir /= null loop
2088 Add_Lib_Search_Dir (First_Lib_Dir.Value.all);
2089 First_Lib_Dir := First_Lib_Dir.Next;
2092 -- Finally, add the default directories
2094 Osint.Add_Default_Search_Dirs;
2096 -- If --RTS= is not specified, check if there is a default runtime
2098 if RTS_Specified = null then
2100 FD : File_Descriptor;
2101 Text : Source_Buffer_Ptr;
2105 Name_Buffer (1 .. 10) := "system.ads";
2108 Read_Source_File (Name_Find, 0, Hi, Text, FD);
2110 if Null_Source_Buffer_Ptr (Text) then
2116 if Verbose_Mode then
2118 Display_Version ("GNATLS", "1997");
2123 ("Default runtime not available. Use --RTS= with a valid runtime");
2126 Exit_Status := E_Warnings;
2129 Write_Str ("Source Search Path:");
2132 for J in 1 .. Nb_Dir_In_Src_Search_Path loop
2135 if Dir_In_Src_Search_Path (J)'Length = 0 then
2136 Write_Str ("<Current_Directory>");
2139 elsif not No_Runtime then
2143 (Dir_In_Src_Search_Path (J).all, True).all));
2150 Write_Str ("Object Search Path:");
2153 for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
2156 if Dir_In_Obj_Search_Path (J)'Length = 0 then
2157 Write_Str ("<Current_Directory>");
2160 elsif not No_Runtime then
2164 (Dir_In_Obj_Search_Path (J).all, True).all));
2171 Write_Str (Project_Search_Path);
2173 Write_Str (" <Current_Directory>");
2176 Prj_Env.Initialize_Default_Project_Path
2177 (Prj_Path, Target_Name => Sdefault.Target_Name.all);
2185 if Prj_Path.all /= "" then
2186 First := Prj_Path'First;
2188 while First <= Prj_Path'Last
2189 and then (Prj_Path (First) = Path_Separator)
2194 exit when First > Prj_Path'Last;
2197 while Last < Prj_Path'Last
2198 and then Prj_Path (Last + 1) /= Path_Separator
2203 if First /= Last or else Prj_Path (First) /= '.' then
2205 -- If the directory is ".", skip it as it is the current
2206 -- directory and it is already the first directory in the
2213 (Prj_Path (First .. Last), True).all));
2225 -- Output usage information when requested
2231 if not More_Lib_Files then
2232 if not Print_Usage and then not Verbose_Mode then
2233 if Arg_Count = 1 then
2237 Exit_Status := E_Fatal;
2241 Exit_Program (Exit_Status);
2245 Initialize_ALI_Source;
2247 -- Print out all libraries for which no ALI files can be located
2249 while More_Lib_Files loop
2250 Main_File := Next_Main_Lib_File;
2251 Ali_File := Full_Lib_File_Name (Lib_File_Name (Main_File));
2253 if Ali_File = No_File then
2254 if Very_Verbose_Mode then
2255 GNATDIST.Output_No_ALI (Lib_File_Name (Main_File));
2259 Write_Str ("Can't find library info for ");
2260 Get_Name_String (Main_File);
2261 Write_Char ('"'); -- "
2262 Write_Str
(Name_Buffer
(1 .. Name_Len
));
2263 Write_Char
('"'); -- "
2265 Exit_Status
:= E_Fatal
;
2269 Ali_File
:= Strip_Directory
(Ali_File
);
2271 if Get_Name_Table_Int
(Ali_File
) = 0 then
2272 Text
:= Read_Library_Info
(Ali_File
, True);
2283 Ignore_Errors
=> True);
2291 -- Reset default output file descriptor, if needed
2293 Set_Standard_Output
;
2295 if Very_Verbose_Mode
then
2296 for A
in ALIs
.First
.. ALIs
.Last
loop
2297 GNATDIST
.Output_ALI
(A
);
2303 Find_General_Layout
;
2305 for Id
in ALIs
.First
.. ALIs
.Last
loop
2310 Get_Name_String
(Units
.Table
(ALIs
.Table
(Id
).First_Unit
).Uname
);
2312 if Also_Predef
or else not Is_Internal_Unit
then
2313 if ALIs
.Table
(Id
).No_Object
then
2314 Output_Object
(No_File
);
2316 Output_Object
(ALIs
.Table
(Id
).Ofile_Full_Name
);
2319 -- In verbose mode print all main units in the ALI file, otherwise
2320 -- just print the first one to ease columnwise printout
2322 if Verbose_Mode
then
2323 Last_U
:= ALIs
.Table
(Id
).Last_Unit
;
2325 Last_U
:= ALIs
.Table
(Id
).First_Unit
;
2328 for U
in ALIs
.Table
(Id
).First_Unit
.. Last_U
loop
2329 if U
/= ALIs
.Table
(Id
).First_Unit
2330 and then Selective_Output
2336 Output_Unit
(Id
, U
);
2338 -- Output source now, unless if it will be done as part of
2339 -- outputing dependencies.
2341 if not (Dependable
and then Print_Source
) then
2342 Output_Source
(Corresponding_Sdep_Entry
(Id
, U
));
2346 -- Print out list of units on which this unit depends (D lines)
2348 if Dependable
and then Print_Source
then
2349 if Verbose_Mode
then
2350 Write_Str
("depends upon");
2358 ALIs
.Table
(Id
).First_Sdep
.. ALIs
.Table
(Id
).Last_Sdep
2361 or else not Is_Internal_File_Name
(Sdep
.Table
(D
).Sfile
)
2363 if Verbose_Mode
then
2373 Write_Str
(Spaces
(1 .. Source_Start
- 2));
2386 -- All done. Set proper exit status
2389 Exit_Program
(Exit_Status
);