|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- G N A T L S --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
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. --
|
|
|
20 -- --
|
|
|
21 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
23 -- --
|
|
|
24 ------------------------------------------------------------------------------
|
|
|
25
|
|
|
26 pragma Ada_2012;
|
|
|
27
|
|
|
28 with ALI; use ALI;
|
|
|
29 with ALI.Util; use ALI.Util;
|
|
|
30 with Binderr; use Binderr;
|
|
|
31 with Butil; use Butil;
|
|
|
32 with Csets;
|
|
|
33 with Fname; use Fname;
|
|
|
34 with Gnatvsn; use Gnatvsn;
|
|
|
35 with Make_Util; use Make_Util;
|
|
|
36 with Namet; use Namet;
|
|
|
37 with Opt; use Opt;
|
|
|
38 with Osint; use Osint;
|
|
|
39 with Osint.L; use Osint.L;
|
|
|
40 with Output; use Output;
|
|
|
41 with Rident; use Rident;
|
|
|
42 with Sdefault;
|
|
|
43 with Snames;
|
|
|
44 with Stringt;
|
|
|
45 with Switch; use Switch;
|
|
|
46 with Types; use Types;
|
|
|
47
|
|
|
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;
|
|
|
52
|
|
|
53 procedure Gnatls is
|
|
|
54 pragma Ident (Gnat_Static_Version_String);
|
|
|
55
|
|
145
|
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
|
|
|
58 -- and coordinated.
|
|
111
|
59
|
|
|
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.
|
|
|
63
|
|
|
64 Prj_Path : String_Access;
|
|
|
65
|
|
|
66 Max_Column : constant := 80;
|
|
|
67
|
|
|
68 No_Obj : aliased String := "<no_obj>";
|
|
|
69
|
|
|
70 No_Runtime : Boolean := False;
|
|
|
71 -- Set to True if there is no default runtime and --RTS= is not specified
|
|
|
72
|
|
|
73 type File_Status is (
|
|
|
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
|
|
|
79
|
|
|
80 type Dir_Data;
|
|
|
81 type Dir_Ref is access Dir_Data;
|
|
|
82
|
|
|
83 type Dir_Data is record
|
|
|
84 Value : String_Access;
|
|
|
85 Next : Dir_Ref;
|
|
|
86 end record;
|
|
|
87 -- Simply linked list of dirs
|
|
|
88
|
|
|
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.
|
|
|
94
|
|
|
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.
|
|
|
100
|
|
|
101 Main_File : File_Name_Type;
|
|
|
102 Ali_File : File_Name_Type;
|
|
|
103 Text : Text_Buffer_Ptr;
|
|
|
104 Next_Arg : Positive;
|
|
|
105
|
|
|
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.
|
|
|
109
|
|
|
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
|
|
|
116
|
|
|
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
|
|
|
122
|
|
|
123 Unit_Start : Integer;
|
|
|
124 Unit_End : Integer;
|
|
|
125 Source_Start : Integer;
|
|
|
126 Source_End : Integer;
|
|
|
127 Object_Start : Integer;
|
|
|
128 Object_End : Integer;
|
|
|
129 -- Various column starts and ends
|
|
|
130
|
|
|
131 Spaces : constant String (1 .. Max_Column) := (others => ' ');
|
|
|
132
|
|
|
133 RTS_Specified : String_Access := null;
|
|
|
134 -- Used to detect multiple use of --RTS= switch
|
|
|
135
|
|
|
136 Exit_Status : Exit_Code_Type := E_Success;
|
|
|
137 -- Reset to E_Fatal if bad error found
|
|
|
138
|
|
|
139 -----------------------
|
|
|
140 -- Local Subprograms --
|
|
|
141 -----------------------
|
|
|
142
|
|
|
143 procedure Add_Lib_Dir (Dir : String);
|
|
|
144 -- Add an object directory in the list First_Lib_Dir-Last_Lib_Dir
|
|
|
145
|
|
|
146 procedure Add_Source_Dir (Dir : String);
|
|
|
147 -- Add a source directory in the list First_Source_Dir-Last_Source_Dir
|
|
|
148
|
|
|
149 procedure Find_General_Layout;
|
|
|
150 -- Determine the structure of the output (multi columns or not, etc)
|
|
|
151
|
|
|
152 procedure Find_Status
|
|
|
153 (FS : in out File_Name_Type;
|
|
|
154 Stamp : Time_Stamp_Type;
|
|
|
155 Checksum : Word;
|
|
|
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.
|
|
|
160
|
|
|
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
|
|
|
163
|
|
|
164 procedure Output_Object (O : File_Name_Type);
|
|
|
165 -- Print out the name of the object when requested
|
|
|
166
|
|
|
167 procedure Output_Source (Sdep_I : Sdep_Id);
|
|
|
168 -- Print out the name and status of the source corresponding to this
|
|
|
169 -- sdep entry.
|
|
|
170
|
|
|
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.
|
|
|
174
|
|
|
175 procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id);
|
|
|
176 -- Print out information on the unit when requested
|
|
|
177
|
|
|
178 procedure Reset_Print;
|
|
|
179 -- Reset Print flags properly when selective output is chosen
|
|
|
180
|
|
|
181 procedure Scan_Ls_Arg (Argv : String);
|
|
|
182 -- Scan and process user specific arguments (Argv is a single argument)
|
|
|
183
|
|
|
184 procedure Search_RTS (Name : String);
|
|
|
185 -- Find include and objects path for the RTS name.
|
|
|
186
|
|
|
187 procedure Usage;
|
|
|
188 -- Print usage message
|
|
|
189
|
|
|
190 procedure Output_License_Information;
|
|
131
|
191 pragma No_Return (Output_License_Information);
|
|
111
|
192 -- Output license statement, and if not found, output reference to COPYING
|
|
|
193
|
|
|
194 function Image (Restriction : Restriction_Id) return String;
|
|
|
195 -- Returns the capitalized image of Restriction
|
|
|
196
|
|
|
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.
|
|
|
200
|
|
|
201 ------------------------------------------
|
|
|
202 -- GNATDIST specific output subprograms --
|
|
|
203 ------------------------------------------
|
|
|
204
|
|
|
205 package GNATDIST is
|
|
|
206
|
|
|
207 -- Any modification to this subunit requires synchronization with the
|
|
|
208 -- GNATDIST sources.
|
|
|
209
|
|
|
210 procedure Output_ALI (A : ALI_Id);
|
|
|
211 -- Comment required saying what this routine does ???
|
|
|
212
|
|
|
213 procedure Output_No_ALI (Afile : File_Name_Type);
|
|
|
214 -- Comments required saying what this routine does ???
|
|
|
215
|
|
|
216 end GNATDIST;
|
|
|
217
|
|
|
218 ------------------------------
|
|
|
219 -- Support for project path --
|
|
|
220 ------------------------------
|
|
|
221
|
|
|
222 package Prj_Env is
|
|
|
223
|
|
|
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.
|
|
|
235
|
|
|
236 procedure Add_Directories
|
|
|
237 (Self : in out String_Access;
|
|
|
238 Path : String;
|
|
|
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
|
|
|
244 -- path.
|
|
|
245 --
|
|
|
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
|
|
|
248 -- path.
|
|
|
249
|
|
|
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.
|
|
|
255
|
|
|
256 end Prj_Env;
|
|
|
257
|
|
|
258 -----------------
|
|
|
259 -- Add_Lib_Dir --
|
|
|
260 -----------------
|
|
|
261
|
|
|
262 procedure Add_Lib_Dir (Dir : String) is
|
|
|
263 begin
|
|
|
264 if First_Lib_Dir = null then
|
|
|
265 First_Lib_Dir :=
|
|
|
266 new Dir_Data'
|
|
|
267 (Value => new String'(Dir),
|
|
|
268 Next => null);
|
|
|
269 Last_Lib_Dir := First_Lib_Dir;
|
|
|
270
|
|
|
271 else
|
|
|
272 Last_Lib_Dir.Next :=
|
|
|
273 new Dir_Data'
|
|
|
274 (Value => new String'(Dir),
|
|
|
275 Next => null);
|
|
|
276 Last_Lib_Dir := Last_Lib_Dir.Next;
|
|
|
277 end if;
|
|
|
278 end Add_Lib_Dir;
|
|
|
279
|
|
|
280 --------------------
|
|
|
281 -- Add_Source_Dir --
|
|
|
282 --------------------
|
|
|
283
|
|
|
284 procedure Add_Source_Dir (Dir : String) is
|
|
|
285 begin
|
|
|
286 if First_Source_Dir = null then
|
|
|
287 First_Source_Dir :=
|
|
|
288 new Dir_Data'
|
|
|
289 (Value => new String'(Dir),
|
|
|
290 Next => null);
|
|
|
291 Last_Source_Dir := First_Source_Dir;
|
|
|
292
|
|
|
293 else
|
|
|
294 Last_Source_Dir.Next :=
|
|
|
295 new Dir_Data'
|
|
|
296 (Value => new String'(Dir),
|
|
|
297 Next => null);
|
|
|
298 Last_Source_Dir := Last_Source_Dir.Next;
|
|
|
299 end if;
|
|
|
300 end Add_Source_Dir;
|
|
|
301
|
|
|
302 ------------------------------
|
|
|
303 -- Corresponding_Sdep_Entry --
|
|
|
304 ------------------------------
|
|
|
305
|
|
|
306 function Corresponding_Sdep_Entry
|
|
|
307 (A : ALI_Id;
|
|
|
308 U : Unit_Id) return Sdep_Id
|
|
|
309 is
|
|
|
310 begin
|
|
|
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
|
|
|
313 return D;
|
|
|
314 end if;
|
|
|
315 end loop;
|
|
|
316
|
|
|
317 Error_Msg_Unit_1 := Units.Table (U).Uname;
|
|
|
318 Error_Msg_File_1 := ALIs.Table (A).Afile;
|
|
|
319 Write_Eol;
|
|
|
320 Error_Msg ("wrong ALI format, can't find dependency line for $ in {");
|
|
|
321 Exit_Program (E_Fatal);
|
|
|
322 return No_Sdep_Id;
|
|
|
323 end Corresponding_Sdep_Entry;
|
|
|
324
|
|
|
325 -------------------------
|
|
|
326 -- Find_General_Layout --
|
|
|
327 -------------------------
|
|
|
328
|
|
|
329 procedure Find_General_Layout is
|
|
|
330 Max_Unit_Length : Integer := 11;
|
|
|
331 Max_Src_Length : Integer := 11;
|
|
|
332 Max_Obj_Length : Integer := 11;
|
|
|
333
|
|
|
334 Len : Integer;
|
|
|
335 FS : File_Name_Type;
|
|
|
336
|
|
|
337 begin
|
|
|
338 -- Compute maximum of each column
|
|
|
339
|
|
|
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
|
|
|
343
|
|
|
344 if Print_Unit then
|
|
|
345 Len := Name_Len - 1;
|
|
|
346 Max_Unit_Length := Integer'Max (Max_Unit_Length, Len);
|
|
|
347 end if;
|
|
|
348
|
|
|
349 if Print_Source then
|
|
|
350 FS := Full_Source_Name (ALIs.Table (Id).Sfile);
|
|
|
351
|
|
|
352 if FS = No_File then
|
|
|
353 Get_Name_String (ALIs.Table (Id).Sfile);
|
|
|
354 Name_Len := Name_Len + 13;
|
|
|
355 else
|
|
|
356 Get_Name_String (FS);
|
|
|
357 end if;
|
|
|
358
|
|
|
359 Max_Src_Length := Integer'Max (Max_Src_Length, Name_Len + 1);
|
|
|
360 end if;
|
|
|
361
|
|
|
362 if Print_Object then
|
|
|
363 if ALIs.Table (Id).No_Object then
|
|
|
364 Max_Obj_Length :=
|
|
|
365 Integer'Max (Max_Obj_Length, No_Obj'Length);
|
|
|
366 else
|
|
|
367 Get_Name_String (ALIs.Table (Id).Ofile_Full_Name);
|
|
|
368 Max_Obj_Length := Integer'Max (Max_Obj_Length, Name_Len + 1);
|
|
|
369 end if;
|
|
|
370 end if;
|
|
|
371 end if;
|
|
|
372 end loop;
|
|
|
373
|
|
|
374 -- Verify is output is not wider than maximum number of columns
|
|
|
375
|
|
|
376 Too_Long :=
|
|
|
377 Verbose_Mode
|
|
|
378 or else
|
|
|
379 (Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column;
|
|
|
380
|
|
|
381 -- Set start and end of columns
|
|
|
382
|
|
|
383 Object_Start := 1;
|
|
|
384 Object_End := Object_Start - 1;
|
|
|
385
|
|
|
386 if Print_Object then
|
|
|
387 Object_End := Object_Start + Max_Obj_Length;
|
|
|
388 end if;
|
|
|
389
|
|
|
390 Unit_Start := Object_End + 1;
|
|
|
391 Unit_End := Unit_Start - 1;
|
|
|
392
|
|
|
393 if Print_Unit then
|
|
|
394 Unit_End := Unit_Start + Max_Unit_Length;
|
|
|
395 end if;
|
|
|
396
|
|
|
397 Source_Start := Unit_End + 1;
|
|
|
398
|
|
|
399 if Source_Start > Spaces'Last then
|
|
|
400 Source_Start := Spaces'Last;
|
|
|
401 end if;
|
|
|
402
|
|
|
403 Source_End := Source_Start - 1;
|
|
|
404
|
|
|
405 if Print_Source then
|
|
|
406 Source_End := Source_Start + Max_Src_Length;
|
|
|
407 end if;
|
|
|
408 end Find_General_Layout;
|
|
|
409
|
|
|
410 -----------------
|
|
|
411 -- Find_Status --
|
|
|
412 -----------------
|
|
|
413
|
|
|
414 procedure Find_Status
|
|
|
415 (FS : in out File_Name_Type;
|
|
|
416 Stamp : Time_Stamp_Type;
|
|
|
417 Checksum : Word;
|
|
|
418 Status : out File_Status)
|
|
|
419 is
|
|
|
420 Tmp1 : File_Name_Type;
|
|
|
421 Tmp2 : File_Name_Type;
|
|
|
422
|
|
|
423 begin
|
|
|
424 Tmp1 := Full_Source_Name (FS);
|
|
|
425
|
|
|
426 if Tmp1 = No_File then
|
|
|
427 Status := Not_Found;
|
|
|
428
|
|
|
429 elsif File_Stamp (Tmp1) = Stamp then
|
|
|
430 FS := Tmp1;
|
|
|
431 Status := OK;
|
|
|
432
|
|
|
433 elsif Checksums_Match (Get_File_Checksum (FS), Checksum) then
|
|
|
434 FS := Tmp1;
|
|
|
435 Status := Checksum_OK;
|
|
|
436
|
|
|
437 else
|
|
|
438 Tmp2 := Matching_Full_Source_Name (FS, Stamp);
|
|
|
439
|
|
|
440 if Tmp2 = No_File then
|
|
|
441 Status := Not_Same;
|
|
|
442 FS := Tmp1;
|
|
|
443
|
|
|
444 else
|
|
|
445 Status := Not_First_On_PATH;
|
|
|
446 FS := Tmp2;
|
|
|
447 end if;
|
|
|
448 end if;
|
|
|
449 end Find_Status;
|
|
|
450
|
|
|
451 --------------
|
|
|
452 -- GNATDIST --
|
|
|
453 --------------
|
|
|
454
|
|
|
455 package body GNATDIST is
|
|
|
456
|
|
|
457 N_Flags : Natural;
|
|
|
458 N_Indents : Natural := 0;
|
|
|
459
|
|
|
460 type Token_Type is
|
|
|
461 (T_No_ALI,
|
|
|
462 T_ALI,
|
|
|
463 T_Unit,
|
|
|
464 T_With,
|
|
|
465 T_Source,
|
|
|
466 T_Afile,
|
|
|
467 T_Ofile,
|
|
|
468 T_Sfile,
|
|
|
469 T_Name,
|
|
|
470 T_Main,
|
|
|
471 T_Kind,
|
|
|
472 T_Flags,
|
|
|
473 T_Preelaborated,
|
|
|
474 T_Pure,
|
|
|
475 T_Has_RACW,
|
|
|
476 T_Remote_Types,
|
|
|
477 T_Shared_Passive,
|
|
|
478 T_RCI,
|
|
|
479 T_Predefined,
|
|
|
480 T_Internal,
|
|
|
481 T_Is_Generic,
|
|
|
482 T_Procedure,
|
|
|
483 T_Function,
|
|
|
484 T_Package,
|
|
|
485 T_Subprogram,
|
|
|
486 T_Spec,
|
|
|
487 T_Body);
|
|
|
488
|
|
|
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"));
|
|
|
517
|
|
|
518 procedure Output_Name (N : Name_Id);
|
|
|
519 -- Remove any encoding info (%b and %s) and output N
|
|
|
520
|
|
|
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.
|
|
|
526
|
|
|
527 procedure Output_Token (T : Token_Type);
|
|
|
528 -- Output token using specific format. That is several indentations and:
|
|
|
529 --
|
|
|
530 -- T_No_ALI .. T_With : <token> & " =>" & NL
|
|
|
531 -- T_Source .. T_Kind : <token> & " => "
|
|
|
532 -- T_Flags : <token> & " =>"
|
|
|
533 -- T_Preelab .. T_Body : " " & <token>
|
|
|
534
|
|
|
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)
|
|
|
539
|
|
|
540 ------------------
|
|
|
541 -- Output_Afile --
|
|
|
542 ------------------
|
|
|
543
|
|
|
544 procedure Output_Afile (A : File_Name_Type) is
|
|
|
545 begin
|
|
|
546 if A /= No_File then
|
|
|
547 Output_Token (T_Afile);
|
|
|
548 Write_Name (A);
|
|
|
549 Write_Eol;
|
|
|
550 end if;
|
|
|
551 end Output_Afile;
|
|
|
552
|
|
|
553 ----------------
|
|
|
554 -- Output_ALI --
|
|
|
555 ----------------
|
|
|
556
|
|
|
557 procedure Output_ALI (A : ALI_Id) is
|
|
|
558 begin
|
|
|
559 Output_Token (T_ALI);
|
|
|
560 N_Indents := N_Indents + 1;
|
|
|
561
|
|
|
562 Output_Afile (ALIs.Table (A).Afile);
|
|
|
563 Output_Ofile (ALIs.Table (A).Ofile_Full_Name);
|
|
|
564 Output_Sfile (ALIs.Table (A).Sfile);
|
|
|
565
|
|
|
566 -- Output Main
|
|
|
567
|
|
|
568 if ALIs.Table (A).Main_Program /= None then
|
|
|
569 Output_Token (T_Main);
|
|
|
570
|
|
|
571 if ALIs.Table (A).Main_Program = Proc then
|
|
|
572 Output_Token (T_Procedure);
|
|
|
573 else
|
|
|
574 Output_Token (T_Function);
|
|
|
575 end if;
|
|
|
576
|
|
|
577 Write_Eol;
|
|
|
578 end if;
|
|
|
579
|
|
|
580 -- Output Units
|
|
|
581
|
|
|
582 for U in ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit loop
|
|
|
583 Output_Unit (U);
|
|
|
584 end loop;
|
|
|
585
|
|
|
586 -- Output Sdeps
|
|
|
587
|
|
|
588 for S in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
|
|
|
589 Output_Sdep (S);
|
|
|
590 end loop;
|
|
|
591
|
|
|
592 N_Indents := N_Indents - 1;
|
|
|
593 end Output_ALI;
|
|
|
594
|
|
|
595 -------------------
|
|
|
596 -- Output_No_ALI --
|
|
|
597 -------------------
|
|
|
598
|
|
|
599 procedure Output_No_ALI (Afile : File_Name_Type) is
|
|
|
600 begin
|
|
|
601 Output_Token (T_No_ALI);
|
|
|
602 N_Indents := N_Indents + 1;
|
|
|
603 Output_Afile (Afile);
|
|
|
604 N_Indents := N_Indents - 1;
|
|
|
605 end Output_No_ALI;
|
|
|
606
|
|
|
607 -----------------
|
|
|
608 -- Output_Name --
|
|
|
609 -----------------
|
|
|
610
|
|
|
611 procedure Output_Name (N : Name_Id) is
|
|
|
612 begin
|
|
|
613 -- Remove any encoding info (%s or %b)
|
|
|
614
|
|
|
615 Get_Name_String (N);
|
|
|
616
|
|
|
617 if Name_Len > 2
|
|
|
618 and then Name_Buffer (Name_Len - 1) = '%'
|
|
|
619 then
|
|
|
620 Name_Len := Name_Len - 2;
|
|
|
621 end if;
|
|
|
622
|
|
|
623 Output_Token (T_Name);
|
|
|
624 Write_Str (Name_Buffer (1 .. Name_Len));
|
|
|
625 Write_Eol;
|
|
|
626 end Output_Name;
|
|
|
627
|
|
|
628 ------------------
|
|
|
629 -- Output_Ofile --
|
|
|
630 ------------------
|
|
|
631
|
|
|
632 procedure Output_Ofile (O : File_Name_Type) is
|
|
|
633 begin
|
|
|
634 if O /= No_File then
|
|
|
635 Output_Token (T_Ofile);
|
|
|
636 Write_Name (O);
|
|
|
637 Write_Eol;
|
|
|
638 end if;
|
|
|
639 end Output_Ofile;
|
|
|
640
|
|
|
641 -----------------
|
|
|
642 -- Output_Sdep --
|
|
|
643 -----------------
|
|
|
644
|
|
|
645 procedure Output_Sdep (S : Sdep_Id) is
|
|
|
646 begin
|
|
|
647 Output_Token (T_Source);
|
|
|
648 Write_Name (Sdep.Table (S).Sfile);
|
|
|
649 Write_Eol;
|
|
|
650 end Output_Sdep;
|
|
|
651
|
|
|
652 ------------------
|
|
|
653 -- Output_Sfile --
|
|
|
654 ------------------
|
|
|
655
|
|
|
656 procedure Output_Sfile (S : File_Name_Type) is
|
|
|
657 FS : File_Name_Type := S;
|
|
|
658
|
|
|
659 begin
|
|
|
660 if FS /= No_File then
|
|
|
661
|
|
|
662 -- We want to output the full source name
|
|
|
663
|
|
|
664 FS := Full_Source_Name (FS);
|
|
|
665
|
|
|
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.
|
|
|
673
|
|
|
674 if FS = No_File then
|
|
|
675 Get_Name_String (S);
|
|
|
676
|
|
|
677 if Name_Len > 4
|
|
|
678 and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb"
|
|
|
679 then
|
|
|
680 Name_Buffer (Name_Len) := 's';
|
|
|
681 FS := Full_Source_Name (Name_Find);
|
|
|
682 end if;
|
|
|
683 end if;
|
|
|
684 end if;
|
|
|
685
|
|
|
686 if FS /= No_File then
|
|
|
687 Output_Token (T_Sfile);
|
|
|
688 Write_Name (FS);
|
|
|
689 Write_Eol;
|
|
|
690 end if;
|
|
|
691 end Output_Sfile;
|
|
|
692
|
|
|
693 ------------------
|
|
|
694 -- Output_Token --
|
|
|
695 ------------------
|
|
|
696
|
|
|
697 procedure Output_Token (T : Token_Type) is
|
|
|
698 begin
|
|
131
|
699 case T is
|
|
|
700 when T_No_ALI .. T_Flags =>
|
|
|
701 for J in 1 .. N_Indents loop
|
|
|
702 Write_Str (" ");
|
|
|
703 end loop;
|
|
|
704
|
|
|
705 Write_Str (Image (T).all);
|
|
|
706
|
|
|
707 for J in Image (T)'Length .. 12 loop
|
|
|
708 Write_Char (' ');
|
|
|
709 end loop;
|
|
|
710
|
|
|
711 Write_Str ("=>");
|
|
|
712
|
|
|
713 if T in T_No_ALI .. T_With then
|
|
|
714 Write_Eol;
|
|
|
715 elsif T in T_Source .. T_Name then
|
|
|
716 Write_Char (' ');
|
|
|
717 end if;
|
|
|
718
|
|
|
719 when T_Preelaborated .. T_Body =>
|
|
|
720 if T in T_Preelaborated .. T_Is_Generic then
|
|
|
721 if N_Flags = 0 then
|
|
|
722 Output_Token (T_Flags);
|
|
|
723 end if;
|
|
|
724
|
|
|
725 N_Flags := N_Flags + 1;
|
|
|
726 end if;
|
|
|
727
|
|
111
|
728 Write_Char (' ');
|
|
131
|
729 Write_Str (Image (T).all);
|
|
|
730 end case;
|
|
111
|
731 end Output_Token;
|
|
|
732
|
|
|
733 -----------------
|
|
|
734 -- Output_Unit --
|
|
|
735 -----------------
|
|
|
736
|
|
|
737 procedure Output_Unit (U : Unit_Id) is
|
|
|
738 begin
|
|
|
739 Output_Token (T_Unit);
|
|
|
740 N_Indents := N_Indents + 1;
|
|
|
741
|
|
|
742 -- Output Name
|
|
|
743
|
|
|
744 Output_Name (Name_Id (Units.Table (U).Uname));
|
|
|
745
|
|
|
746 -- Output Kind
|
|
|
747
|
|
|
748 Output_Token (T_Kind);
|
|
|
749
|
|
|
750 if Units.Table (U).Unit_Kind = 'p' then
|
|
|
751 Output_Token (T_Package);
|
|
|
752 else
|
|
|
753 Output_Token (T_Subprogram);
|
|
|
754 end if;
|
|
|
755
|
|
|
756 if Name_Buffer (Name_Len) = 's' then
|
|
|
757 Output_Token (T_Spec);
|
|
|
758 else
|
|
|
759 Output_Token (T_Body);
|
|
|
760 end if;
|
|
|
761
|
|
|
762 Write_Eol;
|
|
|
763
|
|
|
764 -- Output source file name
|
|
|
765
|
|
|
766 Output_Sfile (Units.Table (U).Sfile);
|
|
|
767
|
|
|
768 -- Output Flags
|
|
|
769
|
|
|
770 N_Flags := 0;
|
|
|
771
|
|
|
772 if Units.Table (U).Preelab then
|
|
|
773 Output_Token (T_Preelaborated);
|
|
|
774 end if;
|
|
|
775
|
|
|
776 if Units.Table (U).Pure then
|
|
|
777 Output_Token (T_Pure);
|
|
|
778 end if;
|
|
|
779
|
|
|
780 if Units.Table (U).Has_RACW then
|
|
|
781 Output_Token (T_Has_RACW);
|
|
|
782 end if;
|
|
|
783
|
|
|
784 if Units.Table (U).Remote_Types then
|
|
|
785 Output_Token (T_Remote_Types);
|
|
|
786 end if;
|
|
|
787
|
|
|
788 if Units.Table (U).Shared_Passive then
|
|
|
789 Output_Token (T_Shared_Passive);
|
|
|
790 end if;
|
|
|
791
|
|
|
792 if Units.Table (U).RCI then
|
|
|
793 Output_Token (T_RCI);
|
|
|
794 end if;
|
|
|
795
|
|
|
796 if Units.Table (U).Predefined then
|
|
|
797 Output_Token (T_Predefined);
|
|
|
798 end if;
|
|
|
799
|
|
|
800 if Units.Table (U).Internal then
|
|
|
801 Output_Token (T_Internal);
|
|
|
802 end if;
|
|
|
803
|
|
|
804 if Units.Table (U).Is_Generic then
|
|
|
805 Output_Token (T_Is_Generic);
|
|
|
806 end if;
|
|
|
807
|
|
|
808 if N_Flags > 0 then
|
|
|
809 Write_Eol;
|
|
|
810 end if;
|
|
|
811
|
|
|
812 -- Output Withs
|
|
|
813
|
|
|
814 for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop
|
|
|
815 Output_With (W);
|
|
|
816 end loop;
|
|
|
817
|
|
|
818 N_Indents := N_Indents - 1;
|
|
|
819 end Output_Unit;
|
|
|
820
|
|
|
821 -----------------
|
|
|
822 -- Output_With --
|
|
|
823 -----------------
|
|
|
824
|
|
|
825 procedure Output_With (W : With_Id) is
|
|
|
826 begin
|
|
|
827 Output_Token (T_With);
|
|
|
828 N_Indents := N_Indents + 1;
|
|
|
829
|
|
|
830 Output_Name (Name_Id (Withs.Table (W).Uname));
|
|
|
831
|
|
|
832 -- Output Kind
|
|
|
833
|
|
|
834 Output_Token (T_Kind);
|
|
|
835
|
|
|
836 if Name_Buffer (Name_Len) = 's' then
|
|
|
837 Output_Token (T_Spec);
|
|
|
838 else
|
|
|
839 Output_Token (T_Body);
|
|
|
840 end if;
|
|
|
841
|
|
|
842 Write_Eol;
|
|
|
843
|
|
|
844 Output_Afile (Withs.Table (W).Afile);
|
|
|
845 Output_Sfile (Withs.Table (W).Sfile);
|
|
|
846
|
|
|
847 N_Indents := N_Indents - 1;
|
|
|
848 end Output_With;
|
|
|
849
|
|
|
850 end GNATDIST;
|
|
|
851
|
|
|
852 -----------
|
|
|
853 -- Image --
|
|
|
854 -----------
|
|
|
855
|
|
|
856 function Image (Restriction : Restriction_Id) return String is
|
|
|
857 Result : String := Restriction'Img;
|
|
|
858 Skip : Boolean := True;
|
|
|
859
|
|
|
860 begin
|
|
|
861 for J in Result'Range loop
|
|
|
862 if Skip then
|
|
|
863 Skip := False;
|
|
|
864 Result (J) := To_Upper (Result (J));
|
|
|
865
|
|
|
866 elsif Result (J) = '_' then
|
|
|
867 Skip := True;
|
|
|
868
|
|
|
869 else
|
|
|
870 Result (J) := To_Lower (Result (J));
|
|
|
871 end if;
|
|
|
872 end loop;
|
|
|
873
|
|
|
874 return Result;
|
|
|
875 end Image;
|
|
|
876
|
|
|
877 ---------------
|
|
|
878 -- Normalize --
|
|
|
879 ---------------
|
|
|
880
|
|
|
881 function Normalize (Path : String) return String is
|
|
|
882 begin
|
|
|
883 return Normalize_Pathname (Path);
|
|
|
884 end Normalize;
|
|
|
885
|
|
|
886 --------------------------------
|
|
|
887 -- Output_License_Information --
|
|
|
888 --------------------------------
|
|
|
889
|
|
|
890 procedure Output_License_Information is
|
|
|
891 begin
|
|
|
892 case Build_Type is
|
|
|
893 when others =>
|
|
|
894 Write_Str ("Please refer to file COPYING in your distribution"
|
|
|
895 & " for license terms.");
|
|
|
896 Write_Eol;
|
|
|
897 end case;
|
|
|
898
|
|
|
899 Exit_Program (E_Success);
|
|
|
900 end Output_License_Information;
|
|
|
901
|
|
|
902 -------------------
|
|
|
903 -- Output_Object --
|
|
|
904 -------------------
|
|
|
905
|
|
|
906 procedure Output_Object (O : File_Name_Type) is
|
|
|
907 Object_Name : String_Access;
|
|
|
908
|
|
|
909 begin
|
|
|
910 if Print_Object then
|
|
|
911 if O /= No_File then
|
|
|
912 Get_Name_String (O);
|
|
|
913 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
|
|
|
914 else
|
|
|
915 Object_Name := No_Obj'Unchecked_Access;
|
|
|
916 end if;
|
|
|
917
|
|
|
918 Write_Str (Object_Name.all);
|
|
|
919
|
|
|
920 if Print_Source or else Print_Unit then
|
|
|
921 if Too_Long then
|
|
|
922 Write_Eol;
|
|
|
923 Write_Str (" ");
|
|
|
924 else
|
|
|
925 Write_Str (Spaces
|
|
|
926 (Object_Start + Object_Name'Length .. Object_End));
|
|
|
927 end if;
|
|
|
928 end if;
|
|
|
929 end if;
|
|
|
930 end Output_Object;
|
|
|
931
|
|
|
932 -------------------
|
|
|
933 -- Output_Source --
|
|
|
934 -------------------
|
|
|
935
|
|
|
936 procedure Output_Source (Sdep_I : Sdep_Id) is
|
|
|
937 Stamp : Time_Stamp_Type;
|
|
|
938 Checksum : Word;
|
|
|
939 FS : File_Name_Type;
|
|
|
940 Status : File_Status;
|
|
|
941 Object_Name : String_Access;
|
|
|
942
|
|
|
943 begin
|
|
|
944 if Sdep_I = No_Sdep_Id then
|
|
|
945 return;
|
|
|
946 end if;
|
|
|
947
|
|
|
948 Stamp := Sdep.Table (Sdep_I).Stamp;
|
|
|
949 Checksum := Sdep.Table (Sdep_I).Checksum;
|
|
|
950 FS := Sdep.Table (Sdep_I).Sfile;
|
|
|
951
|
|
|
952 if Print_Source then
|
|
|
953 Find_Status (FS, Stamp, Checksum, Status);
|
|
|
954 Get_Name_String (FS);
|
|
|
955
|
|
|
956 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
|
|
|
957
|
|
|
958 if Verbose_Mode then
|
|
|
959 Write_Str (" Source => ");
|
|
|
960 Write_Str (Object_Name.all);
|
|
|
961
|
|
|
962 if not Too_Long then
|
|
|
963 Write_Str
|
|
|
964 (Spaces (Source_Start + Object_Name'Length .. Source_End));
|
|
|
965 end if;
|
|
|
966
|
|
|
967 Output_Status (Status, Verbose => True);
|
|
|
968 Write_Eol;
|
|
|
969 Write_Str (" ");
|
|
|
970
|
|
|
971 else
|
|
|
972 if not Selective_Output then
|
|
|
973 Output_Status (Status, Verbose => False);
|
|
|
974 end if;
|
|
|
975
|
|
|
976 Write_Str (Object_Name.all);
|
|
|
977 end if;
|
|
|
978 end if;
|
|
|
979 end Output_Source;
|
|
|
980
|
|
|
981 -------------------
|
|
|
982 -- Output_Status --
|
|
|
983 -------------------
|
|
|
984
|
|
|
985 procedure Output_Status (FS : File_Status; Verbose : Boolean) is
|
|
|
986 begin
|
|
|
987 if Verbose then
|
|
|
988 case FS is
|
|
|
989 when OK =>
|
|
|
990 Write_Str (" unchanged");
|
|
|
991
|
|
|
992 when Checksum_OK =>
|
|
|
993 Write_Str (" slightly modified");
|
|
|
994
|
|
|
995 when Not_Found =>
|
|
|
996 Write_Str (" file not found");
|
|
|
997
|
|
|
998 when Not_Same =>
|
|
|
999 Write_Str (" modified");
|
|
|
1000
|
|
|
1001 when Not_First_On_PATH =>
|
|
|
1002 Write_Str (" unchanged version not first on PATH");
|
|
|
1003 end case;
|
|
|
1004
|
|
|
1005 else
|
|
|
1006 case FS is
|
|
|
1007 when OK =>
|
|
|
1008 Write_Str (" OK ");
|
|
|
1009
|
|
|
1010 when Checksum_OK =>
|
|
|
1011 Write_Str (" MOK ");
|
|
|
1012
|
|
|
1013 when Not_Found =>
|
|
|
1014 Write_Str (" ??? ");
|
|
|
1015
|
|
|
1016 when Not_Same =>
|
|
|
1017 Write_Str (" DIF ");
|
|
|
1018
|
|
|
1019 when Not_First_On_PATH =>
|
|
|
1020 Write_Str (" HID ");
|
|
|
1021 end case;
|
|
|
1022 end if;
|
|
|
1023 end Output_Status;
|
|
|
1024
|
|
|
1025 -----------------
|
|
|
1026 -- Output_Unit --
|
|
|
1027 -----------------
|
|
|
1028
|
|
|
1029 procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id) is
|
|
|
1030 Kind : Character;
|
|
|
1031 U : Unit_Record renames Units.Table (U_Id);
|
|
|
1032
|
|
|
1033 begin
|
|
|
1034 if Print_Unit then
|
|
|
1035 Get_Name_String (U.Uname);
|
|
|
1036 Kind := Name_Buffer (Name_Len);
|
|
|
1037 Name_Len := Name_Len - 2;
|
|
|
1038
|
|
|
1039 if not Verbose_Mode then
|
|
|
1040 Write_Str (Name_Buffer (1 .. Name_Len));
|
|
|
1041
|
|
|
1042 else
|
|
|
1043 Write_Str ("Unit => ");
|
|
|
1044 Write_Eol;
|
|
|
1045 Write_Str (" Name => ");
|
|
|
1046 Write_Str (Name_Buffer (1 .. Name_Len));
|
|
|
1047 Write_Eol;
|
|
|
1048 Write_Str (" Kind => ");
|
|
|
1049
|
|
|
1050 if Units.Table (U_Id).Unit_Kind = 'p' then
|
|
|
1051 Write_Str ("package ");
|
|
|
1052 else
|
|
|
1053 Write_Str ("subprogram ");
|
|
|
1054 end if;
|
|
|
1055
|
|
|
1056 if Kind = 's' then
|
|
|
1057 Write_Str ("spec");
|
|
|
1058 else
|
|
|
1059 Write_Str ("body");
|
|
|
1060 end if;
|
|
|
1061 end if;
|
|
|
1062
|
|
|
1063 if Verbose_Mode then
|
|
|
1064 if U.Preelab or else
|
|
|
1065 U.No_Elab or else
|
|
|
1066 U.Pure or else
|
|
|
1067 U.Dynamic_Elab or else
|
|
|
1068 U.Has_RACW or else
|
|
|
1069 U.Remote_Types or else
|
|
|
1070 U.Shared_Passive or else
|
|
|
1071 U.RCI or else
|
|
|
1072 U.Predefined or else
|
|
|
1073 U.Internal 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
|
|
|
1078 U.Elaborate_Body
|
|
|
1079 then
|
|
|
1080 Write_Eol;
|
|
|
1081 Write_Str (" Flags =>");
|
|
|
1082
|
|
|
1083 if U.Preelab then
|
|
|
1084 Write_Str (" Preelaborable");
|
|
|
1085 end if;
|
|
|
1086
|
|
|
1087 if U.No_Elab then
|
|
|
1088 Write_Str (" No_Elab_Code");
|
|
|
1089 end if;
|
|
|
1090
|
|
|
1091 if U.Pure then
|
|
|
1092 Write_Str (" Pure");
|
|
|
1093 end if;
|
|
|
1094
|
|
|
1095 if U.Dynamic_Elab then
|
|
|
1096 Write_Str (" Dynamic_Elab");
|
|
|
1097 end if;
|
|
|
1098
|
|
|
1099 if U.Has_RACW then
|
|
|
1100 Write_Str (" Has_RACW");
|
|
|
1101 end if;
|
|
|
1102
|
|
|
1103 if U.Remote_Types then
|
|
|
1104 Write_Str (" Remote_Types");
|
|
|
1105 end if;
|
|
|
1106
|
|
|
1107 if U.Shared_Passive then
|
|
|
1108 Write_Str (" Shared_Passive");
|
|
|
1109 end if;
|
|
|
1110
|
|
|
1111 if U.RCI then
|
|
|
1112 Write_Str (" RCI");
|
|
|
1113 end if;
|
|
|
1114
|
|
|
1115 if U.Predefined then
|
|
|
1116 Write_Str (" Predefined");
|
|
|
1117 end if;
|
|
|
1118
|
|
|
1119 if U.Internal then
|
|
|
1120 Write_Str (" Internal");
|
|
|
1121 end if;
|
|
|
1122
|
|
|
1123 if U.Is_Generic then
|
|
|
1124 Write_Str (" Is_Generic");
|
|
|
1125 end if;
|
|
|
1126
|
|
|
1127 if U.Init_Scalars then
|
|
|
1128 Write_Str (" Init_Scalars");
|
|
|
1129 end if;
|
|
|
1130
|
|
|
1131 if U.SAL_Interface then
|
|
|
1132 Write_Str (" SAL_Interface");
|
|
|
1133 end if;
|
|
|
1134
|
|
|
1135 if U.Body_Needed_For_SAL then
|
|
|
1136 Write_Str (" Body_Needed_For_SAL");
|
|
|
1137 end if;
|
|
|
1138
|
|
|
1139 if U.Elaborate_Body then
|
|
|
1140 Write_Str (" Elaborate Body");
|
|
|
1141 end if;
|
|
|
1142
|
|
|
1143 if U.Remote_Types then
|
|
|
1144 Write_Str (" Remote_Types");
|
|
|
1145 end if;
|
|
|
1146
|
|
|
1147 if U.Shared_Passive then
|
|
|
1148 Write_Str (" Shared_Passive");
|
|
|
1149 end if;
|
|
|
1150
|
|
|
1151 if U.Predefined then
|
|
|
1152 Write_Str (" Predefined");
|
|
|
1153 end if;
|
|
|
1154 end if;
|
|
|
1155
|
|
|
1156 declare
|
|
|
1157 Restrictions : constant Restrictions_Info :=
|
|
|
1158 ALIs.Table (ALI).Restrictions;
|
|
|
1159
|
|
|
1160 begin
|
|
|
1161 -- If the source was compiled with pragmas Restrictions,
|
|
|
1162 -- Display these restrictions.
|
|
|
1163
|
|
|
1164 if Restrictions.Set /= (All_Restrictions => False) then
|
|
|
1165 Write_Eol;
|
|
|
1166 Write_Str (" pragma Restrictions =>");
|
|
|
1167
|
|
|
1168 -- For boolean restrictions, just display the name of the
|
|
|
1169 -- restriction; for valued restrictions, also display the
|
|
|
1170 -- restriction value.
|
|
|
1171
|
|
|
1172 for Restriction in All_Restrictions loop
|
|
|
1173 if Restrictions.Set (Restriction) then
|
|
|
1174 Write_Eol;
|
|
|
1175 Write_Str (" ");
|
|
|
1176 Write_Str (Image (Restriction));
|
|
|
1177
|
|
|
1178 if Restriction in All_Parameter_Restrictions then
|
|
|
1179 Write_Str (" =>");
|
|
|
1180 Write_Str (Restrictions.Value (Restriction)'Img);
|
|
|
1181 end if;
|
|
|
1182 end if;
|
|
|
1183 end loop;
|
|
|
1184 end if;
|
|
|
1185
|
|
|
1186 -- If the unit violates some Restrictions, display the list of
|
|
|
1187 -- these restrictions.
|
|
|
1188
|
|
|
1189 if Restrictions.Violated /= (All_Restrictions => False) then
|
|
|
1190 Write_Eol;
|
|
|
1191 Write_Str (" Restrictions violated =>");
|
|
|
1192
|
|
|
1193 -- For boolean restrictions, just display the name of the
|
|
|
1194 -- restriction. For valued restrictions, also display the
|
|
|
1195 -- restriction value.
|
|
|
1196
|
|
|
1197 for Restriction in All_Restrictions loop
|
|
|
1198 if Restrictions.Violated (Restriction) then
|
|
|
1199 Write_Eol;
|
|
|
1200 Write_Str (" ");
|
|
|
1201 Write_Str (Image (Restriction));
|
|
|
1202
|
|
|
1203 if Restriction in All_Parameter_Restrictions then
|
|
|
1204 if Restrictions.Count (Restriction) > 0 then
|
|
|
1205 Write_Str (" =>");
|
|
|
1206
|
|
|
1207 if Restrictions.Unknown (Restriction) then
|
|
|
1208 Write_Str (" at least");
|
|
|
1209 end if;
|
|
|
1210
|
|
|
1211 Write_Str (Restrictions.Count (Restriction)'Img);
|
|
|
1212 end if;
|
|
|
1213 end if;
|
|
|
1214 end if;
|
|
|
1215 end loop;
|
|
|
1216 end if;
|
|
|
1217 end;
|
|
|
1218 end if;
|
|
|
1219
|
|
|
1220 if Print_Source then
|
|
|
1221 if Too_Long then
|
|
|
1222 Write_Eol;
|
|
|
1223 Write_Str (" ");
|
|
|
1224 else
|
|
|
1225 Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
|
|
|
1226 end if;
|
|
|
1227 end if;
|
|
|
1228 end if;
|
|
|
1229 end Output_Unit;
|
|
|
1230
|
|
|
1231 package body Prj_Env is
|
|
|
1232
|
|
|
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.
|
|
|
1236
|
|
|
1237 ---------------------
|
|
|
1238 -- Add_Directories --
|
|
|
1239 ---------------------
|
|
|
1240
|
|
|
1241 procedure Add_Directories
|
|
|
1242 (Self : in out String_Access;
|
|
|
1243 Path : String;
|
|
|
1244 Prepend : Boolean := False)
|
|
|
1245 is
|
|
|
1246 Tmp : String_Access;
|
|
|
1247
|
|
|
1248 begin
|
|
|
1249 if Self = null then
|
|
|
1250 Self := new String'(Uninitialized_Prefix & Path);
|
|
|
1251 else
|
|
|
1252 Tmp := Self;
|
|
|
1253 if Prepend then
|
|
|
1254 Self := new String'(Path & Path_Separator & Tmp.all);
|
|
|
1255 else
|
|
|
1256 Self := new String'(Tmp.all & Path_Separator & Path);
|
|
|
1257 end if;
|
|
|
1258 Free (Tmp);
|
|
|
1259 end if;
|
|
|
1260 end Add_Directories;
|
|
|
1261
|
|
|
1262 -------------------------------------
|
|
|
1263 -- Initialize_Default_Project_Path --
|
|
|
1264 -------------------------------------
|
|
|
1265
|
|
|
1266 procedure Initialize_Default_Project_Path
|
|
|
1267 (Self : in out String_Access;
|
|
|
1268 Target_Name : String;
|
|
|
1269 Runtime_Name : String := "")
|
|
|
1270 is
|
|
|
1271 Add_Default_Dir : Boolean := Target_Name /= "-";
|
|
|
1272 First : Positive;
|
|
|
1273 Last : Positive;
|
|
|
1274
|
|
|
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.
|
|
|
1282
|
|
|
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.
|
|
|
1287 -- May be empty.
|
|
|
1288
|
|
|
1289 Prefix : String_Ptr;
|
|
|
1290 Runtime : String_Ptr;
|
|
|
1291
|
|
|
1292 procedure Add_Target (Suffix : String);
|
|
|
1293 -- Add :<prefix>/<target>/Suffix to the project path
|
|
|
1294
|
|
|
1295 FD : File_Descriptor;
|
|
|
1296 Len : Integer;
|
|
|
1297
|
|
|
1298 ----------------
|
|
|
1299 -- Add_Target --
|
|
|
1300 ----------------
|
|
|
1301
|
|
|
1302 procedure Add_Target (Suffix : String) is
|
|
|
1303 Extra_Sep : constant String :=
|
|
|
1304 (if Target_Name (Target_Name'Last) = '/' then
|
|
|
1305 ""
|
|
|
1306 else
|
|
|
1307 (1 => Directory_Separator));
|
|
|
1308 -- Note: Target_Name has a trailing / when it comes from Sdefault
|
|
|
1309
|
|
|
1310 begin
|
|
|
1311 Add_Str_To_Name_Buffer
|
|
|
1312 (Path_Separator & Prefix.all & Target_Name & Extra_Sep & Suffix);
|
|
|
1313 end Add_Target;
|
|
|
1314
|
|
|
1315 -- Start of processing for Initialize_Default_Project_Path
|
|
|
1316
|
|
|
1317 begin
|
|
|
1318 if Self /= null
|
|
|
1319 and then (Self'Length = 0
|
|
|
1320 or else Self (Self'First) /= '#')
|
|
|
1321 then
|
|
|
1322 return;
|
|
|
1323 end if;
|
|
|
1324
|
|
|
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 '.'
|
|
|
1328
|
|
|
1329 if Self = null then
|
|
|
1330 Self := new String'('.' & Path_Separator);
|
|
|
1331 else
|
|
|
1332 Self (Self'First) := '.';
|
|
|
1333 end if;
|
|
|
1334
|
|
|
1335 -- Then the reset of the project path (if any) currently contains the
|
|
|
1336 -- directories added through Add_Search_Project_Directory
|
|
|
1337
|
|
|
1338 -- If environment variables are defined and not empty, add their
|
|
|
1339 -- content
|
|
|
1340
|
|
|
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);
|
|
|
1344
|
|
|
1345 if Gpr_Prj_Path_File.all /= "" then
|
|
|
1346 FD := Open_Read (Gpr_Prj_Path_File.all, GNAT.OS_Lib.Text);
|
|
|
1347
|
|
|
1348 if FD = Invalid_FD then
|
|
|
1349 Osint.Fail
|
|
|
1350 ("warning: could not read project path file """
|
|
|
1351 & Gpr_Prj_Path_File.all & """");
|
|
|
1352 end if;
|
|
|
1353
|
|
|
1354 Len := Integer (File_Length (FD));
|
|
|
1355
|
|
|
1356 declare
|
|
|
1357 Buffer : String (1 .. Len);
|
|
|
1358 Index : Positive := 1;
|
|
|
1359 Last : Positive;
|
|
|
1360 Tmp : String_Access;
|
|
|
1361
|
|
|
1362 begin
|
|
|
1363 -- Read the file
|
|
|
1364
|
|
|
1365 Len := Read (FD, Buffer (1)'Address, Len);
|
|
|
1366 Close (FD);
|
|
|
1367
|
|
|
1368 -- Scan the file line by line
|
|
|
1369
|
|
|
1370 while Index < Buffer'Last loop
|
|
|
1371
|
|
|
1372 -- Find the end of line
|
|
|
1373
|
|
|
1374 Last := Index;
|
|
|
1375 while Last <= Buffer'Last
|
|
|
1376 and then Buffer (Last) /= ASCII.LF
|
|
|
1377 and then Buffer (Last) /= ASCII.CR
|
|
|
1378 loop
|
|
|
1379 Last := Last + 1;
|
|
|
1380 end loop;
|
|
|
1381
|
|
|
1382 -- Ignore empty lines
|
|
|
1383
|
|
|
1384 if Last > Index then
|
|
|
1385 Tmp := Self;
|
|
|
1386 Self :=
|
|
|
1387 new String'
|
|
|
1388 (Tmp.all & Path_Separator &
|
|
|
1389 Buffer (Index .. Last - 1));
|
|
|
1390 Free (Tmp);
|
|
|
1391 end if;
|
|
|
1392
|
|
|
1393 -- Find the beginning of the next line
|
|
|
1394
|
|
|
1395 Index := Last;
|
|
|
1396 while Buffer (Index) = ASCII.CR or else
|
|
|
1397 Buffer (Index) = ASCII.LF
|
|
|
1398 loop
|
|
|
1399 Index := Index + 1;
|
|
|
1400 end loop;
|
|
|
1401 end loop;
|
|
|
1402 end;
|
|
|
1403
|
|
|
1404 end if;
|
|
|
1405
|
|
|
1406 if Gpr_Prj_Path.all /= "" then
|
|
|
1407 Add_Directories (Self, Gpr_Prj_Path.all);
|
|
|
1408 end if;
|
|
|
1409
|
|
|
1410 Free (Gpr_Prj_Path);
|
|
|
1411
|
|
|
1412 if Ada_Prj_Path.all /= "" then
|
|
|
1413 Add_Directories (Self, Ada_Prj_Path.all);
|
|
|
1414 end if;
|
|
|
1415
|
|
|
1416 Free (Ada_Prj_Path);
|
|
|
1417
|
|
|
1418 -- Copy to Name_Buffer, since we will need to manipulate the path
|
|
|
1419
|
|
|
1420 Name_Len := Self'Length;
|
|
|
1421 Name_Buffer (1 .. Name_Len) := Self.all;
|
|
|
1422
|
|
|
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.
|
|
|
1426
|
|
|
1427 First := 3;
|
|
|
1428 loop
|
|
|
1429 while First <= Name_Len
|
|
|
1430 and then (Name_Buffer (First) = Path_Separator)
|
|
|
1431 loop
|
|
|
1432 First := First + 1;
|
|
|
1433 end loop;
|
|
|
1434
|
|
|
1435 exit when First > Name_Len;
|
|
|
1436
|
|
|
1437 Last := First;
|
|
|
1438
|
|
|
1439 while Last < Name_Len
|
|
|
1440 and then Name_Buffer (Last + 1) /= Path_Separator
|
|
|
1441 loop
|
|
|
1442 Last := Last + 1;
|
|
|
1443 end loop;
|
|
|
1444
|
|
|
1445 -- If the directory is "-", set Add_Default_Dir to False and
|
|
|
1446 -- remove from path.
|
|
|
1447
|
|
|
1448 if Name_Buffer (First .. Last) = "-" then
|
|
|
1449 Add_Default_Dir := False;
|
|
|
1450
|
|
|
1451 for J in Last + 1 .. Name_Len loop
|
|
|
1452 Name_Buffer (J - 2) := Name_Buffer (J);
|
|
|
1453 end loop;
|
|
|
1454
|
|
|
1455 Name_Len := Name_Len - 2;
|
|
|
1456
|
|
|
1457 -- After removing the '-', go back one character to get the
|
|
|
1458 -- next directory correctly.
|
|
|
1459
|
|
|
1460 Last := Last - 1;
|
|
|
1461
|
|
|
1462 else
|
|
|
1463 declare
|
|
|
1464 New_Dir : constant String :=
|
|
|
1465 Normalize_Pathname
|
|
|
1466 (Name_Buffer (First .. Last),
|
|
|
1467 Resolve_Links => Opt.Follow_Links_For_Dirs);
|
|
|
1468 New_Len : Positive;
|
|
|
1469 New_Last : Positive;
|
|
|
1470
|
|
|
1471 begin
|
|
|
1472 -- If the absolute path was resolved and is different from
|
|
|
1473 -- the original, replace original with the resolved path.
|
|
|
1474
|
|
|
1475 if New_Dir /= Name_Buffer (First .. Last)
|
|
|
1476 and then New_Dir'Length /= 0
|
|
|
1477 then
|
|
|
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;
|
|
|
1484 Last := New_Last;
|
|
|
1485 end if;
|
|
|
1486 end;
|
|
|
1487 end if;
|
|
|
1488
|
|
|
1489 First := Last + 1;
|
|
|
1490 end loop;
|
|
|
1491
|
|
|
1492 Free (Self);
|
|
|
1493
|
|
|
1494 -- Set the initial value of Current_Project_Path
|
|
|
1495
|
|
|
1496 if Add_Default_Dir then
|
|
|
1497 if Sdefault.Search_Dir_Prefix = null then
|
|
|
1498
|
|
|
1499 -- gprbuild case
|
|
|
1500
|
|
|
1501 Prefix := new String'(Executable_Prefix_Path);
|
|
|
1502
|
|
|
1503 else
|
|
|
1504 Prefix := new String'(Sdefault.Search_Dir_Prefix.all
|
|
|
1505 & ".." & Dir_Separator
|
|
|
1506 & ".." & Dir_Separator
|
|
|
1507 & ".." & Dir_Separator
|
|
|
1508 & ".." & Dir_Separator);
|
|
|
1509 end if;
|
|
|
1510
|
|
|
1511 if Prefix.all /= "" then
|
|
|
1512 if Target_Name /= "" then
|
|
|
1513
|
|
|
1514 if Runtime_Name /= "" then
|
|
|
1515 if Base_Name (Runtime_Name) = Runtime_Name then
|
|
|
1516
|
|
|
1517 -- $prefix/$target/$runtime/lib/gnat
|
|
|
1518
|
|
|
1519 Add_Target
|
|
|
1520 (Runtime_Name & Directory_Separator &
|
|
|
1521 "lib" & Directory_Separator & "gnat");
|
|
|
1522
|
|
|
1523 -- $prefix/$target/$runtime/share/gpr
|
|
|
1524
|
|
|
1525 Add_Target
|
|
|
1526 (Runtime_Name & Directory_Separator &
|
|
|
1527 "share" & Directory_Separator & "gpr");
|
|
|
1528
|
|
|
1529 else
|
|
|
1530 Runtime :=
|
|
|
1531 new String'(Normalize_Pathname (Runtime_Name));
|
|
|
1532
|
|
|
1533 -- $runtime_dir/lib/gnat
|
|
|
1534
|
|
|
1535 Add_Str_To_Name_Buffer
|
|
|
1536 (Path_Separator & Runtime.all & Directory_Separator &
|
|
|
1537 "lib" & Directory_Separator & "gnat");
|
|
|
1538
|
|
|
1539 -- $runtime_dir/share/gpr
|
|
|
1540
|
|
|
1541 Add_Str_To_Name_Buffer
|
|
|
1542 (Path_Separator & Runtime.all & Directory_Separator &
|
|
|
1543 "share" & Directory_Separator & "gpr");
|
|
|
1544 end if;
|
|
|
1545 end if;
|
|
|
1546
|
|
|
1547 -- $prefix/$target/lib/gnat
|
|
|
1548
|
|
|
1549 Add_Target
|
|
|
1550 ("lib" & Directory_Separator & "gnat");
|
|
|
1551
|
|
|
1552 -- $prefix/$target/share/gpr
|
|
|
1553
|
|
|
1554 Add_Target
|
|
|
1555 ("share" & Directory_Separator & "gpr");
|
|
|
1556 end if;
|
|
|
1557
|
|
|
1558 -- $prefix/share/gpr
|
|
|
1559
|
|
|
1560 Add_Str_To_Name_Buffer
|
|
|
1561 (Path_Separator & Prefix.all & "share"
|
|
|
1562 & Directory_Separator & "gpr");
|
|
|
1563
|
|
|
1564 -- $prefix/lib/gnat
|
|
|
1565
|
|
|
1566 Add_Str_To_Name_Buffer
|
|
|
1567 (Path_Separator & Prefix.all & "lib"
|
|
|
1568 & Directory_Separator & "gnat");
|
|
|
1569 end if;
|
|
|
1570
|
|
|
1571 Free (Prefix);
|
|
|
1572 end if;
|
|
|
1573
|
|
|
1574 Self := new String'(Name_Buffer (1 .. Name_Len));
|
|
|
1575 end Initialize_Default_Project_Path;
|
|
|
1576
|
|
|
1577 -----------------------
|
|
|
1578 -- Get_Runtime_Path --
|
|
|
1579 -----------------------
|
|
|
1580
|
|
|
1581 function Get_Runtime_Path
|
|
|
1582 (Self : String_Access;
|
|
|
1583 Path : String) return String_Access
|
|
|
1584 is
|
|
|
1585 First : Natural;
|
|
|
1586 Last : Natural;
|
|
|
1587
|
|
|
1588 begin
|
|
|
1589
|
|
|
1590 if Is_Absolute_Path (Path) then
|
|
|
1591 if Is_Directory (Path) then
|
|
|
1592 return new String'(Path);
|
|
|
1593 else
|
|
|
1594 return null;
|
|
|
1595 end if;
|
|
|
1596
|
|
|
1597 else
|
|
|
1598 -- Because we do not want to resolve symbolic links, we cannot
|
|
|
1599 -- use Locate_Regular_File. Instead we try each possible path
|
|
|
1600 -- successively.
|
|
|
1601
|
|
|
1602 First := Self'First;
|
|
|
1603 while First <= Self'Last loop
|
|
|
1604 while First <= Self'Last
|
|
|
1605 and then Self (First) = Path_Separator
|
|
|
1606 loop
|
|
|
1607 First := First + 1;
|
|
|
1608 end loop;
|
|
|
1609
|
|
|
1610 exit when First > Self'Last;
|
|
|
1611
|
|
|
1612 Last := First;
|
|
|
1613 while Last < Self'Last
|
|
|
1614 and then Self (Last + 1) /= Path_Separator
|
|
|
1615 loop
|
|
|
1616 Last := Last + 1;
|
|
|
1617 end loop;
|
|
|
1618
|
|
|
1619 Name_Len := 0;
|
|
|
1620
|
|
|
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);
|
|
|
1624 end if;
|
|
|
1625
|
|
|
1626 Add_Str_To_Name_Buffer (Self (First .. Last));
|
|
|
1627 Add_Char_To_Name_Buffer (Directory_Separator);
|
|
|
1628 Add_Str_To_Name_Buffer (Path);
|
|
|
1629
|
|
|
1630 if Is_Directory (Name_Buffer (1 .. Name_Len)) then
|
|
|
1631 return new String'(Name_Buffer (1 .. Name_Len));
|
|
|
1632 end if;
|
|
|
1633
|
|
|
1634 First := Last + 1;
|
|
|
1635 end loop;
|
|
|
1636 end if;
|
|
|
1637
|
|
|
1638 return null;
|
|
|
1639 end Get_Runtime_Path;
|
|
|
1640
|
|
|
1641 end Prj_Env;
|
|
|
1642
|
|
|
1643 -----------------
|
|
|
1644 -- Reset_Print --
|
|
|
1645 -----------------
|
|
|
1646
|
|
|
1647 procedure Reset_Print is
|
|
|
1648 begin
|
|
|
1649 if not Selective_Output then
|
|
|
1650 Selective_Output := True;
|
|
|
1651 Print_Source := False;
|
|
|
1652 Print_Object := False;
|
|
|
1653 Print_Unit := False;
|
|
|
1654 end if;
|
|
|
1655 end Reset_Print;
|
|
|
1656
|
|
|
1657 ----------------
|
|
|
1658 -- Search_RTS --
|
|
|
1659 ----------------
|
|
|
1660
|
|
|
1661 procedure Search_RTS (Name : String) is
|
|
|
1662 Src_Path : String_Ptr;
|
|
|
1663 Lib_Path : String_Ptr;
|
|
|
1664 -- Paths for source and include subdirs
|
|
|
1665
|
|
|
1666 Rts_Full_Path : String_Access;
|
|
|
1667 -- Full path for RTS project
|
|
|
1668
|
|
|
1669 begin
|
|
|
1670 -- Try to find the RTS
|
|
|
1671
|
|
|
1672 Src_Path := Get_RTS_Search_Dir (Name, Include);
|
|
|
1673 Lib_Path := Get_RTS_Search_Dir (Name, Objects);
|
|
|
1674
|
|
|
1675 -- For non-project RTS, both the include and the objects directories
|
|
|
1676 -- must be present.
|
|
|
1677
|
|
|
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
|
|
|
1682 (Prj_Path,
|
|
|
1683 Target_Name => Sdefault.Target_Name.all,
|
|
|
1684 Runtime_Name => Name);
|
|
|
1685 return;
|
|
|
1686 end if;
|
|
|
1687
|
|
|
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");
|
|
|
1692 end if;
|
|
|
1693
|
|
|
1694 -- Try to find the RTS on the project path. First setup the project path
|
|
|
1695
|
|
|
1696 Prj_Env.Initialize_Default_Project_Path
|
|
|
1697 (Prj_Path,
|
|
|
1698 Target_Name => Sdefault.Target_Name.all,
|
|
|
1699 Runtime_Name => Name);
|
|
|
1700
|
|
|
1701 Rts_Full_Path := Prj_Env.Get_Runtime_Path (Prj_Path, Name);
|
|
|
1702
|
|
|
1703 if Rts_Full_Path /= null then
|
|
|
1704
|
|
|
1705 -- Directory name was found on the project path. Look for the
|
|
|
1706 -- include subdirectory(s).
|
|
|
1707
|
|
|
1708 Src_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Include);
|
|
|
1709
|
|
|
1710 if Src_Path /= null then
|
|
|
1711 Add_Search_Dirs (Src_Path, Include);
|
|
|
1712
|
|
|
1713 -- Add the lib subdirectory if it exists
|
|
|
1714
|
|
|
1715 Lib_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Objects);
|
|
|
1716
|
|
|
1717 if Lib_Path /= null then
|
|
|
1718 Add_Search_Dirs (Lib_Path, Objects);
|
|
|
1719 end if;
|
|
|
1720
|
|
|
1721 return;
|
|
|
1722 end if;
|
|
|
1723 end if;
|
|
|
1724
|
|
|
1725 Osint.Fail
|
|
|
1726 ("RTS path not valid: missing adainclude and adalib directories");
|
|
|
1727 end Search_RTS;
|
|
|
1728
|
|
|
1729 -------------------
|
|
|
1730 -- Scan_Ls_Arg --
|
|
|
1731 -------------------
|
|
|
1732
|
|
|
1733 procedure Scan_Ls_Arg (Argv : String) is
|
|
|
1734 FD : File_Descriptor;
|
|
|
1735 Len : Integer;
|
|
|
1736 OK : Boolean;
|
|
|
1737
|
|
|
1738 begin
|
|
|
1739 pragma Assert (Argv'First = 1);
|
|
|
1740
|
|
|
1741 if Argv'Length = 0 then
|
|
|
1742 return;
|
|
|
1743 end if;
|
|
|
1744
|
|
|
1745 OK := True;
|
|
|
1746 if Argv (1) = '-' then
|
|
|
1747 if Argv'Length = 1 then
|
|
|
1748 Fail ("switch character cannot be followed by a blank");
|
|
|
1749
|
|
|
1750 -- Processing for -I-
|
|
|
1751
|
|
|
1752 elsif Argv (2 .. Argv'Last) = "I-" then
|
|
|
1753 Opt.Look_In_Primary_Dir := False;
|
|
|
1754
|
|
|
1755 -- Forbid -?- or -??- where ? is any character
|
|
|
1756
|
|
|
1757 elsif (Argv'Length = 3 and then Argv (3) = '-')
|
|
|
1758 or else (Argv'Length = 4 and then Argv (4) = '-')
|
|
|
1759 then
|
|
|
1760 Fail ("Trailing ""-"" at the end of " & Argv & " forbidden.");
|
|
|
1761
|
|
|
1762 -- Processing for -Idir
|
|
|
1763
|
|
|
1764 elsif Argv (2) = 'I' then
|
|
|
1765 Add_Source_Dir (Argv (3 .. Argv'Last));
|
|
|
1766 Add_Lib_Dir (Argv (3 .. Argv'Last));
|
|
|
1767
|
|
|
1768 -- Processing for -aIdir (to gcc this is like a -I switch)
|
|
|
1769
|
|
|
1770 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
|
|
|
1771 Add_Source_Dir (Argv (4 .. Argv'Last));
|
|
|
1772
|
|
|
1773 -- Processing for -aOdir
|
|
|
1774
|
|
|
1775 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
|
|
|
1776 Add_Lib_Dir (Argv (4 .. Argv'Last));
|
|
|
1777
|
|
|
1778 -- Processing for -aLdir (to gnatbind this is like a -aO switch)
|
|
|
1779
|
|
|
1780 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
|
|
|
1781 Add_Lib_Dir (Argv (4 .. Argv'Last));
|
|
|
1782
|
|
|
1783 -- Processing for -aP<dir>
|
|
|
1784
|
|
|
1785 elsif Argv'Length > 3 and then Argv (1 .. 3) = "-aP" then
|
|
|
1786 Prj_Env.Add_Directories (Prj_Path, Argv (4 .. Argv'Last));
|
|
|
1787
|
|
|
1788 -- Processing for -nostdinc
|
|
|
1789
|
|
|
1790 elsif Argv (2 .. Argv'Last) = "nostdinc" then
|
|
|
1791 Opt.No_Stdinc := True;
|
|
|
1792
|
|
|
1793 -- Processing for one character switches
|
|
|
1794
|
|
|
1795 elsif Argv'Length = 2 then
|
|
|
1796 case Argv (2) is
|
|
|
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;
|
|
|
1806
|
|
|
1807 when others => OK := False;
|
|
|
1808 end case;
|
|
|
1809
|
|
|
1810 -- Processing for -files=file
|
|
|
1811
|
|
|
1812 elsif Argv'Length > 7 and then Argv (1 .. 7) = "-files=" then
|
|
|
1813 FD := Open_Read (Argv (8 .. Argv'Last), GNAT.OS_Lib.Text);
|
|
|
1814
|
|
|
1815 if FD = Invalid_FD then
|
|
|
1816 Osint.Fail ("could not find text file """ &
|
|
|
1817 Argv (8 .. Argv'Last) & '"');
|
|
|
1818 end if;
|
|
|
1819
|
|
|
1820 Len := Integer (File_Length (FD));
|
|
|
1821
|
|
|
1822 declare
|
|
|
1823 Buffer : String (1 .. Len + 1);
|
|
|
1824 Index : Positive := 1;
|
|
|
1825 Last : Positive;
|
|
|
1826
|
|
|
1827 begin
|
|
|
1828 -- Read the file
|
|
|
1829
|
|
|
1830 Len := Read (FD, Buffer (1)'Address, Len);
|
|
|
1831 Buffer (Buffer'Last) := ASCII.NUL;
|
|
|
1832 Close (FD);
|
|
|
1833
|
|
|
1834 -- Scan the file line by line
|
|
|
1835
|
|
|
1836 while Index < Buffer'Last loop
|
|
|
1837
|
|
|
1838 -- Find the end of line
|
|
|
1839
|
|
|
1840 Last := Index;
|
|
|
1841 while Last <= Buffer'Last
|
|
|
1842 and then Buffer (Last) /= ASCII.LF
|
|
|
1843 and then Buffer (Last) /= ASCII.CR
|
|
|
1844 loop
|
|
|
1845 Last := Last + 1;
|
|
|
1846 end loop;
|
|
|
1847
|
|
|
1848 -- Ignore empty lines
|
|
|
1849
|
|
|
1850 if Last > Index then
|
|
|
1851 Add_File (Buffer (Index .. Last - 1));
|
|
|
1852 end if;
|
|
|
1853
|
|
|
1854 -- Find the beginning of the next line
|
|
|
1855
|
|
|
1856 Index := Last;
|
|
|
1857 while Buffer (Index) = ASCII.CR or else
|
|
|
1858 Buffer (Index) = ASCII.LF
|
|
|
1859 loop
|
|
|
1860 Index := Index + 1;
|
|
|
1861 end loop;
|
|
|
1862 end loop;
|
|
|
1863 end;
|
|
|
1864
|
|
|
1865 -- Processing for --RTS=path
|
|
|
1866
|
|
|
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");
|
|
|
1870
|
|
|
1871 else
|
|
|
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.
|
|
|
1874
|
|
|
1875 if RTS_Specified = null then
|
|
|
1876 RTS_Specified := new String'(Argv (7 .. Argv'Last));
|
|
|
1877
|
|
|
1878 elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
|
|
|
1879 Osint.Fail ("--RTS cannot be specified multiple times");
|
|
|
1880 end if;
|
|
|
1881
|
|
|
1882 -- Valid --RTS switch
|
|
|
1883
|
|
|
1884 Opt.No_Stdinc := True;
|
|
|
1885 Opt.RTS_Switch := True;
|
|
|
1886 end if;
|
|
|
1887
|
|
|
1888 else
|
|
|
1889 OK := False;
|
|
|
1890 end if;
|
|
|
1891
|
|
|
1892 -- If not a switch, it must be a file name
|
|
|
1893
|
|
|
1894 else
|
|
|
1895 Add_File (Argv);
|
|
|
1896 end if;
|
|
|
1897
|
|
|
1898 if not OK then
|
|
|
1899 Write_Str ("warning: unknown switch """);
|
|
|
1900 Write_Str (Argv);
|
|
|
1901 Write_Line ("""");
|
|
|
1902 end if;
|
|
|
1903
|
|
|
1904 end Scan_Ls_Arg;
|
|
|
1905
|
|
|
1906 -----------
|
|
|
1907 -- Usage --
|
|
|
1908 -----------
|
|
|
1909
|
|
|
1910 procedure Usage is
|
|
|
1911 begin
|
|
|
1912 -- Usage line
|
|
|
1913
|
|
|
1914 Write_Str ("Usage: ");
|
|
|
1915 Osint.Write_Program_Name;
|
|
|
1916 Write_Str (" switches [list of object files]");
|
|
|
1917 Write_Eol;
|
|
|
1918 Write_Eol;
|
|
|
1919
|
|
|
1920 -- GNATLS switches
|
|
|
1921
|
|
|
1922 Write_Str ("switches:");
|
|
|
1923 Write_Eol;
|
|
|
1924
|
|
|
1925 Display_Usage_Version_And_Help;
|
|
|
1926
|
|
|
1927 -- Line for -a
|
|
|
1928
|
|
|
1929 Write_Str (" -a also output relevant predefined units");
|
|
|
1930 Write_Eol;
|
|
|
1931
|
|
|
1932 -- Line for -u
|
|
|
1933
|
|
|
1934 Write_Str (" -u output only relevant unit names");
|
|
|
1935 Write_Eol;
|
|
|
1936
|
|
|
1937 -- Line for -h
|
|
|
1938
|
|
|
1939 Write_Str (" -h output this help message");
|
|
|
1940 Write_Eol;
|
|
|
1941
|
|
|
1942 -- Line for -s
|
|
|
1943
|
|
|
1944 Write_Str (" -s output only relevant source names");
|
|
|
1945 Write_Eol;
|
|
|
1946
|
|
|
1947 -- Line for -o
|
|
|
1948
|
|
|
1949 Write_Str (" -o output only relevant object names");
|
|
|
1950 Write_Eol;
|
|
|
1951
|
|
|
1952 -- Line for -d
|
|
|
1953
|
|
|
1954 Write_Str (" -d output sources on which specified units " &
|
|
|
1955 "depend");
|
|
|
1956 Write_Eol;
|
|
|
1957
|
|
|
1958 -- Line for -l
|
|
|
1959
|
|
|
1960 Write_Str (" -l output license information");
|
|
|
1961 Write_Eol;
|
|
|
1962
|
|
|
1963 -- Line for -v
|
|
|
1964
|
|
|
1965 Write_Str (" -v verbose output, full path and unit " &
|
|
|
1966 "information");
|
|
|
1967 Write_Eol;
|
|
|
1968 Write_Eol;
|
|
|
1969
|
|
|
1970 -- Line for -files=
|
|
|
1971
|
|
|
1972 Write_Str (" -files=fil files are listed in text file 'fil'");
|
|
|
1973 Write_Eol;
|
|
|
1974
|
|
|
1975 -- Line for -aI switch
|
|
|
1976
|
|
|
1977 Write_Str (" -aIdir specify source files search path");
|
|
|
1978 Write_Eol;
|
|
|
1979
|
|
|
1980 -- Line for -aO switch
|
|
|
1981
|
|
|
1982 Write_Str (" -aOdir specify object files search path");
|
|
|
1983 Write_Eol;
|
|
|
1984
|
|
|
1985 -- Line for -aP switch
|
|
|
1986
|
|
|
1987 Write_Str (" -aPdir specify project search path");
|
|
|
1988 Write_Eol;
|
|
|
1989
|
|
|
1990 -- Line for -I switch
|
|
|
1991
|
|
|
1992 Write_Str (" -Idir like -aIdir -aOdir");
|
|
|
1993 Write_Eol;
|
|
|
1994
|
|
|
1995 -- Line for -I- switch
|
|
|
1996
|
|
|
1997 Write_Str (" -I- do not look for sources & object files");
|
|
|
1998 Write_Str (" in the default directory");
|
|
|
1999 Write_Eol;
|
|
|
2000
|
|
|
2001 -- Line for -nostdinc
|
|
|
2002
|
|
|
2003 Write_Str (" -nostdinc do not look for source files");
|
|
|
2004 Write_Str (" in the system default directory");
|
|
|
2005 Write_Eol;
|
|
|
2006
|
|
|
2007 -- Line for --RTS
|
|
|
2008
|
|
|
2009 Write_Str (" --RTS=dir specify the default source and object search"
|
|
|
2010 & " path");
|
|
|
2011 Write_Eol;
|
|
|
2012
|
|
|
2013 -- File Status explanation
|
|
|
2014
|
|
|
2015 Write_Eol;
|
|
|
2016 Write_Str (" file status can be:");
|
|
|
2017 Write_Eol;
|
|
|
2018
|
|
|
2019 for ST in File_Status loop
|
|
|
2020 Write_Str (" ");
|
|
|
2021 Output_Status (ST, Verbose => False);
|
|
|
2022 Write_Str (" ==> ");
|
|
|
2023 Output_Status (ST, Verbose => True);
|
|
|
2024 Write_Eol;
|
|
|
2025 end loop;
|
|
|
2026 end Usage;
|
|
|
2027
|
|
|
2028 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
|
|
|
2029
|
|
|
2030 -- Start of processing for Gnatls
|
|
|
2031
|
|
|
2032 begin
|
|
|
2033 -- Initialize standard packages
|
|
|
2034
|
|
|
2035 Csets.Initialize;
|
|
|
2036 Snames.Initialize;
|
|
|
2037 Stringt.Initialize;
|
|
|
2038
|
|
|
2039 -- First check for --version or --help
|
|
|
2040
|
|
|
2041 Check_Version_And_Help ("GNATLS", "1992");
|
|
|
2042
|
|
|
2043 -- Loop to scan out arguments
|
|
|
2044
|
|
|
2045 Next_Arg := 1;
|
|
|
2046 Scan_Args : while Next_Arg < Arg_Count loop
|
|
|
2047 declare
|
|
|
2048 Next_Argv : String (1 .. Len_Arg (Next_Arg));
|
|
|
2049 begin
|
|
|
2050 Fill_Arg (Next_Argv'Address, Next_Arg);
|
|
|
2051 Scan_Ls_Arg (Next_Argv);
|
|
|
2052 end;
|
|
|
2053
|
|
|
2054 Next_Arg := Next_Arg + 1;
|
|
|
2055 end loop Scan_Args;
|
|
|
2056
|
|
|
2057 -- If -l (output license information) is given, it must be the only switch
|
|
|
2058
|
|
|
2059 if License then
|
|
|
2060 if Arg_Count = 2 then
|
|
|
2061 Output_License_Information;
|
|
|
2062 Exit_Program (E_Success);
|
|
|
2063
|
|
|
2064 else
|
|
|
2065 Set_Standard_Error;
|
|
|
2066 Write_Str ("Can't use -l with another switch");
|
|
|
2067 Write_Eol;
|
|
|
2068 Try_Help;
|
|
|
2069 Exit_Program (E_Fatal);
|
|
|
2070 end if;
|
|
|
2071 end if;
|
|
|
2072
|
|
|
2073 -- Handle --RTS switch
|
|
|
2074
|
|
|
2075 if RTS_Specified /= null then
|
|
|
2076 Search_RTS (RTS_Specified.all);
|
|
|
2077 end if;
|
|
|
2078
|
|
|
2079 -- Add the source and object directories specified on the command line, if
|
|
|
2080 -- any, to the searched directories.
|
|
|
2081
|
|
|
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;
|
|
|
2085 end loop;
|
|
|
2086
|
|
|
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;
|
|
|
2090 end loop;
|
|
|
2091
|
|
|
2092 -- Finally, add the default directories
|
|
|
2093
|
|
|
2094 Osint.Add_Default_Search_Dirs;
|
|
|
2095
|
|
|
2096 -- If --RTS= is not specified, check if there is a default runtime
|
|
|
2097
|
|
|
2098 if RTS_Specified = null then
|
|
|
2099 declare
|
|
|
2100 FD : File_Descriptor;
|
|
|
2101 Text : Source_Buffer_Ptr;
|
|
|
2102 Hi : Source_Ptr;
|
|
|
2103
|
|
|
2104 begin
|
|
|
2105 Name_Buffer (1 .. 10) := "system.ads";
|
|
|
2106 Name_Len := 10;
|
|
|
2107
|
|
|
2108 Read_Source_File (Name_Find, 0, Hi, Text, FD);
|
|
|
2109
|
|
|
2110 if Null_Source_Buffer_Ptr (Text) then
|
|
|
2111 No_Runtime := True;
|
|
|
2112 end if;
|
|
|
2113 end;
|
|
|
2114 end if;
|
|
|
2115
|
|
|
2116 if Verbose_Mode then
|
|
|
2117 Write_Eol;
|
|
|
2118 Display_Version ("GNATLS", "1997");
|
|
|
2119 Write_Eol;
|
|
|
2120
|
|
|
2121 if No_Runtime then
|
|
|
2122 Write_Str
|
|
|
2123 ("Default runtime not available. Use --RTS= with a valid runtime");
|
|
|
2124 Write_Eol;
|
|
|
2125 Write_Eol;
|
|
|
2126 Exit_Status := E_Warnings;
|
|
|
2127 end if;
|
|
|
2128
|
|
|
2129 Write_Str ("Source Search Path:");
|
|
|
2130 Write_Eol;
|
|
|
2131
|
|
|
2132 for J in 1 .. Nb_Dir_In_Src_Search_Path loop
|
|
|
2133 Write_Str (" ");
|
|
|
2134
|
|
|
2135 if Dir_In_Src_Search_Path (J)'Length = 0 then
|
|
|
2136 Write_Str ("<Current_Directory>");
|
|
|
2137 Write_Eol;
|
|
|
2138
|
|
|
2139 elsif not No_Runtime then
|
|
|
2140 Write_Str
|
|
|
2141 (Normalize
|
|
|
2142 (To_Host_Dir_Spec
|
|
|
2143 (Dir_In_Src_Search_Path (J).all, True).all));
|
|
|
2144 Write_Eol;
|
|
|
2145 end if;
|
|
|
2146 end loop;
|
|
|
2147
|
|
|
2148 Write_Eol;
|
|
|
2149 Write_Eol;
|
|
|
2150 Write_Str ("Object Search Path:");
|
|
|
2151 Write_Eol;
|
|
|
2152
|
|
|
2153 for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
|
|
|
2154 Write_Str (" ");
|
|
|
2155
|
|
|
2156 if Dir_In_Obj_Search_Path (J)'Length = 0 then
|
|
|
2157 Write_Str ("<Current_Directory>");
|
|
|
2158 Write_Eol;
|
|
|
2159
|
|
|
2160 elsif not No_Runtime then
|
|
|
2161 Write_Str
|
|
|
2162 (Normalize
|
|
|
2163 (To_Host_Dir_Spec
|
|
|
2164 (Dir_In_Obj_Search_Path (J).all, True).all));
|
|
|
2165 Write_Eol;
|
|
|
2166 end if;
|
|
|
2167 end loop;
|
|
|
2168
|
|
|
2169 Write_Eol;
|
|
|
2170 Write_Eol;
|
|
|
2171 Write_Str (Project_Search_Path);
|
|
|
2172 Write_Eol;
|
|
|
2173 Write_Str (" <Current_Directory>");
|
|
|
2174 Write_Eol;
|
|
|
2175
|
|
|
2176 Prj_Env.Initialize_Default_Project_Path
|
|
|
2177 (Prj_Path, Target_Name => Sdefault.Target_Name.all);
|
|
|
2178
|
|
|
2179 declare
|
|
|
2180 First : Natural;
|
|
|
2181 Last : Natural;
|
|
|
2182
|
|
|
2183 begin
|
|
|
2184
|
|
|
2185 if Prj_Path.all /= "" then
|
|
|
2186 First := Prj_Path'First;
|
|
|
2187 loop
|
|
|
2188 while First <= Prj_Path'Last
|
|
|
2189 and then (Prj_Path (First) = Path_Separator)
|
|
|
2190 loop
|
|
|
2191 First := First + 1;
|
|
|
2192 end loop;
|
|
|
2193
|
|
|
2194 exit when First > Prj_Path'Last;
|
|
|
2195
|
|
|
2196 Last := First;
|
|
|
2197 while Last < Prj_Path'Last
|
|
|
2198 and then Prj_Path (Last + 1) /= Path_Separator
|
|
|
2199 loop
|
|
|
2200 Last := Last + 1;
|
|
|
2201 end loop;
|
|
|
2202
|
|
|
2203 if First /= Last or else Prj_Path (First) /= '.' then
|
|
|
2204
|
|
|
2205 -- If the directory is ".", skip it as it is the current
|
|
|
2206 -- directory and it is already the first directory in the
|
|
|
2207 -- project path.
|
|
|
2208
|
|
|
2209 Write_Str (" ");
|
|
|
2210 Write_Str
|
|
|
2211 (Normalize
|
|
|
2212 (To_Host_Dir_Spec
|
|
|
2213 (Prj_Path (First .. Last), True).all));
|
|
|
2214 Write_Eol;
|
|
|
2215 end if;
|
|
|
2216
|
|
|
2217 First := Last + 1;
|
|
|
2218 end loop;
|
|
|
2219 end if;
|
|
|
2220 end;
|
|
|
2221
|
|
|
2222 Write_Eol;
|
|
|
2223 end if;
|
|
|
2224
|
|
|
2225 -- Output usage information when requested
|
|
|
2226
|
|
|
2227 if Print_Usage then
|
|
|
2228 Usage;
|
|
|
2229 end if;
|
|
|
2230
|
|
|
2231 if not More_Lib_Files then
|
|
|
2232 if not Print_Usage and then not Verbose_Mode then
|
|
|
2233 if Arg_Count = 1 then
|
|
|
2234 Usage;
|
|
|
2235 else
|
|
|
2236 Try_Help;
|
|
|
2237 Exit_Status := E_Fatal;
|
|
|
2238 end if;
|
|
|
2239 end if;
|
|
|
2240
|
|
|
2241 Exit_Program (Exit_Status);
|
|
|
2242 end if;
|
|
|
2243
|
|
|
2244 Initialize_ALI;
|
|
|
2245 Initialize_ALI_Source;
|
|
|
2246
|
|
|
2247 -- Print out all libraries for which no ALI files can be located
|
|
|
2248
|
|
|
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));
|
|
|
2252
|
|
|
2253 if Ali_File = No_File then
|
|
|
2254 if Very_Verbose_Mode then
|
|
|
2255 GNATDIST.Output_No_ALI (Lib_File_Name (Main_File));
|
|
|
2256
|
|
|
2257 else
|
|
|
2258 Set_Standard_Error;
|
|
|
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 ('"'); -- "
|
|
|
2264 Write_Eol;
|
|
|
2265 Exit_Status := E_Fatal;
|
|
|
2266 end if;
|
|
|
2267
|
|
|
2268 else
|
|
|
2269 Ali_File := Strip_Directory (Ali_File);
|
|
|
2270
|
|
|
2271 if Get_Name_Table_Int (Ali_File) = 0 then
|
|
|
2272 Text := Read_Library_Info (Ali_File, True);
|
|
|
2273
|
|
|
2274 declare
|
|
|
2275 Discard : ALI_Id;
|
|
|
2276 begin
|
|
|
2277 Discard :=
|
|
|
2278 Scan_ALI
|
|
|
2279 (Ali_File,
|
|
|
2280 Text,
|
|
|
2281 Ignore_ED => False,
|
|
|
2282 Err => False,
|
|
|
2283 Ignore_Errors => True);
|
|
|
2284 end;
|
|
|
2285
|
|
|
2286 Free (Text);
|
|
|
2287 end if;
|
|
|
2288 end if;
|
|
|
2289 end loop;
|
|
|
2290
|
|
|
2291 -- Reset default output file descriptor, if needed
|
|
|
2292
|
|
|
2293 Set_Standard_Output;
|
|
|
2294
|
|
|
2295 if Very_Verbose_Mode then
|
|
|
2296 for A in ALIs.First .. ALIs.Last loop
|
|
|
2297 GNATDIST.Output_ALI (A);
|
|
|
2298 end loop;
|
|
|
2299
|
|
|
2300 return;
|
|
|
2301 end if;
|
|
|
2302
|
|
|
2303 Find_General_Layout;
|
|
|
2304
|
|
|
2305 for Id in ALIs.First .. ALIs.Last loop
|
|
|
2306 declare
|
|
|
2307 Last_U : Unit_Id;
|
|
|
2308
|
|
|
2309 begin
|
|
|
2310 Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
|
|
|
2311
|
|
|
2312 if Also_Predef or else not Is_Internal_Unit then
|
|
|
2313 if ALIs.Table (Id).No_Object then
|
|
|
2314 Output_Object (No_File);
|
|
|
2315 else
|
|
|
2316 Output_Object (ALIs.Table (Id).Ofile_Full_Name);
|
|
|
2317 end if;
|
|
|
2318
|
|
|
2319 -- In verbose mode print all main units in the ALI file, otherwise
|
|
|
2320 -- just print the first one to ease columnwise printout
|
|
|
2321
|
|
|
2322 if Verbose_Mode then
|
|
|
2323 Last_U := ALIs.Table (Id).Last_Unit;
|
|
|
2324 else
|
|
|
2325 Last_U := ALIs.Table (Id).First_Unit;
|
|
|
2326 end if;
|
|
|
2327
|
|
|
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
|
|
|
2331 and then Print_Unit
|
|
|
2332 then
|
|
|
2333 Write_Eol;
|
|
|
2334 end if;
|
|
|
2335
|
|
|
2336 Output_Unit (Id, U);
|
|
|
2337
|
|
|
2338 -- Output source now, unless if it will be done as part of
|
|
|
2339 -- outputing dependencies.
|
|
|
2340
|
|
|
2341 if not (Dependable and then Print_Source) then
|
|
|
2342 Output_Source (Corresponding_Sdep_Entry (Id, U));
|
|
|
2343 end if;
|
|
|
2344 end loop;
|
|
|
2345
|
|
|
2346 -- Print out list of units on which this unit depends (D lines)
|
|
|
2347
|
|
|
2348 if Dependable and then Print_Source then
|
|
|
2349 if Verbose_Mode then
|
|
|
2350 Write_Str ("depends upon");
|
|
|
2351 Write_Eol;
|
|
|
2352 Write_Str (" ");
|
|
|
2353 else
|
|
|
2354 Write_Eol;
|
|
|
2355 end if;
|
|
|
2356
|
|
|
2357 for D in
|
|
|
2358 ALIs.Table (Id).First_Sdep .. ALIs.Table (Id).Last_Sdep
|
|
|
2359 loop
|
|
|
2360 if Also_Predef
|
|
|
2361 or else not Is_Internal_File_Name (Sdep.Table (D).Sfile)
|
|
|
2362 then
|
|
|
2363 if Verbose_Mode then
|
|
|
2364 Write_Str (" ");
|
|
|
2365 Output_Source (D);
|
|
|
2366
|
|
|
2367 elsif Too_Long then
|
|
|
2368 Write_Str (" ");
|
|
|
2369 Output_Source (D);
|
|
|
2370 Write_Eol;
|
|
|
2371
|
|
|
2372 else
|
|
|
2373 Write_Str (Spaces (1 .. Source_Start - 2));
|
|
|
2374 Output_Source (D);
|
|
|
2375 Write_Eol;
|
|
|
2376 end if;
|
|
|
2377 end if;
|
|
|
2378 end loop;
|
|
|
2379 end if;
|
|
|
2380
|
|
|
2381 Write_Eol;
|
|
|
2382 end if;
|
|
|
2383 end;
|
|
|
2384 end loop;
|
|
|
2385
|
|
|
2386 -- All done. Set proper exit status
|
|
|
2387
|
|
|
2388 Namet.Finalize;
|
|
|
2389 Exit_Program (Exit_Status);
|
|
|
2390 end Gnatls;
|
