?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
2016-09-19 Richard Biener <rguenther@suse.de>
[official-gcc.git] / gcc / ada / gnatls.adb
blob6e2e382424cea926af68c8dc87862e6cedd64c40
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 others =>
853 Write_Str ("Please refer to file COPYING in your distribution"
854 & " for license terms.");
855 Write_Eol;
856 end case;
857
858 Exit_Program (E_Success);
859 end Output_License_Information;
860
861 -------------------
862 -- Output_Object --
863 -------------------
864
865 procedure Output_Object (O : File_Name_Type) is
866 Object_Name : String_Access;
867
868 begin
869 if Print_Object then
870 if O /= No_File then
871 Get_Name_String (O);
872 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
873 else
874 Object_Name := No_Obj'Unchecked_Access;
875 end if;
876
877 Write_Str (Object_Name.all);
878
879 if Print_Source or else Print_Unit then
880 if Too_Long then
881 Write_Eol;
882 Write_Str (" ");
883 else
884 Write_Str (Spaces
885 (Object_Start + Object_Name'Length .. Object_End));
886 end if;
887 end if;
888 end if;
889 end Output_Object;
890
891 -------------------
892 -- Output_Source --
893 -------------------
894
895 procedure Output_Source (Sdep_I : Sdep_Id) is
896 Stamp : Time_Stamp_Type;
897 Checksum : Word;
898 FS : File_Name_Type;
899 Status : File_Status;
900 Object_Name : String_Access;
901
902 begin
903 if Sdep_I = No_Sdep_Id then
904 return;
905 end if;
906
907 Stamp := Sdep.Table (Sdep_I).Stamp;
908 Checksum := Sdep.Table (Sdep_I).Checksum;
909 FS := Sdep.Table (Sdep_I).Sfile;
910
911 if Print_Source then
912 Find_Status (FS, Stamp, Checksum, Status);
913 Get_Name_String (FS);
914
915 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
916
917 if Verbose_Mode then
918 Write_Str (" Source => ");
919 Write_Str (Object_Name.all);
920
921 if not Too_Long then
922 Write_Str
923 (Spaces (Source_Start + Object_Name'Length .. Source_End));
924 end if;
925
926 Output_Status (Status, Verbose => True);
927 Write_Eol;
928 Write_Str (" ");
929
930 else
931 if not Selective_Output then
932 Output_Status (Status, Verbose => False);
933 end if;
934
935 Write_Str (Object_Name.all);
936 end if;
937 end if;
938 end Output_Source;
939
940 -------------------
941 -- Output_Status --
942 -------------------
943
944 procedure Output_Status (FS : File_Status; Verbose : Boolean) is
945 begin
946 if Verbose then
947 case FS is
948 when OK =>
949 Write_Str (" unchanged");
950
951 when Checksum_OK =>
952 Write_Str (" slightly modified");
953
954 when Not_Found =>
955 Write_Str (" file not found");
956
957 when Not_Same =>
958 Write_Str (" modified");
959
960 when Not_First_On_PATH =>
961 Write_Str (" unchanged version not first on PATH");
962 end case;
963
964 else
965 case FS is
966 when OK =>
967 Write_Str (" OK ");
968
969 when Checksum_OK =>
970 Write_Str (" MOK ");
971
972 when Not_Found =>
973 Write_Str (" ??? ");
974
975 when Not_Same =>
976 Write_Str (" DIF ");
977
978 when Not_First_On_PATH =>
979 Write_Str (" HID ");
980 end case;
981 end if;
982 end Output_Status;
983
984 -----------------
985 -- Output_Unit --
986 -----------------
987
988 procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id) is
989 Kind : Character;
990 U : Unit_Record renames Units.Table (U_Id);
991
992 begin
993 if Print_Unit then
994 Get_Name_String (U.Uname);
995 Kind := Name_Buffer (Name_Len);
996 Name_Len := Name_Len - 2;
997
998 if not Verbose_Mode then
999 Write_Str (Name_Buffer (1 .. Name_Len));
1000
1001 else
1002 Write_Str ("Unit => ");
1003 Write_Eol;
1004 Write_Str (" Name => ");
1005 Write_Str (Name_Buffer (1 .. Name_Len));
1006 Write_Eol;
1007 Write_Str (" Kind => ");
1008
1009 if Units.Table (U_Id).Unit_Kind = 'p' then
1010 Write_Str ("package ");
1011 else
1012 Write_Str ("subprogram ");
1013 end if;
1014
1015 if Kind = 's' then
1016 Write_Str ("spec");
1017 else
1018 Write_Str ("body");
1019 end if;
1020 end if;
1021
1022 if Verbose_Mode then
1023 if U.Preelab or else
1024 U.No_Elab or else
1025 U.Pure or else
1026 U.Dynamic_Elab or else
1027 U.Has_RACW or else
1028 U.Remote_Types or else
1029 U.Shared_Passive or else
1030 U.RCI or else
1031 U.Predefined or else
1032 U.Internal or else
1033 U.Is_Generic or else
1034 U.Init_Scalars or else
1035 U.SAL_Interface or else
1036 U.Body_Needed_For_SAL or else
1037 U.Elaborate_Body
1038 then
1039 Write_Eol;
1040 Write_Str (" Flags =>");
1041
1042 if U.Preelab then
1043 Write_Str (" Preelaborable");
1044 end if;
1045
1046 if U.No_Elab then
1047 Write_Str (" No_Elab_Code");
1048 end if;
1049
1050 if U.Pure then
1051 Write_Str (" Pure");
1052 end if;
1053
1054 if U.Dynamic_Elab then
1055 Write_Str (" Dynamic_Elab");
1056 end if;
1057
1058 if U.Has_RACW then
1059 Write_Str (" Has_RACW");
1060 end if;
1061
1062 if U.Remote_Types then
1063 Write_Str (" Remote_Types");
1064 end if;
1065
1066 if U.Shared_Passive then
1067 Write_Str (" Shared_Passive");
1068 end if;
1069
1070 if U.RCI then
1071 Write_Str (" RCI");
1072 end if;
1073
1074 if U.Predefined then
1075 Write_Str (" Predefined");
1076 end if;
1077
1078 if U.Internal then
1079 Write_Str (" Internal");
1080 end if;
1081
1082 if U.Is_Generic then
1083 Write_Str (" Is_Generic");
1084 end if;
1085
1086 if U.Init_Scalars then
1087 Write_Str (" Init_Scalars");
1088 end if;
1089
1090 if U.SAL_Interface then
1091 Write_Str (" SAL_Interface");
1092 end if;
1093
1094 if U.Body_Needed_For_SAL then
1095 Write_Str (" Body_Needed_For_SAL");
1096 end if;
1097
1098 if U.Elaborate_Body then
1099 Write_Str (" Elaborate Body");
1100 end if;
1101
1102 if U.Remote_Types then
1103 Write_Str (" Remote_Types");
1104 end if;
1105
1106 if U.Shared_Passive then
1107 Write_Str (" Shared_Passive");
1108 end if;
1109
1110 if U.Predefined then
1111 Write_Str (" Predefined");
1112 end if;
1113 end if;
1114
1115 declare
1116 Restrictions : constant Restrictions_Info :=
1117 ALIs.Table (ALI).Restrictions;
1118
1119 begin
1120 -- If the source was compiled with pragmas Restrictions,
1121 -- Display these restrictions.
1122
1123 if Restrictions.Set /= (All_Restrictions => False) then
1124 Write_Eol;
1125 Write_Str (" pragma Restrictions =>");
1126
1127 -- For boolean restrictions, just display the name of the
1128 -- restriction; for valued restrictions, also display the
1129 -- restriction value.
1130
1131 for Restriction in All_Restrictions loop
1132 if Restrictions.Set (Restriction) then
1133 Write_Eol;
1134 Write_Str (" ");
1135 Write_Str (Image (Restriction));
1136
1137 if Restriction in All_Parameter_Restrictions then
1138 Write_Str (" =>");
1139 Write_Str (Restrictions.Value (Restriction)'Img);
1140 end if;
1141 end if;
1142 end loop;
1143 end if;
1144
1145 -- If the unit violates some Restrictions, display the list of
1146 -- these restrictions.
1147
1148 if Restrictions.Violated /= (All_Restrictions => False) then
1149 Write_Eol;
1150 Write_Str (" Restrictions violated =>");
1151
1152 -- For boolean restrictions, just display the name of the
1153 -- restriction. For valued restrictions, also display the
1154 -- restriction value.
1155
1156 for Restriction in All_Restrictions loop
1157 if Restrictions.Violated (Restriction) then
1158 Write_Eol;
1159 Write_Str (" ");
1160 Write_Str (Image (Restriction));
1161
1162 if Restriction in All_Parameter_Restrictions then
1163 if Restrictions.Count (Restriction) > 0 then
1164 Write_Str (" =>");
1165
1166 if Restrictions.Unknown (Restriction) then
1167 Write_Str (" at least");
1168 end if;
1169
1170 Write_Str (Restrictions.Count (Restriction)'Img);
1171 end if;
1172 end if;
1173 end if;
1174 end loop;
1175 end if;
1176 end;
1177 end if;
1178
1179 if Print_Source then
1180 if Too_Long then
1181 Write_Eol;
1182 Write_Str (" ");
1183 else
1184 Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
1185 end if;
1186 end if;
1187 end if;
1188 end Output_Unit;
1189
1190 -----------------
1191 -- Reset_Print --
1192 -----------------
1193
1194 procedure Reset_Print is
1195 begin
1196 if not Selective_Output then
1197 Selective_Output := True;
1198 Print_Source := False;
1199 Print_Object := False;
1200 Print_Unit := False;
1201 end if;
1202 end Reset_Print;
1203
1204 ----------------
1205 -- Search_RTS --
1206 ----------------
1207
1208 procedure Search_RTS (Name : String) is
1209 Src_Path : String_Ptr;
1210 Lib_Path : String_Ptr;
1211 -- Paths for source and include subdirs
1212
1213 Rts_Full_Path : String_Access;
1214 -- Full path for RTS project
1215
1216 begin
1217 -- Try to find the RTS
1218
1219 Src_Path := Get_RTS_Search_Dir (Name, Include);
1220 Lib_Path := Get_RTS_Search_Dir (Name, Objects);
1221
1222 -- For non-project RTS, both the include and the objects directories
1223 -- must be present.
1224
1225 if Src_Path /= null and then Lib_Path /= null then
1226 Add_Search_Dirs (Src_Path, Include);
1227 Add_Search_Dirs (Lib_Path, Objects);
1228 Initialize_Default_Project_Path
1229 (Prj_Path,
1230 Target_Name => Sdefault.Target_Name.all,
1231 Runtime_Name => Name);
1232 return;
1233 end if;
1234
1235 if Lib_Path /= null then
1236 Osint.Fail ("RTS path not valid: missing adainclude directory");
1237 elsif Src_Path /= null then
1238 Osint.Fail ("RTS path not valid: missing adalib directory");
1239 end if;
1240
1241 -- Try to find the RTS on the project path. First setup the project path
1242
1243 Initialize_Default_Project_Path
1244 (Prj_Path,
1245 Target_Name => Sdefault.Target_Name.all,
1246 Runtime_Name => Name);
1247
1248 Rts_Full_Path := Get_Runtime_Path (Prj_Path, Name);
1249
1250 if Rts_Full_Path /= null then
1251
1252 -- Directory name was found on the project path. Look for the
1253 -- include subdirectory(s).
1254
1255 Src_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Include);
1256
1257 if Src_Path /= null then
1258 Add_Search_Dirs (Src_Path, Include);
1259
1260 -- Add the lib subdirectory if it exists
1261
1262 Lib_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Objects);
1263
1264 if Lib_Path /= null then
1265 Add_Search_Dirs (Lib_Path, Objects);
1266 end if;
1267
1268 return;
1269 end if;
1270 end if;
1271
1272 Osint.Fail
1273 ("RTS path not valid: missing adainclude and adalib directories");
1274 end Search_RTS;
1275
1276 -------------------
1277 -- Scan_Ls_Arg --
1278 -------------------
1279
1280 procedure Scan_Ls_Arg (Argv : String) is
1281 FD : File_Descriptor;
1282 Len : Integer;
1283 OK : Boolean;
1284
1285 begin
1286 pragma Assert (Argv'First = 1);
1287
1288 if Argv'Length = 0 then
1289 return;
1290 end if;
1291
1292 OK := True;
1293 if Argv (1) = '-' then
1294 if Argv'Length = 1 then
1295 Fail ("switch character cannot be followed by a blank");
1296
1297 -- Processing for -I-
1298
1299 elsif Argv (2 .. Argv'Last) = "I-" then
1300 Opt.Look_In_Primary_Dir := False;
1301
1302 -- Forbid -?- or -??- where ? is any character
1303
1304 elsif (Argv'Length = 3 and then Argv (3) = '-')
1305 or else (Argv'Length = 4 and then Argv (4) = '-')
1306 then
1307 Fail ("Trailing ""-"" at the end of " & Argv & " forbidden.");
1308
1309 -- Processing for -Idir
1310
1311 elsif Argv (2) = 'I' then
1312 Add_Source_Dir (Argv (3 .. Argv'Last));
1313 Add_Lib_Dir (Argv (3 .. Argv'Last));
1314
1315 -- Processing for -aIdir (to gcc this is like a -I switch)
1316
1317 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
1318 Add_Source_Dir (Argv (4 .. Argv'Last));
1319
1320 -- Processing for -aOdir
1321
1322 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
1323 Add_Lib_Dir (Argv (4 .. Argv'Last));
1324
1325 -- Processing for -aLdir (to gnatbind this is like a -aO switch)
1326
1327 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
1328 Add_Lib_Dir (Argv (4 .. Argv'Last));
1329
1330 -- Processing for -aP<dir>
1331
1332 elsif Argv'Length > 3 and then Argv (1 .. 3) = "-aP" then
1333 Add_Directories (Prj_Path, Argv (4 .. Argv'Last));
1334
1335 -- Processing for -nostdinc
1336
1337 elsif Argv (2 .. Argv'Last) = "nostdinc" then
1338 Opt.No_Stdinc := True;
1339
1340 -- Processing for one character switches
1341
1342 elsif Argv'Length = 2 then
1343 case Argv (2) is
1344 when 'a' => Also_Predef := True;
1345 when 'h' => Print_Usage := True;
1346 when 'u' => Reset_Print; Print_Unit := True;
1347 when 's' => Reset_Print; Print_Source := True;
1348 when 'o' => Reset_Print; Print_Object := True;
1349 when 'v' => Verbose_Mode := True;
1350 when 'd' => Dependable := True;
1351 when 'l' => License := True;
1352 when 'V' => Very_Verbose_Mode := True;
1353
1354 when others => OK := False;
1355 end case;
1356
1357 -- Processing for -files=file
1358
1359 elsif Argv'Length > 7 and then Argv (1 .. 7) = "-files=" then
1360 FD := Open_Read (Argv (8 .. Argv'Last), GNAT.OS_Lib.Text);
1361
1362 if FD = Invalid_FD then
1363 Osint.Fail ("could not find text file """ &
1364 Argv (8 .. Argv'Last) & '"');
1365 end if;
1366
1367 Len := Integer (File_Length (FD));
1368
1369 declare
1370 Buffer : String (1 .. Len + 1);
1371 Index : Positive := 1;
1372 Last : Positive;
1373
1374 begin
1375 -- Read the file
1376
1377 Len := Read (FD, Buffer (1)'Address, Len);
1378 Buffer (Buffer'Last) := ASCII.NUL;
1379 Close (FD);
1380
1381 -- Scan the file line by line
1382
1383 while Index < Buffer'Last loop
1384
1385 -- Find the end of line
1386
1387 Last := Index;
1388 while Last <= Buffer'Last
1389 and then Buffer (Last) /= ASCII.LF
1390 and then Buffer (Last) /= ASCII.CR
1391 loop
1392 Last := Last + 1;
1393 end loop;
1394
1395 -- Ignore empty lines
1396
1397 if Last > Index then
1398 Add_File (Buffer (Index .. Last - 1));
1399 end if;
1400
1401 -- Find the beginning of the next line
1402
1403 Index := Last;
1404 while Buffer (Index) = ASCII.CR or else
1405 Buffer (Index) = ASCII.LF
1406 loop
1407 Index := Index + 1;
1408 end loop;
1409 end loop;
1410 end;
1411
1412 -- Processing for --RTS=path
1413
1414 elsif Argv'Length >= 5 and then Argv (1 .. 5) = "--RTS" then
1415 if Argv'Length <= 6 or else Argv (6) /= '='then
1416 Osint.Fail ("missing path for --RTS");
1417
1418 else
1419 -- Check that it is the first time we see this switch or, if
1420 -- it is not the first time, the same path is specified.
1421
1422 if RTS_Specified = null then
1423 RTS_Specified := new String'(Argv (7 .. Argv'Last));
1424
1425 elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
1426 Osint.Fail ("--RTS cannot be specified multiple times");
1427 end if;
1428
1429 -- Valid --RTS switch
1430
1431 Opt.No_Stdinc := True;
1432 Opt.RTS_Switch := True;
1433 end if;
1434
1435 else
1436 OK := False;
1437 end if;
1438
1439 -- If not a switch, it must be a file name
1440
1441 else
1442 Add_File (Argv);
1443 end if;
1444
1445 if not OK then
1446 Write_Str ("warning: unknown switch """);
1447 Write_Str (Argv);
1448 Write_Line ("""");
1449 end if;
1450
1451 end Scan_Ls_Arg;
1452
1453 -----------
1454 -- Usage --
1455 -----------
1456
1457 procedure Usage is
1458 begin
1459 -- Usage line
1460
1461 Write_Str ("Usage: ");
1462 Osint.Write_Program_Name;
1463 Write_Str (" switches [list of object files]");
1464 Write_Eol;
1465 Write_Eol;
1466
1467 -- GNATLS switches
1468
1469 Write_Str ("switches:");
1470 Write_Eol;
1471
1472 Display_Usage_Version_And_Help;
1473
1474 -- Line for -a
1475
1476 Write_Str (" -a also output relevant predefined units");
1477 Write_Eol;
1478
1479 -- Line for -u
1480
1481 Write_Str (" -u output only relevant unit names");
1482 Write_Eol;
1483
1484 -- Line for -h
1485
1486 Write_Str (" -h output this help message");
1487 Write_Eol;
1488
1489 -- Line for -s
1490
1491 Write_Str (" -s output only relevant source names");
1492 Write_Eol;
1493
1494 -- Line for -o
1495
1496 Write_Str (" -o output only relevant object names");
1497 Write_Eol;
1498
1499 -- Line for -d
1500
1501 Write_Str (" -d output sources on which specified units " &
1502 "depend");
1503 Write_Eol;
1504
1505 -- Line for -l
1506
1507 Write_Str (" -l output license information");
1508 Write_Eol;
1509
1510 -- Line for -v
1511
1512 Write_Str (" -v verbose output, full path and unit " &
1513 "information");
1514 Write_Eol;
1515 Write_Eol;
1516
1517 -- Line for -files=
1518
1519 Write_Str (" -files=fil files are listed in text file 'fil'");
1520 Write_Eol;
1521
1522 -- Line for -aI switch
1523
1524 Write_Str (" -aIdir specify source files search path");
1525 Write_Eol;
1526
1527 -- Line for -aO switch
1528
1529 Write_Str (" -aOdir specify object files search path");
1530 Write_Eol;
1531
1532 -- Line for -aP switch
1533
1534 Write_Str (" -aPdir specify project search path");
1535 Write_Eol;
1536
1537 -- Line for -I switch
1538
1539 Write_Str (" -Idir like -aIdir -aOdir");
1540 Write_Eol;
1541
1542 -- Line for -I- switch
1543
1544 Write_Str (" -I- do not look for sources & object files");
1545 Write_Str (" in the default directory");
1546 Write_Eol;
1547
1548 -- Line for -nostdinc
1549
1550 Write_Str (" -nostdinc do not look for source files");
1551 Write_Str (" in the system default directory");
1552 Write_Eol;
1553
1554 -- Line for --RTS
1555
1556 Write_Str (" --RTS=dir specify the default source and object search"
1557 & " path");
1558 Write_Eol;
1559
1560 -- File Status explanation
1561
1562 Write_Eol;
1563 Write_Str (" file status can be:");
1564 Write_Eol;
1565
1566 for ST in File_Status loop
1567 Write_Str (" ");
1568 Output_Status (ST, Verbose => False);
1569 Write_Str (" ==> ");
1570 Output_Status (ST, Verbose => True);
1571 Write_Eol;
1572 end loop;
1573 end Usage;
1574
1575 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
1576
1577 -- Start of processing for Gnatls
1578
1579 begin
1580 -- Initialize standard packages
1581
1582 Csets.Initialize;
1583 Snames.Initialize;
1584 Stringt.Initialize;
1585
1586 -- First check for --version or --help
1587
1588 Check_Version_And_Help ("GNATLS", "1992");
1589
1590 -- Loop to scan out arguments
1591
1592 Next_Arg := 1;
1593 Scan_Args : while Next_Arg < Arg_Count loop
1594 declare
1595 Next_Argv : String (1 .. Len_Arg (Next_Arg));
1596 begin
1597 Fill_Arg (Next_Argv'Address, Next_Arg);
1598 Scan_Ls_Arg (Next_Argv);
1599 end;
1600
1601 Next_Arg := Next_Arg + 1;
1602 end loop Scan_Args;
1603
1604 -- If -l (output license information) is given, it must be the only switch
1605
1606 if License then
1607 if Arg_Count = 2 then
1608 Output_License_Information;
1609 Exit_Program (E_Success);
1610
1611 else
1612 Set_Standard_Error;
1613 Write_Str ("Can't use -l with another switch");
1614 Write_Eol;
1615 Try_Help;
1616 Exit_Program (E_Fatal);
1617 end if;
1618 end if;
1619
1620 -- Handle --RTS switch
1621
1622 if RTS_Specified /= null then
1623 Search_RTS (RTS_Specified.all);
1624 end if;
1625
1626 -- Add the source and object directories specified on the command line, if
1627 -- any, to the searched directories.
1628
1629 while First_Source_Dir /= null loop
1630 Add_Src_Search_Dir (First_Source_Dir.Value.all);
1631 First_Source_Dir := First_Source_Dir.Next;
1632 end loop;
1633
1634 while First_Lib_Dir /= null loop
1635 Add_Lib_Search_Dir (First_Lib_Dir.Value.all);
1636 First_Lib_Dir := First_Lib_Dir.Next;
1637 end loop;
1638
1639 -- Finally, add the default directories
1640
1641 Osint.Add_Default_Search_Dirs;
1642
1643 -- If --RTS= is not specified, check if there is a default runtime
1644
1645 if RTS_Specified = null then
1646 declare
1647 Text : Source_Buffer_Ptr;
1648 Hi : Source_Ptr;
1649
1650 begin
1651 Name_Buffer (1 .. 10) := "system.ads";
1652 Name_Len := 10;
1653
1654 Read_Source_File (Name_Find, Lo => 0, Hi => Hi, Src => Text);
1655
1656 if Text = null then
1657 No_Runtime := True;
1658 end if;
1659 end;
1660 end if;
1661
1662 if Verbose_Mode then
1663 Write_Eol;
1664 Display_Version ("GNATLS", "1997");
1665 Write_Eol;
1666
1667 if No_Runtime then
1668 Write_Str
1669 ("Default runtime not available. Use --RTS= with a valid runtime");
1670 Write_Eol;
1671 Write_Eol;
1672 Exit_Status := E_Warnings;
1673 end if;
1674
1675 Write_Str ("Source Search Path:");
1676 Write_Eol;
1677
1678 for J in 1 .. Nb_Dir_In_Src_Search_Path loop
1679 Write_Str (" ");
1680
1681 if Dir_In_Src_Search_Path (J)'Length = 0 then
1682 Write_Str ("<Current_Directory>");
1683 Write_Eol;
1684
1685 elsif not No_Runtime then
1686 Write_Str
1687 (Normalize
1688 (To_Host_Dir_Spec
1689 (Dir_In_Src_Search_Path (J).all, True).all));
1690 Write_Eol;
1691 end if;
1692 end loop;
1693
1694 Write_Eol;
1695 Write_Eol;
1696 Write_Str ("Object Search Path:");
1697 Write_Eol;
1698
1699 for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
1700 Write_Str (" ");
1701
1702 if Dir_In_Obj_Search_Path (J)'Length = 0 then
1703 Write_Str ("<Current_Directory>");
1704 Write_Eol;
1705
1706 elsif not No_Runtime then
1707 Write_Str
1708 (Normalize
1709 (To_Host_Dir_Spec
1710 (Dir_In_Obj_Search_Path (J).all, True).all));
1711 Write_Eol;
1712 end if;
1713 end loop;
1714
1715 Write_Eol;
1716 Write_Eol;
1717 Write_Str (Project_Search_Path);
1718 Write_Eol;
1719 Write_Str (" <Current_Directory>");
1720 Write_Eol;
1721
1722 Initialize_Default_Project_Path
1723 (Prj_Path, Target_Name => Sdefault.Target_Name.all);
1724
1725 declare
1726 Project_Path : String_Access;
1727 First : Natural;
1728 Last : Natural;
1729
1730 begin
1731 Get_Path (Prj_Path, Project_Path);
1732
1733 if Project_Path.all /= "" then
1734 First := Project_Path'First;
1735 loop
1736 while First <= Project_Path'Last
1737 and then (Project_Path (First) = Path_Separator)
1738 loop
1739 First := First + 1;
1740 end loop;
1741
1742 exit when First > Project_Path'Last;
1743
1744 Last := First;
1745 while Last < Project_Path'Last
1746 and then Project_Path (Last + 1) /= Path_Separator
1747 loop
1748 Last := Last + 1;
1749 end loop;
1750
1751 if First /= Last or else Project_Path (First) /= '.' then
1752
1753 -- If the directory is ".", skip it as it is the current
1754 -- directory and it is already the first directory in the
1755 -- project path.
1756
1757 Write_Str (" ");
1758 Write_Str
1759 (Normalize
1760 (To_Host_Dir_Spec
1761 (Project_Path (First .. Last), True).all));
1762 Write_Eol;
1763 end if;
1764
1765 First := Last + 1;
1766 end loop;
1767 end if;
1768 end;
1769
1770 Write_Eol;
1771 end if;
1772
1773 -- Output usage information when requested
1774
1775 if Print_Usage then
1776 Usage;
1777 end if;
1778
1779 if not More_Lib_Files then
1780 if not Print_Usage and then not Verbose_Mode then
1781 if Argument_Count = 0 then
1782 Usage;
1783 else
1784 Try_Help;
1785 Exit_Status := E_Fatal;
1786 end if;
1787 end if;
1788
1789 Exit_Program (Exit_Status);
1790 end if;
1791
1792 Initialize_ALI;
1793 Initialize_ALI_Source;
1794
1795 -- Print out all libraries for which no ALI files can be located
1796
1797 while More_Lib_Files loop
1798 Main_File := Next_Main_Lib_File;
1799 Ali_File := Full_Lib_File_Name (Lib_File_Name (Main_File));
1800
1801 if Ali_File = No_File then
1802 if Very_Verbose_Mode then
1803 GNATDIST.Output_No_ALI (Lib_File_Name (Main_File));
1804
1805 else
1806 Set_Standard_Error;
1807 Write_Str ("Can't find library info for ");
1808 Get_Name_String (Main_File);
1809 Write_Char ('"'); -- "
1810 Write_Str (Name_Buffer (1 .. Name_Len));
1811 Write_Char ('"'); -- "
1812 Write_Eol;
1813 Exit_Status := E_Fatal;
1814 end if;
1815
1816 else
1817 Ali_File := Strip_Directory (Ali_File);
1818
1819 if Get_Name_Table_Int (Ali_File) = 0 then
1820 Text := Read_Library_Info (Ali_File, True);
1821
1822 declare
1823 Discard : ALI_Id;
1824 begin
1825 Discard :=
1826 Scan_ALI
1827 (Ali_File,
1828 Text,
1829 Ignore_ED => False,
1830 Err => False,
1831 Ignore_Errors => True);
1832 end;
1833
1834 Free (Text);
1835 end if;
1836 end if;
1837 end loop;
1838
1839 -- Reset default output file descriptor, if needed
1840
1841 Set_Standard_Output;
1842
1843 if Very_Verbose_Mode then
1844 for A in ALIs.First .. ALIs.Last loop
1845 GNATDIST.Output_ALI (A);
1846 end loop;
1847
1848 return;
1849 end if;
1850
1851 Find_General_Layout;
1852
1853 for Id in ALIs.First .. ALIs.Last loop
1854 declare
1855 Last_U : Unit_Id;
1856
1857 begin
1858 Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
1859
1860 if Also_Predef or else not Is_Internal_Unit then
1861 if ALIs.Table (Id).No_Object then
1862 Output_Object (No_File);
1863 else
1864 Output_Object (ALIs.Table (Id).Ofile_Full_Name);
1865 end if;
1866
1867 -- In verbose mode print all main units in the ALI file, otherwise
1868 -- just print the first one to ease columnwise printout
1869
1870 if Verbose_Mode then
1871 Last_U := ALIs.Table (Id).Last_Unit;
1872 else
1873 Last_U := ALIs.Table (Id).First_Unit;
1874 end if;
1875
1876 for U in ALIs.Table (Id).First_Unit .. Last_U loop
1877 if U /= ALIs.Table (Id).First_Unit
1878 and then Selective_Output
1879 and then Print_Unit
1880 then
1881 Write_Eol;
1882 end if;
1883
1884 Output_Unit (Id, U);
1885
1886 -- Output source now, unless if it will be done as part of
1887 -- outputing dependencies.
1888
1889 if not (Dependable and then Print_Source) then
1890 Output_Source (Corresponding_Sdep_Entry (Id, U));
1891 end if;
1892 end loop;
1893
1894 -- Print out list of units on which this unit depends (D lines)
1895
1896 if Dependable and then Print_Source then
1897 if Verbose_Mode then
1898 Write_Str ("depends upon");
1899 Write_Eol;
1900 Write_Str (" ");
1901 else
1902 Write_Eol;
1903 end if;
1904
1905 for D in
1906 ALIs.Table (Id).First_Sdep .. ALIs.Table (Id).Last_Sdep
1907 loop
1908 if Also_Predef
1909 or else not Is_Internal_File_Name (Sdep.Table (D).Sfile)
1910 then
1911 if Verbose_Mode then
1912 Write_Str (" ");
1913 Output_Source (D);
1914
1915 elsif Too_Long then
1916 Write_Str (" ");
1917 Output_Source (D);
1918 Write_Eol;
1919
1920 else
1921 Write_Str (Spaces (1 .. Source_Start - 2));
1922 Output_Source (D);
1923 Write_Eol;
1924 end if;
1925 end if;
1926 end loop;
1927 end if;
1928
1929 Write_Eol;
1930 end if;
1931 end;
1932 end loop;
1933
1934 -- All done. Set proper exit status
1935
1936 Namet.Finalize;
1937 Exit_Program (Exit_Status);
1938 end Gnatls;
Mirror of the offical gcc git repository hosted at gcc.gnu.org