Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/make_util.adb @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- M A K E _ U T I L --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2004-2017, 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 Atree; use Atree;
27 with Debug;
28 with Errutil;
29 with Osint; use Osint;
30 with Output; use Output;
31 with Opt; use Opt;
32 with Table;
33
34 with Ada.Command_Line; use Ada.Command_Line;
35
36 with GNAT.Case_Util; use GNAT.Case_Util;
37 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
38 with GNAT.HTable;
39
40 package body Make_Util is
41
42 ---------
43 -- Add --
44 ---------
45
46 procedure Add
47 (Option : String_Access;
48 To : in out String_List_Access;
49 Last : in out Natural)
50 is
51 begin
52 if Last = To'Last then
53 declare
54 New_Options : constant String_List_Access :=
55 new String_List (1 .. To'Last * 2);
56
57 begin
58 New_Options (To'Range) := To.all;
59
60 -- Set all elements of the original options to null to avoid
61 -- deallocation of copies.
62
63 To.all := (others => null);
64
65 Free (To);
66 To := New_Options;
67 end;
68 end if;
69
70 Last := Last + 1;
71 To (Last) := Option;
72 end Add;
73
74 procedure Add
75 (Option : String;
76 To : in out String_List_Access;
77 Last : in out Natural)
78 is
79 begin
80 Add (Option => new String'(Option), To => To, Last => Last);
81 end Add;
82
83 -------------------------
84 -- Base_Name_Index_For --
85 -------------------------
86
87 function Base_Name_Index_For
88 (Main : String;
89 Main_Index : Int;
90 Index_Separator : Character) return File_Name_Type
91 is
92 Result : File_Name_Type;
93
94 begin
95 Name_Len := 0;
96 Add_Str_To_Name_Buffer (Base_Name (Main));
97
98 -- Remove the extension, if any, that is the last part of the base name
99 -- starting with a dot and following some characters.
100
101 for J in reverse 2 .. Name_Len loop
102 if Name_Buffer (J) = '.' then
103 Name_Len := J - 1;
104 exit;
105 end if;
106 end loop;
107
108 -- Add the index info, if index is different from 0
109
110 if Main_Index > 0 then
111 Add_Char_To_Name_Buffer (Index_Separator);
112
113 declare
114 Img : constant String := Main_Index'Img;
115 begin
116 Add_Str_To_Name_Buffer (Img (2 .. Img'Last));
117 end;
118 end if;
119
120 Result := Name_Find;
121 return Result;
122 end Base_Name_Index_For;
123
124 -----------------
125 -- Create_Name --
126 -----------------
127
128 function Create_Name (Name : String) return File_Name_Type is
129 begin
130 Name_Len := 0;
131 Add_Str_To_Name_Buffer (Name);
132 return Name_Find;
133 end Create_Name;
134
135 function Create_Name (Name : String) return Name_Id is
136 begin
137 Name_Len := 0;
138 Add_Str_To_Name_Buffer (Name);
139 return Name_Find;
140 end Create_Name;
141
142 function Create_Name (Name : String) return Path_Name_Type is
143 begin
144 Name_Len := 0;
145 Add_Str_To_Name_Buffer (Name);
146 return Name_Find;
147 end Create_Name;
148
149 ---------------------------
150 -- Ensure_Absolute_Path --
151 ---------------------------
152
153 procedure Ensure_Absolute_Path
154 (Switch : in out String_Access;
155 Parent : String;
156 Do_Fail : Fail_Proc;
157 For_Gnatbind : Boolean := False;
158 Including_Non_Switch : Boolean := True;
159 Including_RTS : Boolean := False)
160 is
161 begin
162 if Switch /= null then
163 declare
164 Sw : String (1 .. Switch'Length);
165 Start : Positive;
166
167 begin
168 Sw := Switch.all;
169
170 if Sw (1) = '-' then
171 if Sw'Length >= 3
172 and then (Sw (2) = 'I'
173 or else (not For_Gnatbind
174 and then (Sw (2) = 'L'
175 or else
176 Sw (2) = 'A')))
177 then
178 Start := 3;
179
180 if Sw = "-I-" then
181 return;
182 end if;
183
184 elsif Sw'Length >= 4
185 and then
186 (Sw (2 .. 3) = "aL" or else
187 Sw (2 .. 3) = "aO" or else
188 Sw (2 .. 3) = "aI"
189 or else (For_Gnatbind and then Sw (2 .. 3) = "A="))
190 then
191 Start := 4;
192
193 elsif Including_RTS
194 and then Sw'Length >= 7
195 and then Sw (2 .. 6) = "-RTS="
196 then
197 Start := 7;
198
199 else
200 return;
201 end if;
202
203 -- Because relative path arguments to --RTS= may be relative to
204 -- the search directory prefix, those relative path arguments
205 -- are converted only when they include directory information.
206
207 if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
208 if Parent'Length = 0 then
209 Do_Fail
210 ("relative search path switches ("""
211 & Sw
212 & """) are not allowed");
213
214 elsif Including_RTS then
215 for J in Start .. Sw'Last loop
216 if Sw (J) = Directory_Separator then
217 Switch :=
218 new String'
219 (Sw (1 .. Start - 1)
220 & Parent
221 & Directory_Separator
222 & Sw (Start .. Sw'Last));
223 return;
224 end if;
225 end loop;
226
227 else
228 Switch :=
229 new String'
230 (Sw (1 .. Start - 1)
231 & Parent
232 & Directory_Separator
233 & Sw (Start .. Sw'Last));
234 end if;
235 end if;
236
237 elsif Including_Non_Switch then
238 if not Is_Absolute_Path (Sw) then
239 if Parent'Length = 0 then
240 Do_Fail
241 ("relative paths (""" & Sw & """) are not allowed");
242 else
243 Switch := new String'(Parent & Directory_Separator & Sw);
244 end if;
245 end if;
246 end if;
247 end;
248 end if;
249 end Ensure_Absolute_Path;
250
251 ----------------------------
252 -- Executable_Prefix_Path --
253 ----------------------------
254
255 function Executable_Prefix_Path return String is
256 Exec_Name : constant String := Command_Name;
257
258 function Get_Install_Dir (S : String) return String;
259 -- S is the executable name preceded by the absolute or relative path,
260 -- e.g. "c:\usr\bin\gcc.exe". Returns the absolute directory where "bin"
261 -- lies (in the example "C:\usr"). If the executable is not in a "bin"
262 -- directory, return "".
263
264 ---------------------
265 -- Get_Install_Dir --
266 ---------------------
267
268 function Get_Install_Dir (S : String) return String is
269 Exec : String := S;
270 Path_Last : Integer := 0;
271
272 begin
273 for J in reverse Exec'Range loop
274 if Exec (J) = Directory_Separator then
275 Path_Last := J - 1;
276 exit;
277 end if;
278 end loop;
279
280 if Path_Last >= Exec'First + 2 then
281 To_Lower (Exec (Path_Last - 2 .. Path_Last));
282 end if;
283
284 if Path_Last < Exec'First + 2
285 or else Exec (Path_Last - 2 .. Path_Last) /= "bin"
286 or else (Path_Last - 3 >= Exec'First
287 and then Exec (Path_Last - 3) /= Directory_Separator)
288 then
289 return "";
290 end if;
291
292 return Normalize_Pathname
293 (Exec (Exec'First .. Path_Last - 4),
294 Resolve_Links => Opt.Follow_Links_For_Dirs)
295 & Directory_Separator;
296 end Get_Install_Dir;
297
298 -- Beginning of Executable_Prefix_Path
299
300 begin
301 -- First determine if a path prefix was placed in front of the
302 -- executable name.
303
304 for J in reverse Exec_Name'Range loop
305 if Exec_Name (J) = Directory_Separator then
306 return Get_Install_Dir (Exec_Name);
307 end if;
308 end loop;
309
310 -- If we get here, the user has typed the executable name with no
311 -- directory prefix.
312
313 declare
314 Path : String_Access := Locate_Exec_On_Path (Exec_Name);
315 begin
316 if Path = null then
317 return "";
318 else
319 declare
320 Dir : constant String := Get_Install_Dir (Path.all);
321 begin
322 Free (Path);
323 return Dir;
324 end;
325 end if;
326 end;
327 end Executable_Prefix_Path;
328
329 ------------------
330 -- Fail_Program --
331 ------------------
332
333 procedure Fail_Program
334 (S : String;
335 Flush_Messages : Boolean := True)
336 is
337 begin
338 if Flush_Messages and not No_Exit_Message then
339 if Total_Errors_Detected /= 0 or else Warnings_Detected /= 0 then
340 Errutil.Finalize;
341 end if;
342 end if;
343
344 Finish_Program (E_Fatal, S => S);
345 end Fail_Program;
346
347 --------------------
348 -- Finish_Program --
349 --------------------
350
351 procedure Finish_Program
352 (Exit_Code : Osint.Exit_Code_Type := Osint.E_Success;
353 S : String := "")
354 is
355 begin
356 if S'Length > 0 then
357 if Exit_Code /= E_Success then
358 if No_Exit_Message then
359 Osint.Exit_Program (E_Fatal);
360 else
361 Osint.Fail (S);
362 end if;
363
364 elsif not No_Exit_Message then
365 Write_Str (S);
366 end if;
367 end if;
368
369 -- Output Namet statistics
370
371 Namet.Finalize;
372
373 Exit_Program (Exit_Code);
374 end Finish_Program;
375
376 ----------
377 -- Hash --
378 ----------
379
380 function Hash is new GNAT.HTable.Hash (Header_Num => Header_Num);
381 -- Used in implementation of other functions Hash below
382
383 ----------
384 -- Hash --
385 ----------
386
387 function Hash (Name : File_Name_Type) return Header_Num is
388 begin
389 return Hash (Get_Name_String (Name));
390 end Hash;
391
392 function Hash (Name : Name_Id) return Header_Num is
393 begin
394 return Hash (Get_Name_String (Name));
395 end Hash;
396
397 function Hash (Name : Path_Name_Type) return Header_Num is
398 begin
399 return Hash (Get_Name_String (Name));
400 end Hash;
401
402 ------------
403 -- Inform --
404 ------------
405
406 procedure Inform (N : File_Name_Type; Msg : String) is
407 begin
408 Inform (Name_Id (N), Msg);
409 end Inform;
410
411 procedure Inform (N : Name_Id := No_Name; Msg : String) is
412 begin
413 Osint.Write_Program_Name;
414
415 Write_Str (": ");
416
417 if N /= No_Name then
418 Write_Str ("""");
419
420 declare
421 Name : constant String := Get_Name_String (N);
422 begin
423 if Debug.Debug_Flag_F and then Is_Absolute_Path (Name) then
424 Write_Str (File_Name (Name));
425 else
426 Write_Str (Name);
427 end if;
428 end;
429
430 Write_Str (""" ");
431 end if;
432
433 Write_Str (Msg);
434 Write_Eol;
435 end Inform;
436
437 -----------
438 -- Mains --
439 -----------
440
441 package body Mains is
442
443 package Names is new Table.Table
444 (Table_Component_Type => Main_Info,
445 Table_Index_Type => Integer,
446 Table_Low_Bound => 1,
447 Table_Initial => 10,
448 Table_Increment => 100,
449 Table_Name => "Makeutl.Mains.Names");
450 -- The table that stores the mains
451
452 Current : Natural := 0;
453 -- The index of the last main retrieved from the table
454
455 Count_Of_Mains_With_No_Tree : Natural := 0;
456 -- Number of main units for which we do not know the project tree
457
458 --------------
459 -- Add_Main --
460 --------------
461
462 procedure Add_Main (Name : String; Index : Int := 0) is
463 begin
464 Name_Len := 0;
465 Add_Str_To_Name_Buffer (Name);
466 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
467
468 Names.Increment_Last;
469 Names.Table (Names.Last) := (Name_Find, Index);
470
471 Mains.Count_Of_Mains_With_No_Tree :=
472 Mains.Count_Of_Mains_With_No_Tree + 1;
473 end Add_Main;
474
475 ------------
476 -- Delete --
477 ------------
478
479 procedure Delete is
480 begin
481 Names.Set_Last (0);
482 Mains.Reset;
483 end Delete;
484
485 ---------------
486 -- Next_Main --
487 ---------------
488
489 function Next_Main return String is
490 Info : constant Main_Info := Next_Main;
491 begin
492 if Info = No_Main_Info then
493 return "";
494 else
495 return Get_Name_String (Info.File);
496 end if;
497 end Next_Main;
498
499 function Next_Main return Main_Info is
500 begin
501 if Current >= Names.Last then
502 return No_Main_Info;
503 else
504 Current := Current + 1;
505
506 declare
507 Orig_Main : constant File_Name_Type :=
508 Names.Table (Current).File;
509 Current_Main : File_Name_Type;
510
511 begin
512 if Strip_Suffix (Orig_Main) = Orig_Main then
513 Get_Name_String (Orig_Main);
514 Add_Str_To_Name_Buffer (".adb");
515 Current_Main := Name_Find;
516
517 if Full_Source_Name (Current_Main) = No_File then
518 Get_Name_String (Orig_Main);
519 Add_Str_To_Name_Buffer (".ads");
520 Current_Main := Name_Find;
521
522 if Full_Source_Name (Current_Main) /= No_File then
523 Names.Table (Current).File := Current_Main;
524 end if;
525
526 else
527 Names.Table (Current).File := Current_Main;
528 end if;
529 end if;
530 end;
531
532 return Names.Table (Current);
533 end if;
534 end Next_Main;
535
536 ---------------------
537 -- Number_Of_Mains --
538 ---------------------
539
540 function Number_Of_Mains return Natural is
541 begin
542 return Names.Last;
543 end Number_Of_Mains;
544
545 -----------
546 -- Reset --
547 -----------
548
549 procedure Reset is
550 begin
551 Current := 0;
552 end Reset;
553
554 --------------------------
555 -- Set_Multi_Unit_Index --
556 --------------------------
557
558 procedure Set_Multi_Unit_Index
559 (Index : Int := 0)
560 is
561 begin
562 if Index /= 0 then
563 if Names.Last = 0 then
564 Fail_Program
565 ("cannot specify a multi-unit index but no main "
566 & "on the command line");
567
568 elsif Names.Last > 1 then
569 Fail_Program
570 ("cannot specify several mains with a multi-unit index");
571
572 else
573 Names.Table (Names.Last).Index := Index;
574 end if;
575 end if;
576 end Set_Multi_Unit_Index;
577
578 end Mains;
579
580 -----------------------
581 -- Path_Or_File_Name --
582 -----------------------
583
584 function Path_Or_File_Name (Path : Path_Name_Type) return String is
585 Path_Name : constant String := Get_Name_String (Path);
586 begin
587 if Debug.Debug_Flag_F then
588 return File_Name (Path_Name);
589 else
590 return Path_Name;
591 end if;
592 end Path_Or_File_Name;
593
594 -------------------
595 -- Unit_Index_Of --
596 -------------------
597
598 function Unit_Index_Of (ALI_File : File_Name_Type) return Int is
599 Start : Natural;
600 Finish : Natural;
601 Result : Int := 0;
602
603 begin
604 Get_Name_String (ALI_File);
605
606 -- First, find the last dot
607
608 Finish := Name_Len;
609
610 while Finish >= 1 and then Name_Buffer (Finish) /= '.' loop
611 Finish := Finish - 1;
612 end loop;
613
614 if Finish = 1 then
615 return 0;
616 end if;
617
618 -- Now check that the dot is preceded by digits
619
620 Start := Finish;
621 Finish := Finish - 1;
622 while Start >= 1 and then Name_Buffer (Start - 1) in '0' .. '9' loop
623 Start := Start - 1;
624 end loop;
625
626 -- If there are no digits, or if the digits are not preceded by the
627 -- character that precedes a unit index, this is not the ALI file of
628 -- a unit in a multi-unit source.
629
630 if Start > Finish
631 or else Start = 1
632 or else Name_Buffer (Start - 1) /= Multi_Unit_Index_Character
633 then
634 return 0;
635 end if;
636
637 -- Build the index from the digit(s)
638
639 while Start <= Finish loop
640 Result := Result * 10 +
641 Character'Pos (Name_Buffer (Start)) - Character'Pos ('0');
642 Start := Start + 1;
643 end loop;
644
645 return Result;
646 end Unit_Index_Of;
647
648 -----------------
649 -- Verbose_Msg --
650 -----------------
651
652 procedure Verbose_Msg
653 (N1 : Name_Id;
654 S1 : String;
655 N2 : Name_Id := No_Name;
656 S2 : String := "";
657 Prefix : String := " -> ";
658 Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low)
659 is
660 begin
661 if not Opt.Verbose_Mode
662 or else Minimum_Verbosity > Opt.Verbosity_Level
663 then
664 return;
665 end if;
666
667 Write_Str (Prefix);
668 Write_Str ("""");
669 Write_Name (N1);
670 Write_Str (""" ");
671 Write_Str (S1);
672
673 if N2 /= No_Name then
674 Write_Str (" """);
675 Write_Name (N2);
676 Write_Str (""" ");
677 end if;
678
679 Write_Str (S2);
680 Write_Eol;
681 end Verbose_Msg;
682
683 procedure Verbose_Msg
684 (N1 : File_Name_Type;
685 S1 : String;
686 N2 : File_Name_Type := No_File;
687 S2 : String := "";
688 Prefix : String := " -> ";
689 Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low)
690 is
691 begin
692 Verbose_Msg
693 (Name_Id (N1), S1, Name_Id (N2), S2, Prefix, Minimum_Verbosity);
694 end Verbose_Msg;
695
696 -----------
697 -- Queue --
698 -----------
699
700 package body Queue is
701
702 type Q_Record is record
703 Info : Source_Info;
704 Processed : Boolean;
705 end record;
706
707 package Q is new Table.Table
708 (Table_Component_Type => Q_Record,
709 Table_Index_Type => Natural,
710 Table_Low_Bound => 1,
711 Table_Initial => 1000,
712 Table_Increment => 100,
713 Table_Name => "Makeutl.Queue.Q");
714 -- This is the actual Queue
715
716 type Mark_Key is record
717 File : File_Name_Type;
718 Index : Int;
719 end record;
720 -- Identify either a mono-unit source (when Index = 0) or a specific
721 -- unit (index = 1's origin index of unit) in a multi-unit source.
722
723 Max_Mask_Num : constant := 2048;
724 subtype Mark_Num is Union_Id range 0 .. Max_Mask_Num - 1;
725
726 function Hash (Key : Mark_Key) return Mark_Num;
727
728 package Marks is new GNAT.HTable.Simple_HTable
729 (Header_Num => Mark_Num,
730 Element => Boolean,
731 No_Element => False,
732 Key => Mark_Key,
733 Hash => Hash,
734 Equal => "=");
735 -- A hash table to keep tracks of the marked units.
736 -- These are the units that have already been processed, when using the
737 -- gnatmake format. When using the gprbuild format, we can directly
738 -- store in the source_id whether the file has already been processed.
739
740 procedure Mark (Source_File : File_Name_Type; Index : Int := 0);
741 -- Mark a unit, identified by its source file and, when Index is not 0,
742 -- the index of the unit in the source file. Marking is used to signal
743 -- that the unit has already been inserted in the Q.
744
745 function Is_Marked
746 (Source_File : File_Name_Type;
747 Index : Int := 0) return Boolean;
748 -- Returns True if the unit was previously marked
749
750 Q_Processed : Natural := 0;
751 Q_Initialized : Boolean := False;
752
753 Q_First : Natural := 1;
754 -- Points to the first valid element in the queue
755
756 procedure Debug_Display (S : Source_Info);
757 -- A debug display for S
758
759 function Was_Processed (S : Source_Info) return Boolean;
760 -- Whether S has already been processed. This marks the source as
761 -- processed, if it hasn't already been processed.
762
763 -------------------
764 -- Was_Processed --
765 -------------------
766
767 function Was_Processed (S : Source_Info) return Boolean is
768 begin
769 if Is_Marked (S.File, S.Index) then
770 return True;
771 end if;
772
773 Mark (S.File, Index => S.Index);
774
775 return False;
776 end Was_Processed;
777
778 -------------------
779 -- Debug_Display --
780 -------------------
781
782 procedure Debug_Display (S : Source_Info) is
783 begin
784 Write_Name (S.File);
785
786 if S.Index /= 0 then
787 Write_Str (", ");
788 Write_Int (S.Index);
789 end if;
790 end Debug_Display;
791
792 ----------
793 -- Hash --
794 ----------
795
796 function Hash (Key : Mark_Key) return Mark_Num is
797 begin
798 return Union_Id (Key.File) mod Max_Mask_Num;
799 end Hash;
800
801 ---------------
802 -- Is_Marked --
803 ---------------
804
805 function Is_Marked
806 (Source_File : File_Name_Type;
807 Index : Int := 0) return Boolean
808 is
809 begin
810 return Marks.Get (K => (File => Source_File, Index => Index));
811 end Is_Marked;
812
813 ----------
814 -- Mark --
815 ----------
816
817 procedure Mark (Source_File : File_Name_Type; Index : Int := 0) is
818 begin
819 Marks.Set (K => (File => Source_File, Index => Index), E => True);
820 end Mark;
821
822 -------------
823 -- Extract --
824 -------------
825
826 procedure Extract
827 (Found : out Boolean;
828 Source : out Source_Info)
829 is
830 begin
831 Found := False;
832
833 if Q_First <= Q.Last then
834 Source := Q.Table (Q_First).Info;
835 Q.Table (Q_First).Processed := True;
836 Q_First := Q_First + 1;
837 Found := True;
838 end if;
839
840 if Found then
841 Q_Processed := Q_Processed + 1;
842 end if;
843
844 if Found and then Debug.Debug_Flag_Q then
845 Write_Str (" Q := Q - [ ");
846 Debug_Display (Source);
847 Write_Str (" ]");
848 Write_Eol;
849
850 Write_Str (" Q_First =");
851 Write_Int (Int (Q_First));
852 Write_Eol;
853
854 Write_Str (" Q.Last =");
855 Write_Int (Int (Q.Last));
856 Write_Eol;
857 end if;
858 end Extract;
859
860 ---------------
861 -- Processed --
862 ---------------
863
864 function Processed return Natural is
865 begin
866 return Q_Processed;
867 end Processed;
868
869 ----------------
870 -- Initialize --
871 ----------------
872
873 procedure Initialize (Force : Boolean := False) is
874 begin
875 if Force or else not Q_Initialized then
876 Q_Initialized := True;
877 Q.Init;
878 Q_Processed := 0;
879 Q_First := 1;
880 end if;
881 end Initialize;
882
883 ------------
884 -- Insert --
885 ------------
886
887 function Insert (Source : Source_Info) return Boolean is
888 begin
889 -- Only insert in the Q if it is not already done, to avoid
890 -- simultaneous compilations if -jnnn is used.
891
892 if Was_Processed (Source) then
893 return False;
894 end if;
895
896 Q.Append (New_Val => (Info => Source, Processed => False));
897
898 if Debug.Debug_Flag_Q then
899 Write_Str (" Q := Q + [ ");
900 Debug_Display (Source);
901 Write_Str (" ] ");
902 Write_Eol;
903
904 Write_Str (" Q_First =");
905 Write_Int (Int (Q_First));
906 Write_Eol;
907
908 Write_Str (" Q.Last =");
909 Write_Int (Int (Q.Last));
910 Write_Eol;
911 end if;
912
913 return True;
914 end Insert;
915
916 procedure Insert (Source : Source_Info) is
917 Discard : Boolean;
918 begin
919 Discard := Insert (Source);
920 end Insert;
921
922 --------------
923 -- Is_Empty --
924 --------------
925
926 function Is_Empty return Boolean is
927 begin
928 return Q_Processed >= Q.Last;
929 end Is_Empty;
930
931 ----------
932 -- Size --
933 ----------
934
935 function Size return Natural is
936 begin
937 return Q.Last;
938 end Size;
939
940 -------------
941 -- Element --
942 -------------
943
944 function Element (Rank : Positive) return File_Name_Type is
945 begin
946 if Rank <= Q.Last then
947 return Q.Table (Rank).Info.File;
948 else
949 return No_File;
950 end if;
951 end Element;
952
953 ------------------
954 -- Remove_Marks --
955 ------------------
956
957 procedure Remove_Marks is
958 begin
959 Marks.Reset;
960 end Remove_Marks;
961
962 end Queue;
963
964 end Make_Util;