1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2013, 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 ------------------------------------------------------------------------------
27 with ALI
.Util
; use ALI
.Util
;
28 with Binderr
; use Binderr
;
29 with Butil
; use Butil
;
30 with Csets
; use Csets
;
31 with Fname
; use Fname
;
32 with Gnatvsn
; use Gnatvsn
;
33 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
34 with Namet
; use Namet
;
36 with Osint
; use Osint
;
37 with Osint
.L
; use Osint
.L
;
38 with Output
; use Output
;
39 with Prj
.Env
; use Prj
.Env
;
40 with Rident
; use Rident
;
43 with Switch
; use Switch
;
44 with Types
; use Types
;
46 with GNAT
.Case_Util
; use GNAT
.Case_Util
;
49 pragma Ident
(Gnat_Static_Version_String
);
51 -- NOTE : The following string may be used by other tools, such as GPS. So
52 -- it can only be modified if these other uses are checked and coordinated.
54 Project_Search_Path
: constant String := "Project Search Path:";
55 -- Label displayed in verbose mode before the directories in the project
56 -- search path. Do not modify without checking NOTE above.
58 Prj_Path
: Prj
.Env
.Project_Search_Path
;
60 Max_Column
: constant := 80;
62 No_Obj
: aliased String := "<no_obj>";
65 OK
, -- matching timestamp
66 Checksum_OK
, -- only matching checksum
67 Not_Found
, -- file not found on source PATH
68 Not_Same
, -- neither checksum nor timestamp matching
69 Not_First_On_PATH
); -- matching file hidden by Not_Same file on path
72 type Dir_Ref
is access Dir_Data
;
74 type Dir_Data
is record
75 Value
: String_Access
;
78 -- Simply linked list of dirs
80 First_Source_Dir
: Dir_Ref
;
81 Last_Source_Dir
: Dir_Ref
;
82 -- The list of source directories from the command line.
83 -- These directories are added using Osint.Add_Src_Search_Dir
84 -- after those of the GNAT Project File, if any.
86 First_Lib_Dir
: Dir_Ref
;
87 Last_Lib_Dir
: Dir_Ref
;
88 -- The list of object directories from the command line.
89 -- These directories are added using Osint.Add_Lib_Search_Dir
90 -- after those of the GNAT Project File, if any.
92 Main_File
: File_Name_Type
;
93 Ali_File
: File_Name_Type
;
94 Text
: Text_Buffer_Ptr
;
97 Too_Long
: Boolean := False;
98 -- When True, lines are too long for multi-column output and each
99 -- item of information is on a different line.
101 Selective_Output
: Boolean := False;
102 Print_Usage
: Boolean := False;
103 Print_Unit
: Boolean := True;
104 Print_Source
: Boolean := True;
105 Print_Object
: Boolean := True;
106 -- Flags controlling the form of the output
108 Also_Predef
: Boolean := False; -- -a
109 Dependable
: Boolean := False; -- -d
110 License
: Boolean := False; -- -l
111 Very_Verbose_Mode
: Boolean := False; -- -V
112 -- Command line flags
114 Unit_Start
: Integer;
116 Source_Start
: Integer;
117 Source_End
: Integer;
118 Object_Start
: Integer;
119 Object_End
: Integer;
120 -- Various column starts and ends
122 Spaces
: constant String (1 .. Max_Column
) := (others => ' ');
124 RTS_Specified
: String_Access
:= null;
125 -- Used to detect multiple use of --RTS= switch
127 -----------------------
128 -- Local Subprograms --
129 -----------------------
131 procedure Add_Lib_Dir
(Dir
: String);
132 -- Add an object directory in the list First_Lib_Dir-Last_Lib_Dir
134 procedure Add_Source_Dir
(Dir
: String);
135 -- Add a source directory in the list First_Source_Dir-Last_Source_Dir
137 procedure Find_General_Layout
;
138 -- Determine the structure of the output (multi columns or not, etc)
140 procedure Find_Status
141 (FS
: in out File_Name_Type
;
142 Stamp
: Time_Stamp_Type
;
144 Status
: out File_Status
);
145 -- Determine the file status (Status) of the file represented by FS
146 -- with the expected Stamp and checksum given as argument. FS will be
147 -- updated to the full file name if available.
149 function Corresponding_Sdep_Entry
(A
: ALI_Id
; U
: Unit_Id
) return Sdep_Id
;
150 -- Give the Sdep entry corresponding to the unit U in ali record A
152 procedure Output_Object
(O
: File_Name_Type
);
153 -- Print out the name of the object when requested
155 procedure Output_Source
(Sdep_I
: Sdep_Id
);
156 -- Print out the name and status of the source corresponding to this
159 procedure Output_Status
(FS
: File_Status
; Verbose
: Boolean);
160 -- Print out FS either in a coded form if verbose is false or in an
161 -- expanded form otherwise.
163 procedure Output_Unit
(ALI
: ALI_Id
; U_Id
: Unit_Id
);
164 -- Print out information on the unit when requested
166 procedure Reset_Print
;
167 -- Reset Print flags properly when selective output is chosen
169 procedure Scan_Ls_Arg
(Argv
: String);
170 -- Scan and process lser specific arguments. Argv is a single argument
172 procedure Search_RTS
(Name
: String);
173 -- Find include and objects path for the RTS name.
176 -- Print usage message
178 procedure Output_License_Information
;
179 -- Output license statement, and if not found, output reference to
182 function Image
(Restriction
: Restriction_Id
) return String;
183 -- Returns the capitalized image of Restriction
185 ------------------------------------------
186 -- GNATDIST specific output subprograms --
187 ------------------------------------------
191 -- Any modification to this subunit requires synchronization with the
194 procedure Output_ALI
(A
: ALI_Id
);
195 -- Comment required saying what this routine does ???
197 procedure Output_No_ALI
(Afile
: File_Name_Type
);
198 -- Comments required saying what this routine does ???
206 procedure Add_Lib_Dir
(Dir
: String) is
208 if First_Lib_Dir
= null then
211 (Value => new String'(Dir
),
213 Last_Lib_Dir
:= First_Lib_Dir
;
218 (Value => new String'(Dir
),
220 Last_Lib_Dir
:= Last_Lib_Dir
.Next
;
228 procedure Add_Source_Dir
(Dir
: String) is
230 if First_Source_Dir
= null then
233 (Value => new String'(Dir
),
235 Last_Source_Dir
:= First_Source_Dir
;
238 Last_Source_Dir
.Next
:=
240 (Value => new String'(Dir
),
242 Last_Source_Dir
:= Last_Source_Dir
.Next
;
246 ------------------------------
247 -- Corresponding_Sdep_Entry --
248 ------------------------------
250 function Corresponding_Sdep_Entry
252 U
: Unit_Id
) return Sdep_Id
255 for D
in ALIs
.Table
(A
).First_Sdep
.. ALIs
.Table
(A
).Last_Sdep
loop
256 if Sdep
.Table
(D
).Sfile
= Units
.Table
(U
).Sfile
then
261 Error_Msg_Unit_1
:= Units
.Table
(U
).Uname
;
262 Error_Msg_File_1
:= ALIs
.Table
(A
).Afile
;
264 Error_Msg
("wrong ALI format, can't find dependency line for $ in {");
265 Exit_Program
(E_Fatal
);
267 end Corresponding_Sdep_Entry
;
269 -------------------------
270 -- Find_General_Layout --
271 -------------------------
273 procedure Find_General_Layout
is
274 Max_Unit_Length
: Integer := 11;
275 Max_Src_Length
: Integer := 11;
276 Max_Obj_Length
: Integer := 11;
282 -- Compute maximum of each column
284 for Id
in ALIs
.First
.. ALIs
.Last
loop
285 Get_Name_String
(Units
.Table
(ALIs
.Table
(Id
).First_Unit
).Uname
);
286 if Also_Predef
or else not Is_Internal_Unit
then
290 Max_Unit_Length
:= Integer'Max (Max_Unit_Length
, Len
);
294 FS
:= Full_Source_Name
(ALIs
.Table
(Id
).Sfile
);
297 Get_Name_String
(ALIs
.Table
(Id
).Sfile
);
298 Name_Len
:= Name_Len
+ 13;
300 Get_Name_String
(FS
);
303 Max_Src_Length
:= Integer'Max (Max_Src_Length
, Name_Len
+ 1);
307 if ALIs
.Table
(Id
).No_Object
then
309 Integer'Max (Max_Obj_Length
, No_Obj
'Length);
311 Get_Name_String
(ALIs
.Table
(Id
).Ofile_Full_Name
);
312 Max_Obj_Length
:= Integer'Max (Max_Obj_Length
, Name_Len
+ 1);
318 -- Verify is output is not wider than maximum number of columns
323 (Max_Unit_Length
+ Max_Src_Length
+ Max_Obj_Length
) > Max_Column
;
325 -- Set start and end of columns
328 Object_End
:= Object_Start
- 1;
331 Object_End
:= Object_Start
+ Max_Obj_Length
;
334 Unit_Start
:= Object_End
+ 1;
335 Unit_End
:= Unit_Start
- 1;
338 Unit_End
:= Unit_Start
+ Max_Unit_Length
;
341 Source_Start
:= Unit_End
+ 1;
343 if Source_Start
> Spaces
'Last then
344 Source_Start
:= Spaces
'Last;
347 Source_End
:= Source_Start
- 1;
350 Source_End
:= Source_Start
+ Max_Src_Length
;
352 end Find_General_Layout
;
358 procedure Find_Status
359 (FS
: in out File_Name_Type
;
360 Stamp
: Time_Stamp_Type
;
362 Status
: out File_Status
)
364 Tmp1
: File_Name_Type
;
365 Tmp2
: File_Name_Type
;
368 Tmp1
:= Full_Source_Name
(FS
);
370 if Tmp1
= No_File
then
373 elsif File_Stamp
(Tmp1
) = Stamp
then
377 elsif Checksums_Match
(Get_File_Checksum
(FS
), Checksum
) then
379 Status
:= Checksum_OK
;
382 Tmp2
:= Matching_Full_Source_Name
(FS
, Stamp
);
384 if Tmp2
= No_File
then
389 Status
:= Not_First_On_PATH
;
399 package body GNATDIST
is
402 N_Indents
: Natural := 0;
433 Image
: constant array (Token_Type
) of String_Access
:=
434 (T_No_ALI
=> new String'("No_ALI"),
435 T_ALI => new String'("ALI"),
436 T_Unit
=> new String'("Unit"),
437 T_With => new String'("With"),
438 T_Source
=> new String'("Source"),
439 T_Afile => new String'("Afile"),
440 T_Ofile
=> new String'("Ofile"),
441 T_Sfile => new String'("Sfile"),
442 T_Name
=> new String'("Name"),
443 T_Main => new String'("Main"),
444 T_Kind
=> new String'("Kind"),
445 T_Flags => new String'("Flags"),
446 T_Preelaborated
=> new String'("Preelaborated"),
447 T_Pure => new String'("Pure"),
448 T_Has_RACW
=> new String'("Has_RACW"),
449 T_Remote_Types => new String'("Remote_Types"),
450 T_Shared_Passive
=> new String'("Shared_Passive"),
451 T_RCI => new String'("RCI"),
452 T_Predefined
=> new String'("Predefined"),
453 T_Internal => new String'("Internal"),
454 T_Is_Generic
=> new String'("Is_Generic"),
455 T_Procedure => new String'("procedure"),
456 T_Function
=> new String'("function"),
457 T_Package => new String'("package"),
458 T_Subprogram
=> new String'("subprogram"),
459 T_Spec => new String'("spec"),
460 T_Body
=> new String'("body"));
462 procedure Output_Name (N : Name_Id);
463 -- Remove any encoding info (%b and %s) and output N
465 procedure Output_Afile (A : File_Name_Type);
466 procedure Output_Ofile (O : File_Name_Type);
467 procedure Output_Sfile (S : File_Name_Type);
468 -- Output various names. Check that the name is different from no name.
469 -- Otherwise, skip the output.
471 procedure Output_Token (T : Token_Type);
472 -- Output token using specific format. That is several indentations and:
474 -- T_No_ALI .. T_With : <token> & " =>" & NL
475 -- T_Source .. T_Kind : <token> & " => "
476 -- T_Flags : <token> & " =>"
477 -- T_Preelab .. T_Body : " " & <token>
479 procedure Output_Sdep (S : Sdep_Id);
480 procedure Output_Unit (U : Unit_Id);
481 procedure Output_With (W : With_Id);
482 -- Output this entry as a global section (like ALIs)
488 procedure Output_Afile (A : File_Name_Type) is
491 Output_Token (T_Afile);
501 procedure Output_ALI (A : ALI_Id) is
503 Output_Token (T_ALI);
504 N_Indents := N_Indents + 1;
506 Output_Afile (ALIs.Table (A).Afile);
507 Output_Ofile (ALIs.Table (A).Ofile_Full_Name);
508 Output_Sfile (ALIs.Table (A).Sfile);
512 if ALIs.Table (A).Main_Program /= None then
513 Output_Token (T_Main);
515 if ALIs.Table (A).Main_Program = Proc then
516 Output_Token (T_Procedure);
518 Output_Token (T_Function);
526 for U in ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit loop
532 for S in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
536 N_Indents := N_Indents - 1;
543 procedure Output_No_ALI (Afile : File_Name_Type) is
545 Output_Token (T_No_ALI);
546 N_Indents := N_Indents + 1;
547 Output_Afile (Afile);
548 N_Indents := N_Indents - 1;
555 procedure Output_Name (N : Name_Id) is
557 -- Remove any encoding info (%s or %b)
562 and then Name_Buffer (Name_Len - 1) = '%'
564 Name_Len := Name_Len - 2;
567 Output_Token (T_Name);
568 Write_Str (Name_Buffer (1 .. Name_Len));
576 procedure Output_Ofile (O : File_Name_Type) is
579 Output_Token (T_Ofile);
589 procedure Output_Sdep (S : Sdep_Id) is
591 Output_Token (T_Source);
592 Write_Name (Sdep.Table (S).Sfile);
600 procedure Output_Sfile (S : File_Name_Type) is
601 FS : File_Name_Type := S;
604 if FS /= No_File then
606 -- We want to output the full source name
608 FS := Full_Source_Name (FS);
610 -- There is no full source name. This occurs for instance when a
611 -- withed unit has a spec file but no body file. This situation is
612 -- not a problem for GNATDIST since the unit may be located on a
613 -- partition we do not want to build. However, we need to locate
614 -- the spec file and to find its full source name. Replace the
615 -- body file name with the spec file name used to compile the
616 -- current unit when possible.
622 and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb"
624 Name_Buffer (Name_Len) := 's
';
625 FS := Full_Source_Name (Name_Find);
630 if FS /= No_File then
631 Output_Token (T_Sfile);
641 procedure Output_Token (T : Token_Type) is
643 if T in T_No_ALI .. T_Flags then
644 for J in 1 .. N_Indents loop
648 Write_Str (Image (T).all);
650 for J in Image (T)'Length .. 12 loop
656 if T in T_No_ALI .. T_With then
658 elsif T in T_Source .. T_Name then
662 elsif T in T_Preelaborated .. T_Body then
663 if T in T_Preelaborated .. T_Is_Generic then
665 Output_Token (T_Flags);
668 N_Flags := N_Flags + 1;
672 Write_Str (Image (T).all);
675 Write_Str (Image (T).all);
683 procedure Output_Unit (U : Unit_Id) is
685 Output_Token (T_Unit);
686 N_Indents := N_Indents + 1;
690 Output_Name (Name_Id (Units.Table (U).Uname));
694 Output_Token (T_Kind);
696 if Units.Table (U).Unit_Kind = 'p
' then
697 Output_Token (T_Package);
699 Output_Token (T_Subprogram);
702 if Name_Buffer (Name_Len) = 's
' then
703 Output_Token (T_Spec);
705 Output_Token (T_Body);
710 -- Output source file name
712 Output_Sfile (Units.Table (U).Sfile);
718 if Units.Table (U).Preelab then
719 Output_Token (T_Preelaborated);
722 if Units.Table (U).Pure then
723 Output_Token (T_Pure);
726 if Units.Table (U).Has_RACW then
727 Output_Token (T_Has_RACW);
730 if Units.Table (U).Remote_Types then
731 Output_Token (T_Remote_Types);
734 if Units.Table (U).Shared_Passive then
735 Output_Token (T_Shared_Passive);
738 if Units.Table (U).RCI then
739 Output_Token (T_RCI);
742 if Units.Table (U).Predefined then
743 Output_Token (T_Predefined);
746 if Units.Table (U).Internal then
747 Output_Token (T_Internal);
750 if Units.Table (U).Is_Generic then
751 Output_Token (T_Is_Generic);
760 for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop
764 N_Indents := N_Indents - 1;
771 procedure Output_With (W : With_Id) is
773 Output_Token (T_With);
774 N_Indents := N_Indents + 1;
776 Output_Name (Name_Id (Withs.Table (W).Uname));
780 Output_Token (T_Kind);
782 if Name_Buffer (Name_Len) = 's
' then
783 Output_Token (T_Spec);
785 Output_Token (T_Body);
790 Output_Afile (Withs.Table (W).Afile);
791 Output_Sfile (Withs.Table (W).Sfile);
793 N_Indents := N_Indents - 1;
802 function Image (Restriction : Restriction_Id) return String is
803 Result : String := Restriction'Img;
804 Skip : Boolean := True;
807 for J in Result'Range loop
810 Result (J) := To_Upper (Result (J));
812 elsif Result (J) = '_
' then
816 Result (J) := To_Lower (Result (J));
823 --------------------------------
824 -- Output_License_Information --
825 --------------------------------
827 procedure Output_License_Information is
831 Write_Str ("Please refer to file COPYING in your distribution"
832 & " for license terms.");
836 Exit_Program (E_Success);
837 end Output_License_Information;
843 procedure Output_Object (O : File_Name_Type) is
844 Object_Name : String_Access;
850 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
852 Object_Name := No_Obj'Unchecked_Access;
855 Write_Str (Object_Name.all);
857 if Print_Source or else Print_Unit then
863 (Object_Start + Object_Name'Length .. Object_End));
873 procedure Output_Source (Sdep_I : Sdep_Id) is
874 Stamp : Time_Stamp_Type;
877 Status : File_Status;
878 Object_Name : String_Access;
881 if Sdep_I = No_Sdep_Id then
885 Stamp := Sdep.Table (Sdep_I).Stamp;
886 Checksum := Sdep.Table (Sdep_I).Checksum;
887 FS := Sdep.Table (Sdep_I).Sfile;
890 Find_Status (FS, Stamp, Checksum, Status);
891 Get_Name_String (FS);
893 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
896 Write_Str (" Source => ");
897 Write_Str (Object_Name.all);
901 (Spaces (Source_Start + Object_Name'Length .. Source_End));
904 Output_Status (Status, Verbose => True);
909 if not Selective_Output then
910 Output_Status (Status, Verbose => False);
913 Write_Str (Object_Name.all);
922 procedure Output_Status (FS : File_Status; Verbose : Boolean) is
927 Write_Str (" unchanged");
930 Write_Str (" slightly modified");
933 Write_Str (" file not found");
936 Write_Str (" modified");
938 when Not_First_On_PATH =>
939 Write_Str (" unchanged version not first on PATH");
956 when Not_First_On_PATH =>
966 procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id) is
968 U : Unit_Record renames Units.Table (U_Id);
972 Get_Name_String (U.Uname);
973 Kind := Name_Buffer (Name_Len);
974 Name_Len := Name_Len - 2;
976 if not Verbose_Mode then
977 Write_Str (Name_Buffer (1 .. Name_Len));
980 Write_Str ("Unit => ");
982 Write_Str (" Name => ");
983 Write_Str (Name_Buffer (1 .. Name_Len));
985 Write_Str (" Kind => ");
987 if Units.Table (U_Id).Unit_Kind = 'p
' then
988 Write_Str ("package ");
990 Write_Str ("subprogram ");
1000 if Verbose_Mode then
1001 if U.Preelab or else
1004 U.Dynamic_Elab or else
1006 U.Remote_Types or else
1007 U.Shared_Passive or else
1009 U.Predefined or else
1011 U.Is_Generic or else
1012 U.Init_Scalars or else
1013 U.SAL_Interface or else
1014 U.Body_Needed_For_SAL or else
1018 Write_Str (" Flags =>");
1021 Write_Str (" Preelaborable");
1025 Write_Str (" No_Elab_Code");
1029 Write_Str (" Pure");
1032 if U.Dynamic_Elab then
1033 Write_Str (" Dynamic_Elab");
1037 Write_Str (" Has_RACW");
1040 if U.Remote_Types then
1041 Write_Str (" Remote_Types");
1044 if U.Shared_Passive then
1045 Write_Str (" Shared_Passive");
1052 if U.Predefined then
1053 Write_Str (" Predefined");
1057 Write_Str (" Internal");
1060 if U.Is_Generic then
1061 Write_Str (" Is_Generic");
1064 if U.Init_Scalars then
1065 Write_Str (" Init_Scalars");
1068 if U.SAL_Interface then
1069 Write_Str (" SAL_Interface");
1072 if U.Body_Needed_For_SAL then
1073 Write_Str (" Body_Needed_For_SAL");
1076 if U.Elaborate_Body then
1077 Write_Str (" Elaborate Body");
1080 if U.Remote_Types then
1081 Write_Str (" Remote_Types");
1084 if U.Shared_Passive then
1085 Write_Str (" Shared_Passive");
1088 if U.Predefined then
1089 Write_Str (" Predefined");
1094 Restrictions : constant Restrictions_Info :=
1095 ALIs.Table (ALI).Restrictions;
1098 -- If the source was compiled with pragmas Restrictions,
1099 -- Display these restrictions.
1101 if Restrictions.Set /= (All_Restrictions => False) then
1103 Write_Str (" pragma Restrictions =>");
1105 -- For boolean restrictions, just display the name of the
1106 -- restriction; for valued restrictions, also display the
1107 -- restriction value.
1109 for Restriction in All_Restrictions loop
1110 if Restrictions.Set (Restriction) then
1113 Write_Str (Image (Restriction));
1115 if Restriction in All_Parameter_Restrictions then
1117 Write_Str (Restrictions.Value (Restriction)'Img);
1123 -- If the unit violates some Restrictions, display the list of
1124 -- these restrictions.
1126 if Restrictions.Violated /= (All_Restrictions => False) then
1128 Write_Str (" Restrictions violated =>");
1130 -- For boolean restrictions, just display the name of the
1131 -- restriction. For valued restrictions, also display the
1132 -- restriction value.
1134 for Restriction in All_Restrictions loop
1135 if Restrictions.Violated (Restriction) then
1138 Write_Str (Image (Restriction));
1140 if Restriction in All_Parameter_Restrictions then
1141 if Restrictions.Count (Restriction) > 0 then
1144 if Restrictions.Unknown (Restriction) then
1145 Write_Str (" at least");
1148 Write_Str (Restrictions.Count (Restriction)'Img);
1157 if Print_Source then
1162 Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
1172 procedure Reset_Print is
1174 if not Selective_Output then
1175 Selective_Output := True;
1176 Print_Source := False;
1177 Print_Object := False;
1178 Print_Unit := False;
1186 procedure Search_RTS (Name : String) is
1187 Src_Path : String_Ptr;
1188 Lib_Path : String_Ptr;
1189 -- Paths for source and include subdirs
1191 Rts_Full_Path : String_Access;
1192 -- Full path for RTS project
1195 -- Try to find the RTS
1197 Src_Path := Get_RTS_Search_Dir (Name, Include);
1198 Lib_Path := Get_RTS_Search_Dir (Name, Objects);
1200 -- For non-project RTS, both the include and the objects directories
1203 if Src_Path /= null and then Lib_Path /= null then
1204 Add_Search_Dirs (Src_Path, Include);
1205 Add_Search_Dirs (Lib_Path, Objects);
1209 if Lib_Path /= null then
1210 Osint.Fail ("RTS path not valid: missing adainclude directory");
1211 elsif Src_Path /= null then
1212 Osint.Fail ("RTS path not valid: missing adalib directory");
1215 -- Try to find the RTS on the project path. First setup the project path
1217 Initialize_Default_Project_Path
1218 (Prj_Path, Target_Name => Sdefault.Target_Name.all);
1220 Rts_Full_Path := Get_Runtime_Path (Prj_Path, Name);
1222 if Rts_Full_Path /= null then
1224 -- Directory name was found on the project path. Look for the
1225 -- include subdirectory(s).
1227 Src_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Include);
1229 if Src_Path /= null then
1230 Add_Search_Dirs (Src_Path, Include);
1232 -- Add the lib subdirectory if it exists
1234 Lib_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Objects);
1236 if Lib_Path /= null then
1237 Add_Search_Dirs (Lib_Path, Objects);
1245 ("RTS path not valid: missing adainclude and adalib directories");
1252 procedure Scan_Ls_Arg (Argv : String) is
1253 FD : File_Descriptor;
1258 pragma Assert (Argv'First = 1);
1260 if Argv'Length = 0 then
1265 if Argv (1) = '-' then
1266 if Argv'Length = 1 then
1267 Fail ("switch character cannot be followed by a blank");
1269 -- Processing for -I-
1271 elsif Argv (2 .. Argv'Last) = "I-" then
1272 Opt.Look_In_Primary_Dir := False;
1274 -- Forbid -?- or -??- where ? is any character
1276 elsif (Argv'Length = 3 and then Argv (3) = '-')
1277 or else (Argv'Length = 4 and then Argv (4) = '-')
1279 Fail ("Trailing ""-"" at the end of " & Argv & " forbidden.");
1281 -- Processing for -Idir
1283 elsif Argv (2) = 'I
' then
1284 Add_Source_Dir (Argv (3 .. Argv'Last));
1285 Add_Lib_Dir (Argv (3 .. Argv'Last));
1287 -- Processing for -aIdir (to gcc this is like a -I switch)
1289 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
1290 Add_Source_Dir (Argv (4 .. Argv'Last));
1292 -- Processing for -aOdir
1294 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
1295 Add_Lib_Dir (Argv (4 .. Argv'Last));
1297 -- Processing for -aLdir (to gnatbind this is like a -aO switch)
1299 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
1300 Add_Lib_Dir (Argv (4 .. Argv'Last));
1302 -- Processing for -aP<dir>
1304 elsif Argv'Length > 3 and then Argv (1 .. 3) = "-aP" then
1305 Add_Directories (Prj_Path, Argv (4 .. Argv'Last));
1307 -- Processing for -nostdinc
1309 elsif Argv (2 .. Argv'Last) = "nostdinc" then
1310 Opt.No_Stdinc := True;
1312 -- Processing for one character switches
1314 elsif Argv'Length = 2 then
1316 when 'a
' => Also_Predef := True;
1317 when 'h
' => Print_Usage := True;
1318 when 'u
' => Reset_Print; Print_Unit := True;
1319 when 's
' => Reset_Print; Print_Source := True;
1320 when 'o
' => Reset_Print; Print_Object := True;
1321 when 'v
' => Verbose_Mode := True;
1322 when 'd
' => Dependable := True;
1323 when 'l
' => License := True;
1324 when 'V
' => Very_Verbose_Mode := True;
1326 when others => OK := False;
1329 -- Processing for -files=file
1331 elsif Argv'Length > 7 and then Argv (1 .. 7) = "-files=" then
1332 FD := Open_Read (Argv (8 .. Argv'Last), GNAT.OS_Lib.Text);
1334 if FD = Invalid_FD then
1335 Osint.Fail ("could not find text file """ &
1336 Argv (8 .. Argv'Last) & '"');
1339 Len := Integer (File_Length (FD));
1342 Buffer : String (1 .. Len + 1);
1343 Index : Positive := 1;
1349 Len := Read (FD, Buffer (1)'Address, Len);
1350 Buffer (Buffer'Last) := ASCII.NUL;
1353 -- Scan the file line by line
1355 while Index < Buffer'Last loop
1357 -- Find the end of line
1360 while Last <= Buffer'Last
1361 and then Buffer (Last) /= ASCII.LF
1362 and then Buffer (Last) /= ASCII.CR
1367 -- Ignore empty lines
1369 if Last > Index then
1370 Add_File (Buffer (Index .. Last - 1));
1373 -- Find the beginning of the next line
1376 while Buffer (Index) = ASCII.CR or else
1377 Buffer (Index) = ASCII.LF
1384 -- Processing for --RTS=path
1386 elsif Argv'Length >= 5 and then Argv (1 .. 5) = "--RTS" then
1387 if Argv
'Length <= 6 or else Argv
(6) /= '='then
1388 Osint
.Fail
("missing path for --RTS");
1391 -- Check that it is the first time we see this switch or, if
1392 -- it is not the first time, the same path is specified.
1394 if RTS_Specified
= null then
1395 RTS_Specified
:= new String'(Argv (7 .. Argv'Last));
1397 elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
1398 Osint.Fail ("--RTS cannot be specified multiple times");
1401 -- Valid --RTS switch
1403 Opt.No_Stdinc := True;
1404 Opt.RTS_Switch := True;
1411 -- If not a switch, it must be a file name
1418 Write_Str ("warning: unknown switch """);
1433 Write_Str ("Usage: ");
1434 Osint.Write_Program_Name;
1435 Write_Str (" switches [list of object files]");
1441 Write_Str ("switches:");
1444 Display_Usage_Version_And_Help;
1448 Write_Str (" -a also output relevant predefined units");
1453 Write_Str (" -u output only relevant unit names");
1458 Write_Str (" -h output this help message");
1463 Write_Str (" -s output only relevant source names");
1468 Write_Str (" -o output only relevant object names");
1473 Write_Str (" -d output sources on which specified units " &
1479 Write_Str (" -l output license information");
1484 Write_Str (" -v verbose output, full path and unit " &
1491 Write_Str (" -files=fil files are listed in text file 'fil
'");
1494 -- Line for -aI switch
1496 Write_Str (" -aIdir specify source files search path");
1499 -- Line for -aO switch
1501 Write_Str (" -aOdir specify object files search path");
1504 -- Line for -aP switch
1506 Write_Str (" -aPdir specify project search path");
1509 -- Line for -I switch
1511 Write_Str (" -Idir like -aIdir -aOdir");
1514 -- Line for -I- switch
1516 Write_Str (" -I- do not look for sources & object files");
1517 Write_Str (" in the default directory");
1520 -- Line for -nostdinc
1522 Write_Str (" -nostdinc do not look for source files");
1523 Write_Str (" in the system default directory");
1528 Write_Str (" --RTS=dir specify the default source and object search"
1532 -- File Status explanation
1535 Write_Str (" file status can be:");
1538 for ST in File_Status loop
1540 Output_Status (ST, Verbose => False);
1541 Write_Str (" ==> ");
1542 Output_Status (ST, Verbose => True);
1547 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
1549 -- Start of processing for Gnatls
1552 -- Initialize standard packages
1557 -- First check for --version or --help
1559 Check_Version_And_Help ("GNATLS", "1997");
1561 -- Loop to scan out arguments
1564 Scan_Args : while Next_Arg < Arg_Count loop
1566 Next_Argv : String (1 .. Len_Arg (Next_Arg));
1568 Fill_Arg (Next_Argv'Address, Next_Arg);
1569 Scan_Ls_Arg (Next_Argv);
1572 Next_Arg := Next_Arg + 1;
1575 -- If -l (output license information) is given, it must be the only switch
1577 if License and then Arg_Count /= 2 then
1579 Write_Str ("Can't use -l with another switch");
1582 Exit_Program (E_Fatal);
1585 -- Handle --RTS switch
1587 if RTS_Specified /= null then
1588 Search_RTS (RTS_Specified.all);
1591 -- Add the source and object directories specified on the command line, if
1592 -- any, to the searched directories.
1594 while First_Source_Dir /= null loop
1595 Add_Src_Search_Dir (First_Source_Dir.Value.all);
1596 First_Source_Dir := First_Source_Dir.Next;
1599 while First_Lib_Dir /= null loop
1600 Add_Lib_Search_Dir (First_Lib_Dir.Value.all);
1601 First_Lib_Dir := First_Lib_Dir.Next;
1604 -- Finally, add the default directories and obtain target parameters
1606 Osint.Add_Default_Search_Dirs;
1608 if Verbose_Mode then
1610 Display_Version ("GNATLS", "1997");
1612 Write_Str ("Source Search Path:");
1615 for J in 1 .. Nb_Dir_In_Src_Search_Path loop
1618 if Dir_In_Src_Search_Path (J)'Length = 0 then
1619 Write_Str ("<Current_Directory>");
1621 Write_Str (To_Host_Dir_Spec
1622 (Dir_In_Src_Search_Path (J).all, True).all);
1630 Write_Str ("Object Search Path:");
1633 for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
1636 if Dir_In_Obj_Search_Path (J)'Length = 0 then
1637 Write_Str ("<Current_Directory>");
1639 Write_Str (To_Host_Dir_Spec
1640 (Dir_In_Obj_Search_Path (J).all, True).all);
1648 Write_Str (Project_Search_Path);
1650 Write_Str (" <Current_Directory>");
1653 Initialize_Default_Project_Path
1654 (Prj_Path, Target_Name => Sdefault.Target_Name.all);
1657 Project_Path : String_Access;
1662 Get_Path (Prj_Path, Project_Path);
1664 if Project_Path.all /= "" then
1665 First := Project_Path'First;
1667 while First <= Project_Path'Last
1668 and then (Project_Path (First) = Path_Separator)
1673 exit when First > Project_Path'Last;
1676 while Last < Project_Path'Last
1677 and then Project_Path (Last + 1) /= Path_Separator
1682 if First /= Last or else Project_Path (First) /= '.' then
1684 -- If the directory is ".", skip it as it is the current
1685 -- directory and it is already the first directory in the
1692 (Project_Path (First .. Last), True).all));
1704 -- Output usage information when requested
1710 -- Output license information when requested
1713 Output_License_Information;
1714 Exit_Program (E_Success);
1717 if not More_Lib_Files then
1718 if not Print_Usage and then not Verbose_Mode then
1722 Exit_Program (E_Fatal);
1726 Initialize_ALI_Source;
1728 -- Print out all library for which no ALI files can be located
1730 while More_Lib_Files loop
1731 Main_File := Next_Main_Lib_File;
1732 Ali_File := Full_Lib_File_Name (Lib_File_Name (Main_File));
1734 if Ali_File = No_File then
1735 if Very_Verbose_Mode then
1736 GNATDIST.Output_No_ALI (Lib_File_Name (Main_File));
1740 Write_Str ("Can't find library info for ");
1741 Get_Name_String (Main_File);
1742 Write_Char ('"'); -- "
1743 Write_Str
(Name_Buffer
(1 .. Name_Len
));
1744 Write_Char
('"'); -- "
1749 Ali_File
:= Strip_Directory
(Ali_File
);
1751 if Get_Name_Table_Info
(Ali_File
) = 0 then
1752 Text
:= Read_Library_Info
(Ali_File
, True);
1756 pragma Unreferenced
(Discard
);
1764 Ignore_Errors
=> True);
1772 -- Reset default output file descriptor, if needed
1774 Set_Standard_Output
;
1776 if Very_Verbose_Mode
then
1777 for A
in ALIs
.First
.. ALIs
.Last
loop
1778 GNATDIST
.Output_ALI
(A
);
1784 Find_General_Layout
;
1786 for Id
in ALIs
.First
.. ALIs
.Last
loop
1791 Get_Name_String
(Units
.Table
(ALIs
.Table
(Id
).First_Unit
).Uname
);
1793 if Also_Predef
or else not Is_Internal_Unit
then
1794 if ALIs
.Table
(Id
).No_Object
then
1795 Output_Object
(No_File
);
1797 Output_Object
(ALIs
.Table
(Id
).Ofile_Full_Name
);
1800 -- In verbose mode print all main units in the ALI file, otherwise
1801 -- just print the first one to ease columnwise printout
1803 if Verbose_Mode
then
1804 Last_U
:= ALIs
.Table
(Id
).Last_Unit
;
1806 Last_U
:= ALIs
.Table
(Id
).First_Unit
;
1809 for U
in ALIs
.Table
(Id
).First_Unit
.. Last_U
loop
1810 if U
/= ALIs
.Table
(Id
).First_Unit
1811 and then Selective_Output
1817 Output_Unit
(Id
, U
);
1819 -- Output source now, unless if it will be done as part of
1820 -- outputing dependencies.
1822 if not (Dependable
and then Print_Source
) then
1823 Output_Source
(Corresponding_Sdep_Entry
(Id
, U
));
1827 -- Print out list of units on which this unit depends (D lines)
1829 if Dependable
and then Print_Source
then
1830 if Verbose_Mode
then
1831 Write_Str
("depends upon");
1839 ALIs
.Table
(Id
).First_Sdep
.. ALIs
.Table
(Id
).Last_Sdep
1842 or else not Is_Internal_File_Name
(Sdep
.Table
(D
).Sfile
)
1844 if Verbose_Mode
then
1854 Write_Str
(Spaces
(1 .. Source_Start
- 2));
1867 -- All done. Set proper exit status
1870 Exit_Program
(E_Success
);