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