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