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