projects / gcc.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
[multiple changes]
[gcc.git] / gcc / ada / gnatls.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G N A T L S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
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 with ALI; use ALI;
27 with ALI.Util; use ALI.Util;
28 with Binderr; use Binderr;
29 with Butil; use Butil;
30 with Csets; use Csets;
31 with Fname; use Fname;
32 with Gnatvsn; use Gnatvsn;
33 with GNAT.OS_Lib; use GNAT.OS_Lib;
34 with Namet; use Namet;
35 with Opt; use Opt;
36 with Osint; use Osint;
37 with Osint.L; use Osint.L;
38 with Output; use Output;
39 with Prj.Env; use Prj.Env;
40 with Rident; use Rident;
41 with Sdefault;
42 with Snames;
43 with Stringt;
44 with Switch; use Switch;
45 with Targparm; use Targparm;
46 with Types; use Types;
47
48 with Ada.Command_Line; use Ada.Command_Line;
49
50 with GNAT.Command_Line; use GNAT.Command_Line;
51 with GNAT.Case_Util; use GNAT.Case_Util;
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 : Prj.Env.Project_Search_Path;
64
65 Max_Column : constant := 80;
66
67 No_Obj : aliased String := "<no_obj>";
68
69 type File_Status is (
70 OK, -- matching timestamp
71 Checksum_OK, -- only matching checksum
72 Not_Found, -- file not found on source PATH
73 Not_Same, -- neither checksum nor timestamp matching
74 Not_First_On_PATH); -- matching file hidden by Not_Same file on path
75
76 type Dir_Data;
77 type Dir_Ref is access Dir_Data;
78
79 type Dir_Data is record
80 Value : String_Access;
81 Next : Dir_Ref;
82 end record;
83 -- Simply linked list of dirs
84
85 First_Source_Dir : Dir_Ref;
86 Last_Source_Dir : Dir_Ref;
87 -- The list of source directories from the command line.
88 -- These directories are added using Osint.Add_Src_Search_Dir
89 -- after those of the GNAT Project File, if any.
90
91 First_Lib_Dir : Dir_Ref;
92 Last_Lib_Dir : Dir_Ref;
93 -- The list of object directories from the command line.
94 -- These directories are added using Osint.Add_Lib_Search_Dir
95 -- after those of the GNAT Project File, if any.
96
97 Main_File : File_Name_Type;
98 Ali_File : File_Name_Type;
99 Text : Text_Buffer_Ptr;
100 Next_Arg : Positive;
101
102 Too_Long : Boolean := False;
103 -- When True, lines are too long for multi-column output and each
104 -- item of information is on a different line.
105
106 Selective_Output : Boolean := False;
107 Print_Usage : Boolean := False;
108 Print_Unit : Boolean := True;
109 Print_Source : Boolean := True;
110 Print_Object : Boolean := True;
111 -- Flags controlling the form of the output
112
113 Also_Predef : Boolean := False; -- -a
114 Dependable : Boolean := False; -- -d
115 License : Boolean := False; -- -l
116 Very_Verbose_Mode : Boolean := False; -- -V
117 -- Command line flags
118
119 Unit_Start : Integer;
120 Unit_End : Integer;
121 Source_Start : Integer;
122 Source_End : Integer;
123 Object_Start : Integer;
124 Object_End : Integer;
125 -- Various column starts and ends
126
127 Spaces : constant String (1 .. Max_Column) := (others => ' ');
128
129 RTS_Specified : String_Access := null;
130 -- Used to detect multiple use of --RTS= switch
131
132 -----------------------
133 -- Local Subprograms --
134 -----------------------
135
136 procedure Add_Lib_Dir (Dir : String);
137 -- Add an object directory in the list First_Lib_Dir-Last_Lib_Dir
138
139 procedure Add_Source_Dir (Dir : String);
140 -- Add a source directory in the list First_Source_Dir-Last_Source_Dir
141
142 procedure Find_General_Layout;
143 -- Determine the structure of the output (multi columns or not, etc)
144
145 procedure Find_Status
146 (FS : in out File_Name_Type;
147 Stamp : Time_Stamp_Type;
148 Checksum : Word;
149 Status : out File_Status);
150 -- Determine the file status (Status) of the file represented by FS
151 -- with the expected Stamp and checksum given as argument. FS will be
152 -- updated to the full file name if available.
153
154 function Corresponding_Sdep_Entry (A : ALI_Id; U : Unit_Id) return Sdep_Id;
155 -- Give the Sdep entry corresponding to the unit U in ali record A
156
157 procedure Output_Object (O : File_Name_Type);
158 -- Print out the name of the object when requested
159
160 procedure Output_Source (Sdep_I : Sdep_Id);
161 -- Print out the name and status of the source corresponding to this
162 -- sdep entry.
163
164 procedure Output_Status (FS : File_Status; Verbose : Boolean);
165 -- Print out FS either in a coded form if verbose is false or in an
166 -- expanded form otherwise.
167
168 procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id);
169 -- Print out information on the unit when requested
170
171 procedure Reset_Print;
172 -- Reset Print flags properly when selective output is chosen
173
174 procedure Scan_Ls_Arg (Argv : String);
175 -- Scan and process lser specific arguments. Argv is a single argument
176
177 procedure Search_RTS (Name : String);
178 -- Find include and objects path for the RTS name.
179
180 procedure Usage;
181 -- Print usage message
182
183 procedure Output_License_Information;
184 -- Output license statement, and if not found, output reference to
185 -- COPYING.
186
187 function Image (Restriction : Restriction_Id) return String;
188 -- Returns the capitalized image of Restriction
189
190 function Normalize (Path : String) return String;
191 -- Returns a normalized path name, except on VMS where the argument Path
192 -- is returned, to keep the host pathname syntax. On Windows, the directory
193 -- separators are set to '\' in Normalize_Pathname.
194
195 ------------------------------------------
196 -- GNATDIST specific output subprograms --
197 ------------------------------------------
198
199 package GNATDIST is
200
201 -- Any modification to this subunit requires synchronization with the
202 -- GNATDIST sources.
203
204 procedure Output_ALI (A : ALI_Id);
205 -- Comment required saying what this routine does ???
206
207 procedure Output_No_ALI (Afile : File_Name_Type);
208 -- Comments required saying what this routine does ???
209
210 end GNATDIST;
211
212 -----------------
213 -- Add_Lib_Dir --
214 -----------------
215
216 procedure Add_Lib_Dir (Dir : String) is
217 begin
218 if First_Lib_Dir = null then
219 First_Lib_Dir :=
220 new Dir_Data'
221 (Value => new String'(Dir),
222 Next => null);
223 Last_Lib_Dir := First_Lib_Dir;
224
225 else
226 Last_Lib_Dir.Next :=
227 new Dir_Data'
228 (Value => new String'(Dir),
229 Next => null);
230 Last_Lib_Dir := Last_Lib_Dir.Next;
231 end if;
232 end Add_Lib_Dir;
233
234 --------------------
235 -- Add_Source_Dir --
236 --------------------
237
238 procedure Add_Source_Dir (Dir : String) is
239 begin
240 if First_Source_Dir = null then
241 First_Source_Dir :=
242 new Dir_Data'
243 (Value => new String'(Dir),
244 Next => null);
245 Last_Source_Dir := First_Source_Dir;
246
247 else
248 Last_Source_Dir.Next :=
249 new Dir_Data'
250 (Value => new String'(Dir),
251 Next => null);
252 Last_Source_Dir := Last_Source_Dir.Next;
253 end if;
254 end Add_Source_Dir;
255
256 ------------------------------
257 -- Corresponding_Sdep_Entry --
258 ------------------------------
259
260 function Corresponding_Sdep_Entry
261 (A : ALI_Id;
262 U : Unit_Id) return Sdep_Id
263 is
264 begin
265 for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
266 if Sdep.Table (D).Sfile = Units.Table (U).Sfile then
267 return D;
268 end if;
269 end loop;
270
271 Error_Msg_Unit_1 := Units.Table (U).Uname;
272 Error_Msg_File_1 := ALIs.Table (A).Afile;
273 Write_Eol;
274 Error_Msg ("wrong ALI format, can't find dependency line for $ in {");
275 Exit_Program (E_Fatal);
276 return No_Sdep_Id;
277 end Corresponding_Sdep_Entry;
278
279 -------------------------
280 -- Find_General_Layout --
281 -------------------------
282
283 procedure Find_General_Layout is
284 Max_Unit_Length : Integer := 11;
285 Max_Src_Length : Integer := 11;
286 Max_Obj_Length : Integer := 11;
287
288 Len : Integer;
289 FS : File_Name_Type;
290
291 begin
292 -- Compute maximum of each column
293
294 for Id in ALIs.First .. ALIs.Last loop
295 Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
296 if Also_Predef or else not Is_Internal_Unit then
297
298 if Print_Unit then
299 Len := Name_Len - 1;
300 Max_Unit_Length := Integer'Max (Max_Unit_Length, Len);
301 end if;
302
303 if Print_Source then
304 FS := Full_Source_Name (ALIs.Table (Id).Sfile);
305
306 if FS = No_File then
307 Get_Name_String (ALIs.Table (Id).Sfile);
308 Name_Len := Name_Len + 13;
309 else
310 Get_Name_String (FS);
311 end if;
312
313 Max_Src_Length := Integer'Max (Max_Src_Length, Name_Len + 1);
314 end if;
315
316 if Print_Object then
317 if ALIs.Table (Id).No_Object then
318 Max_Obj_Length :=
319 Integer'Max (Max_Obj_Length, No_Obj'Length);
320 else
321 Get_Name_String (ALIs.Table (Id).Ofile_Full_Name);
322 Max_Obj_Length := Integer'Max (Max_Obj_Length, Name_Len + 1);
323 end if;
324 end if;
325 end if;
326 end loop;
327
328 -- Verify is output is not wider than maximum number of columns
329
330 Too_Long :=
331 Verbose_Mode
332 or else
333 (Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column;
334
335 -- Set start and end of columns
336
337 Object_Start := 1;
338 Object_End := Object_Start - 1;
339
340 if Print_Object then
341 Object_End := Object_Start + Max_Obj_Length;
342 end if;
343
344 Unit_Start := Object_End + 1;
345 Unit_End := Unit_Start - 1;
346
347 if Print_Unit then
348 Unit_End := Unit_Start + Max_Unit_Length;
349 end if;
350
351 Source_Start := Unit_End + 1;
352
353 if Source_Start > Spaces'Last then
354 Source_Start := Spaces'Last;
355 end if;
356
357 Source_End := Source_Start - 1;
358
359 if Print_Source then
360 Source_End := Source_Start + Max_Src_Length;
361 end if;
362 end Find_General_Layout;
363
364 -----------------
365 -- Find_Status --
366 -----------------
367
368 procedure Find_Status
369 (FS : in out File_Name_Type;
370 Stamp : Time_Stamp_Type;
371 Checksum : Word;
372 Status : out File_Status)
373 is
374 Tmp1 : File_Name_Type;
375 Tmp2 : File_Name_Type;
376
377 begin
378 Tmp1 := Full_Source_Name (FS);
379
380 if Tmp1 = No_File then
381 Status := Not_Found;
382
383 elsif File_Stamp (Tmp1) = Stamp then
384 FS := Tmp1;
385 Status := OK;
386
387 elsif Checksums_Match (Get_File_Checksum (FS), Checksum) then
388 FS := Tmp1;
389 Status := Checksum_OK;
390
391 else
392 Tmp2 := Matching_Full_Source_Name (FS, Stamp);
393
394 if Tmp2 = No_File then
395 Status := Not_Same;
396 FS := Tmp1;
397
398 else
399 Status := Not_First_On_PATH;
400 FS := Tmp2;
401 end if;
402 end if;
403 end Find_Status;
404
405 --------------
406 -- GNATDIST --
407 --------------
408
409 package body GNATDIST is
410
411 N_Flags : Natural;
412 N_Indents : Natural := 0;
413
414 type Token_Type is
415 (T_No_ALI,
416 T_ALI,
417 T_Unit,
418 T_With,
419 T_Source,
420 T_Afile,
421 T_Ofile,
422 T_Sfile,
423 T_Name,
424 T_Main,
425 T_Kind,
426 T_Flags,
427 T_Preelaborated,
428 T_Pure,
429 T_Has_RACW,
430 T_Remote_Types,
431 T_Shared_Passive,
432 T_RCI,
433 T_Predefined,
434 T_Internal,
435 T_Is_Generic,
436 T_Procedure,
437 T_Function,
438 T_Package,
439 T_Subprogram,
440 T_Spec,
441 T_Body);
442
443 Image : constant array (Token_Type) of String_Access :=
444 (T_No_ALI => new String'("No_ALI"),
445 T_ALI => new String'("ALI"),
446 T_Unit => new String'("Unit"),
447 T_With => new String'("With"),
448 T_Source => new String'("Source"),
449 T_Afile => new String'("Afile"),
450 T_Ofile => new String'("Ofile"),
451 T_Sfile => new String'("Sfile"),
452 T_Name => new String'("Name"),
453 T_Main => new String'("Main"),
454 T_Kind => new String'("Kind"),
455 T_Flags => new String'("Flags"),
456 T_Preelaborated => new String'("Preelaborated"),
457 T_Pure => new String'("Pure"),
458 T_Has_RACW => new String'("Has_RACW"),
459 T_Remote_Types => new String'("Remote_Types"),
460 T_Shared_Passive => new String'("Shared_Passive"),
461 T_RCI => new String'("RCI"),
462 T_Predefined => new String'("Predefined"),
463 T_Internal => new String'("Internal"),
464 T_Is_Generic => new String'("Is_Generic"),
465 T_Procedure => new String'("procedure"),
466 T_Function => new String'("function"),
467 T_Package => new String'("package"),
468 T_Subprogram => new String'("subprogram"),
469 T_Spec => new String'("spec"),
470 T_Body => new String'("body"));
471
472 procedure Output_Name (N : Name_Id);
473 -- Remove any encoding info (%b and %s) and output N
474
475 procedure Output_Afile (A : File_Name_Type);
476 procedure Output_Ofile (O : File_Name_Type);
477 procedure Output_Sfile (S : File_Name_Type);
478 -- Output various names. Check that the name is different from no name.
479 -- Otherwise, skip the output.
480
481 procedure Output_Token (T : Token_Type);
482 -- Output token using specific format. That is several indentations and:
483 --
484 -- T_No_ALI .. T_With : <token> & " =>" & NL
485 -- T_Source .. T_Kind : <token> & " => "
486 -- T_Flags : <token> & " =>"
487 -- T_Preelab .. T_Body : " " & <token>
488
489 procedure Output_Sdep (S : Sdep_Id);
490 procedure Output_Unit (U : Unit_Id);
491 procedure Output_With (W : With_Id);
492 -- Output this entry as a global section (like ALIs)
493
494 ------------------
495 -- Output_Afile --
496 ------------------
497
498 procedure Output_Afile (A : File_Name_Type) is
499 begin
500 if A /= No_File then
501 Output_Token (T_Afile);
502 Write_Name (A);
503 Write_Eol;
504 end if;
505 end Output_Afile;
506
507 ----------------
508 -- Output_ALI --
509 ----------------
510
511 procedure Output_ALI (A : ALI_Id) is
512 begin
513 Output_Token (T_ALI);
514 N_Indents := N_Indents + 1;
515
516 Output_Afile (ALIs.Table (A).Afile);
517 Output_Ofile (ALIs.Table (A).Ofile_Full_Name);
518 Output_Sfile (ALIs.Table (A).Sfile);
519
520 -- Output Main
521
522 if ALIs.Table (A).Main_Program /= None then
523 Output_Token (T_Main);
524
525 if ALIs.Table (A).Main_Program = Proc then
526 Output_Token (T_Procedure);
527 else
528 Output_Token (T_Function);
529 end if;
530
531 Write_Eol;
532 end if;
533
534 -- Output Units
535
536 for U in ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit loop
537 Output_Unit (U);
538 end loop;
539
540 -- Output Sdeps
541
542 for S in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
543 Output_Sdep (S);
544 end loop;
545
546 N_Indents := N_Indents - 1;
547 end Output_ALI;
548
549 -------------------
550 -- Output_No_ALI --
551 -------------------
552
553 procedure Output_No_ALI (Afile : File_Name_Type) is
554 begin
555 Output_Token (T_No_ALI);
556 N_Indents := N_Indents + 1;
557 Output_Afile (Afile);
558 N_Indents := N_Indents - 1;
559 end Output_No_ALI;
560
561 -----------------
562 -- Output_Name --
563 -----------------
564
565 procedure Output_Name (N : Name_Id) is
566 begin
567 -- Remove any encoding info (%s or %b)
568
569 Get_Name_String (N);
570
571 if Name_Len > 2
572 and then Name_Buffer (Name_Len - 1) = '%'
573 then
574 Name_Len := Name_Len - 2;
575 end if;
576
577 Output_Token (T_Name);
578 Write_Str (Name_Buffer (1 .. Name_Len));
579 Write_Eol;
580 end Output_Name;
581
582 ------------------
583 -- Output_Ofile --
584 ------------------
585
586 procedure Output_Ofile (O : File_Name_Type) is
587 begin
588 if O /= No_File then
589 Output_Token (T_Ofile);
590 Write_Name (O);
591 Write_Eol;
592 end if;
593 end Output_Ofile;
594
595 -----------------
596 -- Output_Sdep --
597 -----------------
598
599 procedure Output_Sdep (S : Sdep_Id) is
600 begin
601 Output_Token (T_Source);
602 Write_Name (Sdep.Table (S).Sfile);
603 Write_Eol;
604 end Output_Sdep;
605
606 ------------------
607 -- Output_Sfile --
608 ------------------
609
610 procedure Output_Sfile (S : File_Name_Type) is
611 FS : File_Name_Type := S;
612
613 begin
614 if FS /= No_File then
615
616 -- We want to output the full source name
617
618 FS := Full_Source_Name (FS);
619
620 -- There is no full source name. This occurs for instance when a
621 -- withed unit has a spec file but no body file. This situation is
622 -- not a problem for GNATDIST since the unit may be located on a
623 -- partition we do not want to build. However, we need to locate
624 -- the spec file and to find its full source name. Replace the
625 -- body file name with the spec file name used to compile the
626 -- current unit when possible.
627
628 if FS = No_File then
629 Get_Name_String (S);
630
631 if Name_Len > 4
632 and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb"
633 then
634 Name_Buffer (Name_Len) := 's';
635 FS := Full_Source_Name (Name_Find);
636 end if;
637 end if;
638 end if;
639
640 if FS /= No_File then
641 Output_Token (T_Sfile);
642 Write_Name (FS);
643 Write_Eol;
644 end if;
645 end Output_Sfile;
646
647 ------------------
648 -- Output_Token --
649 ------------------
650
651 procedure Output_Token (T : Token_Type) is
652 begin
653 if T in T_No_ALI .. T_Flags then
654 for J in 1 .. N_Indents loop
655 Write_Str (" ");
656 end loop;
657
658 Write_Str (Image (T).all);
659
660 for J in Image (T)'Length .. 12 loop
661 Write_Char (' ');
662 end loop;
663
664 Write_Str ("=>");
665
666 if T in T_No_ALI .. T_With then
667 Write_Eol;
668 elsif T in T_Source .. T_Name then
669 Write_Char (' ');
670 end if;
671
672 elsif T in T_Preelaborated .. T_Body then
673 if T in T_Preelaborated .. T_Is_Generic then
674 if N_Flags = 0 then
675 Output_Token (T_Flags);
676 end if;
677
678 N_Flags := N_Flags + 1;
679 end if;
680
681 Write_Char (' ');
682 Write_Str (Image (T).all);
683
684 else
685 Write_Str (Image (T).all);
686 end if;
687 end Output_Token;
688
689 -----------------
690 -- Output_Unit --
691 -----------------
692
693 procedure Output_Unit (U : Unit_Id) is
694 begin
695 Output_Token (T_Unit);
696 N_Indents := N_Indents + 1;
697
698 -- Output Name
699
700 Output_Name (Name_Id (Units.Table (U).Uname));
701
702 -- Output Kind
703
704 Output_Token (T_Kind);
705
706 if Units.Table (U).Unit_Kind = 'p' then
707 Output_Token (T_Package);
708 else
709 Output_Token (T_Subprogram);
710 end if;
711
712 if Name_Buffer (Name_Len) = 's' then
713 Output_Token (T_Spec);
714 else
715 Output_Token (T_Body);
716 end if;
717
718 Write_Eol;
719
720 -- Output source file name
721
722 Output_Sfile (Units.Table (U).Sfile);
723
724 -- Output Flags
725
726 N_Flags := 0;
727
728 if Units.Table (U).Preelab then
729 Output_Token (T_Preelaborated);
730 end if;
731
732 if Units.Table (U).Pure then
733 Output_Token (T_Pure);
734 end if;
735
736 if Units.Table (U).Has_RACW then
737 Output_Token (T_Has_RACW);
738 end if;
739
740 if Units.Table (U).Remote_Types then
741 Output_Token (T_Remote_Types);
742 end if;
743
744 if Units.Table (U).Shared_Passive then
745 Output_Token (T_Shared_Passive);
746 end if;
747
748 if Units.Table (U).RCI then
749 Output_Token (T_RCI);
750 end if;
751
752 if Units.Table (U).Predefined then
753 Output_Token (T_Predefined);
754 end if;
755
756 if Units.Table (U).Internal then
757 Output_Token (T_Internal);
758 end if;
759
760 if Units.Table (U).Is_Generic then
761 Output_Token (T_Is_Generic);
762 end if;
763
764 if N_Flags > 0 then
765 Write_Eol;
766 end if;
767
768 -- Output Withs
769
770 for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop
771 Output_With (W);
772 end loop;
773
774 N_Indents := N_Indents - 1;
775 end Output_Unit;
776
777 -----------------
778 -- Output_With --
779 -----------------
780
781 procedure Output_With (W : With_Id) is
782 begin
783 Output_Token (T_With);
784 N_Indents := N_Indents + 1;
785
786 Output_Name (Name_Id (Withs.Table (W).Uname));
787
788 -- Output Kind
789
790 Output_Token (T_Kind);
791
792 if Name_Buffer (Name_Len) = 's' then
793 Output_Token (T_Spec);
794 else
795 Output_Token (T_Body);
796 end if;
797
798 Write_Eol;
799
800 Output_Afile (Withs.Table (W).Afile);
801 Output_Sfile (Withs.Table (W).Sfile);
802
803 N_Indents := N_Indents - 1;
804 end Output_With;
805
806 end GNATDIST;
807
808 -----------
809 -- Image --
810 -----------
811
812 function Image (Restriction : Restriction_Id) return String is
813 Result : String := Restriction'Img;
814 Skip : Boolean := True;
815
816 begin
817 for J in Result'Range loop
818 if Skip then
819 Skip := False;
820 Result (J) := To_Upper (Result (J));
821
822 elsif Result (J) = '_' then
823 Skip := True;
824
825 else
826 Result (J) := To_Lower (Result (J));
827 end if;
828 end loop;
829
830 return Result;
831 end Image;
832
833 ---------------
834 -- Normalize --
835 ---------------
836
837 function Normalize (Path : String) return String is
838 begin
839 if OpenVMS_On_Target then
840 return Path;
841 else
842 return Normalize_Pathname (Path);
843 end if;
844 end Normalize;
845
846 --------------------------------
847 -- Output_License_Information --
848 --------------------------------
849
850 procedure Output_License_Information is
851 begin
852 case Build_Type is
853 when others =>
854 Write_Str ("Please refer to file COPYING in your distribution"
855 & " for license terms.");
856 Write_Eol;
857 end case;
858
859 Exit_Program (E_Success);
860 end Output_License_Information;
861
862 -------------------
863 -- Output_Object --
864 -------------------
865
866 procedure Output_Object (O : File_Name_Type) is
867 Object_Name : String_Access;
868
869 begin
870 if Print_Object then
871 if O /= No_File then
872 Get_Name_String (O);
873 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
874 else
875 Object_Name := No_Obj'Unchecked_Access;
876 end if;
877
878 Write_Str (Object_Name.all);
879
880 if Print_Source or else Print_Unit then
881 if Too_Long then
882 Write_Eol;
883 Write_Str (" ");
884 else
885 Write_Str (Spaces
886 (Object_Start + Object_Name'Length .. Object_End));
887 end if;
888 end if;
889 end if;
890 end Output_Object;
891
892 -------------------
893 -- Output_Source --
894 -------------------
895
896 procedure Output_Source (Sdep_I : Sdep_Id) is
897 Stamp : Time_Stamp_Type;
898 Checksum : Word;
899 FS : File_Name_Type;
900 Status : File_Status;
901 Object_Name : String_Access;
902
903 begin
904 if Sdep_I = No_Sdep_Id then
905 return;
906 end if;
907
908 Stamp := Sdep.Table (Sdep_I).Stamp;
909 Checksum := Sdep.Table (Sdep_I).Checksum;
910 FS := Sdep.Table (Sdep_I).Sfile;
911
912 if Print_Source then
913 Find_Status (FS, Stamp, Checksum, Status);
914 Get_Name_String (FS);
915
916 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
917
918 if Verbose_Mode then
919 Write_Str (" Source => ");
920 Write_Str (Object_Name.all);
921
922 if not Too_Long then
923 Write_Str
924 (Spaces (Source_Start + Object_Name'Length .. Source_End));
925 end if;
926
927 Output_Status (Status, Verbose => True);
928 Write_Eol;
929 Write_Str (" ");
930
931 else
932 if not Selective_Output then
933 Output_Status (Status, Verbose => False);
934 end if;
935
936 Write_Str (Object_Name.all);
937 end if;
938 end if;
939 end Output_Source;
940
941 -------------------
942 -- Output_Status --
943 -------------------
944
945 procedure Output_Status (FS : File_Status; Verbose : Boolean) is
946 begin
947 if Verbose then
948 case FS is
949 when OK =>
950 Write_Str (" unchanged");
951
952 when Checksum_OK =>
953 Write_Str (" slightly modified");
954
955 when Not_Found =>
956 Write_Str (" file not found");
957
958 when Not_Same =>
959 Write_Str (" modified");
960
961 when Not_First_On_PATH =>
962 Write_Str (" unchanged version not first on PATH");
963 end case;
964
965 else
966 case FS is
967 when OK =>
968 Write_Str (" OK ");
969
970 when Checksum_OK =>
971 Write_Str (" MOK ");
972
973 when Not_Found =>
974 Write_Str (" ??? ");
975
976 when Not_Same =>
977 Write_Str (" DIF ");
978
979 when Not_First_On_PATH =>
980 Write_Str (" HID ");
981 end case;
982 end if;
983 end Output_Status;
984
985 -----------------
986 -- Output_Unit --
987 -----------------
988
989 procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id) is
990 Kind : Character;
991 U : Unit_Record renames Units.Table (U_Id);
992
993 begin
994 if Print_Unit then
995 Get_Name_String (U.Uname);
996 Kind := Name_Buffer (Name_Len);
997 Name_Len := Name_Len - 2;
998
999 if not Verbose_Mode then
1000 Write_Str (Name_Buffer (1 .. Name_Len));
1001
1002 else
1003 Write_Str ("Unit => ");
1004 Write_Eol;
1005 Write_Str (" Name => ");
1006 Write_Str (Name_Buffer (1 .. Name_Len));
1007 Write_Eol;
1008 Write_Str (" Kind => ");
1009
1010 if Units.Table (U_Id).Unit_Kind = 'p' then
1011 Write_Str ("package ");
1012 else
1013 Write_Str ("subprogram ");
1014 end if;
1015
1016 if Kind = 's' then
1017 Write_Str ("spec");
1018 else
1019 Write_Str ("body");
1020 end if;
1021 end if;
1022
1023 if Verbose_Mode then
1024 if U.Preelab or else
1025 U.No_Elab or else
1026 U.Pure or else
1027 U.Dynamic_Elab or else
1028 U.Has_RACW or else
1029 U.Remote_Types or else
1030 U.Shared_Passive or else
1031 U.RCI or else
1032 U.Predefined or else
1033 U.Internal or else
1034 U.Is_Generic or else
1035 U.Init_Scalars or else
1036 U.SAL_Interface or else
1037 U.Body_Needed_For_SAL or else
1038 U.Elaborate_Body
1039 then
1040 Write_Eol;
1041 Write_Str (" Flags =>");
1042
1043 if U.Preelab then
1044 Write_Str (" Preelaborable");
1045 end if;
1046
1047 if U.No_Elab then
1048 Write_Str (" No_Elab_Code");
1049 end if;
1050
1051 if U.Pure then
1052 Write_Str (" Pure");
1053 end if;
1054
1055 if U.Dynamic_Elab then
1056 Write_Str (" Dynamic_Elab");
1057 end if;
1058
1059 if U.Has_RACW then
1060 Write_Str (" Has_RACW");
1061 end if;
1062
1063 if U.Remote_Types then
1064 Write_Str (" Remote_Types");
1065 end if;
1066
1067 if U.Shared_Passive then
1068 Write_Str (" Shared_Passive");
1069 end if;
1070
1071 if U.RCI then
1072 Write_Str (" RCI");
1073 end if;
1074
1075 if U.Predefined then
1076 Write_Str (" Predefined");
1077 end if;
1078
1079 if U.Internal then
1080 Write_Str (" Internal");
1081 end if;
1082
1083 if U.Is_Generic then
1084 Write_Str (" Is_Generic");
1085 end if;
1086
1087 if U.Init_Scalars then
1088 Write_Str (" Init_Scalars");
1089 end if;
1090
1091 if U.SAL_Interface then
1092 Write_Str (" SAL_Interface");
1093 end if;
1094
1095 if U.Body_Needed_For_SAL then
1096 Write_Str (" Body_Needed_For_SAL");
1097 end if;
1098
1099 if U.Elaborate_Body then
1100 Write_Str (" Elaborate Body");
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.Predefined then
1112 Write_Str (" Predefined");
1113 end if;
1114 end if;
1115
1116 declare
1117 Restrictions : constant Restrictions_Info :=
1118 ALIs.Table (ALI).Restrictions;
1119
1120 begin
1121 -- If the source was compiled with pragmas Restrictions,
1122 -- Display these restrictions.
1123
1124 if Restrictions.Set /= (All_Restrictions => False) then
1125 Write_Eol;
1126 Write_Str (" pragma Restrictions =>");
1127
1128 -- For boolean restrictions, just display the name of the
1129 -- restriction; for valued restrictions, also display the
1130 -- restriction value.
1131
1132 for Restriction in All_Restrictions loop
1133 if Restrictions.Set (Restriction) then
1134 Write_Eol;
1135 Write_Str (" ");
1136 Write_Str (Image (Restriction));
1137
1138 if Restriction in All_Parameter_Restrictions then
1139 Write_Str (" =>");
1140 Write_Str (Restrictions.Value (Restriction)'Img);
1141 end if;
1142 end if;
1143 end loop;
1144 end if;
1145
1146 -- If the unit violates some Restrictions, display the list of
1147 -- these restrictions.
1148
1149 if Restrictions.Violated /= (All_Restrictions => False) then
1150 Write_Eol;
1151 Write_Str (" Restrictions violated =>");
1152
1153 -- For boolean restrictions, just display the name of the
1154 -- restriction. For valued restrictions, also display the
1155 -- restriction value.
1156
1157 for Restriction in All_Restrictions loop
1158 if Restrictions.Violated (Restriction) then
1159 Write_Eol;
1160 Write_Str (" ");
1161 Write_Str (Image (Restriction));
1162
1163 if Restriction in All_Parameter_Restrictions then
1164 if Restrictions.Count (Restriction) > 0 then
1165 Write_Str (" =>");
1166
1167 if Restrictions.Unknown (Restriction) then
1168 Write_Str (" at least");
1169 end if;
1170
1171 Write_Str (Restrictions.Count (Restriction)'Img);
1172 end if;
1173 end if;
1174 end if;
1175 end loop;
1176 end if;
1177 end;
1178 end if;
1179
1180 if Print_Source then
1181 if Too_Long then
1182 Write_Eol;
1183 Write_Str (" ");
1184 else
1185 Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
1186 end if;
1187 end if;
1188 end if;
1189 end Output_Unit;
1190
1191 -----------------
1192 -- Reset_Print --
1193 -----------------
1194
1195 procedure Reset_Print is
1196 begin
1197 if not Selective_Output then
1198 Selective_Output := True;
1199 Print_Source := False;
1200 Print_Object := False;
1201 Print_Unit := False;
1202 end if;
1203 end Reset_Print;
1204
1205 ----------------
1206 -- Search_RTS --
1207 ----------------
1208
1209 procedure Search_RTS (Name : String) is
1210 Src_Path : String_Ptr;
1211 Lib_Path : String_Ptr;
1212 -- Paths for source and include subdirs
1213
1214 Rts_Full_Path : String_Access;
1215 -- Full path for RTS project
1216
1217 begin
1218 -- Try to find the RTS
1219
1220 Src_Path := Get_RTS_Search_Dir (Name, Include);
1221 Lib_Path := Get_RTS_Search_Dir (Name, Objects);
1222
1223 -- For non-project RTS, both the include and the objects directories
1224 -- must be present.
1225
1226 if Src_Path /= null and then Lib_Path /= null then
1227 Add_Search_Dirs (Src_Path, Include);
1228 Add_Search_Dirs (Lib_Path, Objects);
1229 return;
1230 end if;
1231
1232 if Lib_Path /= null then
1233 Osint.Fail ("RTS path not valid: missing adainclude directory");
1234 elsif Src_Path /= null then
1235 Osint.Fail ("RTS path not valid: missing adalib directory");
1236 end if;
1237
1238 -- Try to find the RTS on the project path. First setup the project path
1239
1240 Initialize_Default_Project_Path
1241 (Prj_Path, Target_Name => Sdefault.Target_Name.all);
1242
1243 Rts_Full_Path := Get_Runtime_Path (Prj_Path, Name);
1244
1245 if Rts_Full_Path /= null then
1246
1247 -- Directory name was found on the project path. Look for the
1248 -- include subdirectory(s).
1249
1250 Src_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Include);
1251
1252 if Src_Path /= null then
1253 Add_Search_Dirs (Src_Path, Include);
1254
1255 -- Add the lib subdirectory if it exists
1256
1257 Lib_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Objects);
1258
1259 if Lib_Path /= null then
1260 Add_Search_Dirs (Lib_Path, Objects);
1261 end if;
1262
1263 return;
1264 end if;
1265 end if;
1266
1267 Osint.Fail
1268 ("RTS path not valid: missing adainclude and adalib directories");
1269 end Search_RTS;
1270
1271 -------------------
1272 -- Scan_Ls_Arg --
1273 -------------------
1274
1275 procedure Scan_Ls_Arg (Argv : String) is
1276 FD : File_Descriptor;
1277 Len : Integer;
1278 OK : Boolean;
1279
1280 begin
1281 pragma Assert (Argv'First = 1);
1282
1283 if Argv'Length = 0 then
1284 return;
1285 end if;
1286
1287 OK := True;
1288 if Argv (1) = '-' then
1289 if Argv'Length = 1 then
1290 Fail ("switch character cannot be followed by a blank");
1291
1292 -- Processing for -I-
1293
1294 elsif Argv (2 .. Argv'Last) = "I-" then
1295 Opt.Look_In_Primary_Dir := False;
1296
1297 -- Forbid -?- or -??- where ? is any character
1298
1299 elsif (Argv'Length = 3 and then Argv (3) = '-')
1300 or else (Argv'Length = 4 and then Argv (4) = '-')
1301 then
1302 Fail ("Trailing ""-"" at the end of " & Argv & " forbidden.");
1303
1304 -- Processing for -Idir
1305
1306 elsif Argv (2) = 'I' then
1307 Add_Source_Dir (Argv (3 .. Argv'Last));
1308 Add_Lib_Dir (Argv (3 .. Argv'Last));
1309
1310 -- Processing for -aIdir (to gcc this is like a -I switch)
1311
1312 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
1313 Add_Source_Dir (Argv (4 .. Argv'Last));
1314
1315 -- Processing for -aOdir
1316
1317 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
1318 Add_Lib_Dir (Argv (4 .. Argv'Last));
1319
1320 -- Processing for -aLdir (to gnatbind this is like a -aO switch)
1321
1322 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
1323 Add_Lib_Dir (Argv (4 .. Argv'Last));
1324
1325 -- Processing for -aP<dir>
1326
1327 elsif Argv'Length > 3 and then Argv (1 .. 3) = "-aP" then
1328 Add_Directories (Prj_Path, Argv (4 .. Argv'Last));
1329
1330 -- Processing for -nostdinc
1331
1332 elsif Argv (2 .. Argv'Last) = "nostdinc" then
1333 Opt.No_Stdinc := True;
1334
1335 -- Processing for one character switches
1336
1337 elsif Argv'Length = 2 then
1338 case Argv (2) is
1339 when 'a' => Also_Predef := True;
1340 when 'h' => Print_Usage := True;
1341 when 'u' => Reset_Print; Print_Unit := True;
1342 when 's' => Reset_Print; Print_Source := True;
1343 when 'o' => Reset_Print; Print_Object := True;
1344 when 'v' => Verbose_Mode := True;
1345 when 'd' => Dependable := True;
1346 when 'l' => License := True;
1347 when 'V' => Very_Verbose_Mode := True;
1348
1349 when others => OK := False;
1350 end case;
1351
1352 -- Processing for -files=file
1353
1354 elsif Argv'Length > 7 and then Argv (1 .. 7) = "-files=" then
1355 FD := Open_Read (Argv (8 .. Argv'Last), GNAT.OS_Lib.Text);
1356
1357 if FD = Invalid_FD then
1358 Osint.Fail ("could not find text file """ &
1359 Argv (8 .. Argv'Last) & '"');
1360 end if;
1361
1362 Len := Integer (File_Length (FD));
1363
1364 declare
1365 Buffer : String (1 .. Len + 1);
1366 Index : Positive := 1;
1367 Last : Positive;
1368
1369 begin
1370 -- Read the file
1371
1372 Len := Read (FD, Buffer (1)'Address, Len);
1373 Buffer (Buffer'Last) := ASCII.NUL;
1374 Close (FD);
1375
1376 -- Scan the file line by line
1377
1378 while Index < Buffer'Last loop
1379
1380 -- Find the end of line
1381
1382 Last := Index;
1383 while Last <= Buffer'Last
1384 and then Buffer (Last) /= ASCII.LF
1385 and then Buffer (Last) /= ASCII.CR
1386 loop
1387 Last := Last + 1;
1388 end loop;
1389
1390 -- Ignore empty lines
1391
1392 if Last > Index then
1393 Add_File (Buffer (Index .. Last - 1));
1394 end if;
1395
1396 -- Find the beginning of the next line
1397
1398 Index := Last;
1399 while Buffer (Index) = ASCII.CR or else
1400 Buffer (Index) = ASCII.LF
1401 loop
1402 Index := Index + 1;
1403 end loop;
1404 end loop;
1405 end;
1406
1407 -- Processing for --RTS=path
1408
1409 elsif Argv'Length >= 5 and then Argv (1 .. 5) = "--RTS" then
1410 if Argv'Length <= 6 or else Argv (6) /= '='then
1411 Osint.Fail ("missing path for --RTS");
1412
1413 else
1414 -- Check that it is the first time we see this switch or, if
1415 -- it is not the first time, the same path is specified.
1416
1417 if RTS_Specified = null then
1418 RTS_Specified := new String'(Argv (7 .. Argv'Last));
1419
1420 elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
1421 Osint.Fail ("--RTS cannot be specified multiple times");
1422 end if;
1423
1424 -- Valid --RTS switch
1425
1426 Opt.No_Stdinc := True;
1427 Opt.RTS_Switch := True;
1428 end if;
1429
1430 else
1431 OK := False;
1432 end if;
1433
1434 -- If not a switch, it must be a file name
1435
1436 else
1437 Add_File (Argv);
1438 end if;
1439
1440 if not OK then
1441 Write_Str ("warning: unknown switch """);
1442 Write_Str (Argv);
1443 Write_Line ("""");
1444 end if;
1445
1446 end Scan_Ls_Arg;
1447
1448 -----------
1449 -- Usage --
1450 -----------
1451
1452 procedure Usage is
1453 begin
1454 -- Usage line
1455
1456 Write_Str ("Usage: ");
1457 Osint.Write_Program_Name;
1458 Write_Str (" switches [list of object files]");
1459 Write_Eol;
1460 Write_Eol;
1461
1462 -- GNATLS switches
1463
1464 Write_Str ("switches:");
1465 Write_Eol;
1466
1467 Display_Usage_Version_And_Help;
1468
1469 -- Line for -a
1470
1471 Write_Str (" -a also output relevant predefined units");
1472 Write_Eol;
1473
1474 -- Line for -u
1475
1476 Write_Str (" -u output only relevant unit names");
1477 Write_Eol;
1478
1479 -- Line for -h
1480
1481 Write_Str (" -h output this help message");
1482 Write_Eol;
1483
1484 -- Line for -s
1485
1486 Write_Str (" -s output only relevant source names");
1487 Write_Eol;
1488
1489 -- Line for -o
1490
1491 Write_Str (" -o output only relevant object names");
1492 Write_Eol;
1493
1494 -- Line for -d
1495
1496 Write_Str (" -d output sources on which specified units " &
1497 "depend");
1498 Write_Eol;
1499
1500 -- Line for -l
1501
1502 Write_Str (" -l output license information");
1503 Write_Eol;
1504
1505 -- Line for -v
1506
1507 Write_Str (" -v verbose output, full path and unit " &
1508 "information");
1509 Write_Eol;
1510 Write_Eol;
1511
1512 -- Line for -files=
1513
1514 Write_Str (" -files=fil files are listed in text file 'fil'");
1515 Write_Eol;
1516
1517 -- Line for -aI switch
1518
1519 Write_Str (" -aIdir specify source files search path");
1520 Write_Eol;
1521
1522 -- Line for -aO switch
1523
1524 Write_Str (" -aOdir specify object files search path");
1525 Write_Eol;
1526
1527 -- Line for -aP switch
1528
1529 Write_Str (" -aPdir specify project search path");
1530 Write_Eol;
1531
1532 -- Line for -I switch
1533
1534 Write_Str (" -Idir like -aIdir -aOdir");
1535 Write_Eol;
1536
1537 -- Line for -I- switch
1538
1539 Write_Str (" -I- do not look for sources & object files");
1540 Write_Str (" in the default directory");
1541 Write_Eol;
1542
1543 -- Line for -nostdinc
1544
1545 Write_Str (" -nostdinc do not look for source files");
1546 Write_Str (" in the system default directory");
1547 Write_Eol;
1548
1549 -- Line for --RTS
1550
1551 Write_Str (" --RTS=dir specify the default source and object search"
1552 & " path");
1553 Write_Eol;
1554
1555 -- File Status explanation
1556
1557 Write_Eol;
1558 Write_Str (" file status can be:");
1559 Write_Eol;
1560
1561 for ST in File_Status loop
1562 Write_Str (" ");
1563 Output_Status (ST, Verbose => False);
1564 Write_Str (" ==> ");
1565 Output_Status (ST, Verbose => True);
1566 Write_Eol;
1567 end loop;
1568 end Usage;
1569
1570 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
1571
1572 -- Start of processing for Gnatls
1573
1574 begin
1575 -- Initialize standard packages
1576
1577 Csets.Initialize;
1578 Snames.Initialize;
1579 Stringt.Initialize;
1580
1581 -- First check for --version or --help
1582
1583 Check_Version_And_Help ("GNATLS", "1992");
1584
1585 -- Loop to scan out arguments
1586
1587 Next_Arg := 1;
1588 Scan_Args : while Next_Arg < Arg_Count loop
1589 declare
1590 Next_Argv : String (1 .. Len_Arg (Next_Arg));
1591 begin
1592 Fill_Arg (Next_Argv'Address, Next_Arg);
1593 Scan_Ls_Arg (Next_Argv);
1594 end;
1595
1596 Next_Arg := Next_Arg + 1;
1597 end loop Scan_Args;
1598
1599 -- If -l (output license information) is given, it must be the only switch
1600
1601 if License and then Arg_Count /= 2 then
1602 Set_Standard_Error;
1603 Write_Str ("Can't use -l with another switch");
1604 Write_Eol;
1605 Try_Help;
1606 Exit_Program (E_Fatal);
1607 end if;
1608
1609 -- Handle --RTS switch
1610
1611 if RTS_Specified /= null then
1612 Search_RTS (RTS_Specified.all);
1613 end if;
1614
1615 -- Add the source and object directories specified on the command line, if
1616 -- any, to the searched directories.
1617
1618 while First_Source_Dir /= null loop
1619 Add_Src_Search_Dir (First_Source_Dir.Value.all);
1620 First_Source_Dir := First_Source_Dir.Next;
1621 end loop;
1622
1623 while First_Lib_Dir /= null loop
1624 Add_Lib_Search_Dir (First_Lib_Dir.Value.all);
1625 First_Lib_Dir := First_Lib_Dir.Next;
1626 end loop;
1627
1628 -- Finally, add the default directories
1629
1630 Osint.Add_Default_Search_Dirs;
1631
1632 -- Get the target parameters to know if the target is OpenVMS, but only if
1633 -- switch -nostdinc was not specified.
1634
1635 if not Opt.No_Stdinc then
1636 Get_Target_Parameters;
1637 end if;
1638
1639 if Verbose_Mode then
1640 Write_Eol;
1641 Display_Version ("GNATLS", "1997");
1642 Write_Eol;
1643 Write_Str ("Source Search Path:");
1644 Write_Eol;
1645
1646 for J in 1 .. Nb_Dir_In_Src_Search_Path loop
1647 Write_Str (" ");
1648
1649 if Dir_In_Src_Search_Path (J)'Length = 0 then
1650 Write_Str ("<Current_Directory>");
1651 else
1652 Write_Str
1653 (Normalize
1654 (To_Host_Dir_Spec
1655 (Dir_In_Src_Search_Path (J).all, True).all));
1656 end if;
1657
1658 Write_Eol;
1659 end loop;
1660
1661 Write_Eol;
1662 Write_Eol;
1663 Write_Str ("Object Search Path:");
1664 Write_Eol;
1665
1666 for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
1667 Write_Str (" ");
1668
1669 if Dir_In_Obj_Search_Path (J)'Length = 0 then
1670 Write_Str ("<Current_Directory>");
1671 else
1672 Write_Str
1673 (Normalize
1674 (To_Host_Dir_Spec
1675 (Dir_In_Obj_Search_Path (J).all, True).all));
1676 end if;
1677
1678 Write_Eol;
1679 end loop;
1680
1681 Write_Eol;
1682 Write_Eol;
1683 Write_Str (Project_Search_Path);
1684 Write_Eol;
1685 Write_Str (" <Current_Directory>");
1686 Write_Eol;
1687
1688 Initialize_Default_Project_Path
1689 (Prj_Path, Target_Name => Sdefault.Target_Name.all);
1690
1691 declare
1692 Project_Path : String_Access;
1693 First : Natural;
1694 Last : Natural;
1695
1696 begin
1697 Get_Path (Prj_Path, Project_Path);
1698
1699 if Project_Path.all /= "" then
1700 First := Project_Path'First;
1701 loop
1702 while First <= Project_Path'Last
1703 and then (Project_Path (First) = Path_Separator)
1704 loop
1705 First := First + 1;
1706 end loop;
1707
1708 exit when First > Project_Path'Last;
1709
1710 Last := First;
1711 while Last < Project_Path'Last
1712 and then Project_Path (Last + 1) /= Path_Separator
1713 loop
1714 Last := Last + 1;
1715 end loop;
1716
1717 if First /= Last or else Project_Path (First) /= '.' then
1718
1719 -- If the directory is ".", skip it as it is the current
1720 -- directory and it is already the first directory in the
1721 -- project path.
1722
1723 Write_Str (" ");
1724 Write_Str
1725 (Normalize
1726 (To_Host_Dir_Spec
1727 (Project_Path (First .. Last), True).all));
1728 Write_Eol;
1729 end if;
1730
1731 First := Last + 1;
1732 end loop;
1733 end if;
1734 end;
1735
1736 Write_Eol;
1737 end if;
1738
1739 -- Output usage information when requested
1740
1741 if Print_Usage then
1742 Usage;
1743 end if;
1744
1745 -- Output license information when requested
1746
1747 if License then
1748 Output_License_Information;
1749 Exit_Program (E_Success);
1750 end if;
1751
1752 if not More_Lib_Files then
1753 if not Print_Usage and then not Verbose_Mode then
1754 if Argument_Count = 0 then
1755 Usage;
1756 else
1757 Try_Help;
1758 end if;
1759 end if;
1760
1761 Exit_Program (E_Fatal);
1762 end if;
1763
1764 Initialize_ALI;
1765 Initialize_ALI_Source;
1766
1767 -- Print out all library for which no ALI files can be located
1768
1769 while More_Lib_Files loop
1770 Main_File := Next_Main_Lib_File;
1771 Ali_File := Full_Lib_File_Name (Lib_File_Name (Main_File));
1772
1773 if Ali_File = No_File then
1774 if Very_Verbose_Mode then
1775 GNATDIST.Output_No_ALI (Lib_File_Name (Main_File));
1776
1777 else
1778 Set_Standard_Error;
1779 Write_Str ("Can't find library info for ");
1780 Get_Name_String (Main_File);
1781 Write_Char ('"'); -- "
1782 Write_Str (Name_Buffer (1 .. Name_Len));
1783 Write_Char ('"'); -- "
1784 Write_Eol;
1785 end if;
1786
1787 else
1788 Ali_File := Strip_Directory (Ali_File);
1789
1790 if Get_Name_Table_Info (Ali_File) = 0 then
1791 Text := Read_Library_Info (Ali_File, True);
1792
1793 declare
1794 Discard : ALI_Id;
1795 pragma Unreferenced (Discard);
1796 begin
1797 Discard :=
1798 Scan_ALI
1799 (Ali_File,
1800 Text,
1801 Ignore_ED => False,
1802 Err => False,
1803 Ignore_Errors => True);
1804 end;
1805
1806 Free (Text);
1807 end if;
1808 end if;
1809 end loop;
1810
1811 -- Reset default output file descriptor, if needed
1812
1813 Set_Standard_Output;
1814
1815 if Very_Verbose_Mode then
1816 for A in ALIs.First .. ALIs.Last loop
1817 GNATDIST.Output_ALI (A);
1818 end loop;
1819
1820 return;
1821 end if;
1822
1823 Find_General_Layout;
1824
1825 for Id in ALIs.First .. ALIs.Last loop
1826 declare
1827 Last_U : Unit_Id;
1828
1829 begin
1830 Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
1831
1832 if Also_Predef or else not Is_Internal_Unit then
1833 if ALIs.Table (Id).No_Object then
1834 Output_Object (No_File);
1835 else
1836 Output_Object (ALIs.Table (Id).Ofile_Full_Name);
1837 end if;
1838
1839 -- In verbose mode print all main units in the ALI file, otherwise
1840 -- just print the first one to ease columnwise printout
1841
1842 if Verbose_Mode then
1843 Last_U := ALIs.Table (Id).Last_Unit;
1844 else
1845 Last_U := ALIs.Table (Id).First_Unit;
1846 end if;
1847
1848 for U in ALIs.Table (Id).First_Unit .. Last_U loop
1849 if U /= ALIs.Table (Id).First_Unit
1850 and then Selective_Output
1851 and then Print_Unit
1852 then
1853 Write_Eol;
1854 end if;
1855
1856 Output_Unit (Id, U);
1857
1858 -- Output source now, unless if it will be done as part of
1859 -- outputing dependencies.
1860
1861 if not (Dependable and then Print_Source) then
1862 Output_Source (Corresponding_Sdep_Entry (Id, U));
1863 end if;
1864 end loop;
1865
1866 -- Print out list of units on which this unit depends (D lines)
1867
1868 if Dependable and then Print_Source then
1869 if Verbose_Mode then
1870 Write_Str ("depends upon");
1871 Write_Eol;
1872 Write_Str (" ");
1873 else
1874 Write_Eol;
1875 end if;
1876
1877 for D in
1878 ALIs.Table (Id).First_Sdep .. ALIs.Table (Id).Last_Sdep
1879 loop
1880 if Also_Predef
1881 or else not Is_Internal_File_Name (Sdep.Table (D).Sfile)
1882 then
1883 if Verbose_Mode then
1884 Write_Str (" ");
1885 Output_Source (D);
1886
1887 elsif Too_Long then
1888 Write_Str (" ");
1889 Output_Source (D);
1890 Write_Eol;
1891
1892 else
1893 Write_Str (Spaces (1 .. Source_Start - 2));
1894 Output_Source (D);
1895 Write_Eol;
1896 end if;
1897 end if;
1898 end loop;
1899 end if;
1900
1901 Write_Eol;
1902 end if;
1903 end;
1904 end loop;
1905
1906 -- All done. Set proper exit status
1907
1908 Namet.Finalize;
1909 Exit_Program (E_Success);
1910 end Gnatls;