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