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