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

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/ada/make_util.adb	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,964 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                            M A K E _ U T I L                             --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 2004-2017, Free Software Foundation, Inc.         --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Atree;    use Atree;
+with Debug;
+with Errutil;
+with Osint;    use Osint;
+with Output;   use Output;
+with Opt;      use Opt;
+with Table;
+
+with Ada.Command_Line;           use Ada.Command_Line;
+
+with GNAT.Case_Util;             use GNAT.Case_Util;
+with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
+with GNAT.HTable;
+
+package body Make_Util is
+
+   ---------
+   -- Add --
+   ---------
+
+   procedure Add
+     (Option : String_Access;
+      To     : in out String_List_Access;
+      Last   : in out Natural)
+   is
+   begin
+      if Last = To'Last then
+         declare
+            New_Options : constant String_List_Access :=
+                            new String_List (1 .. To'Last * 2);
+
+         begin
+            New_Options (To'Range) := To.all;
+
+            --  Set all elements of the original options to null to avoid
+            --  deallocation of copies.
+
+            To.all := (others => null);
+
+            Free (To);
+            To := New_Options;
+         end;
+      end if;
+
+      Last := Last + 1;
+      To (Last) := Option;
+   end Add;
+
+   procedure Add
+     (Option : String;
+      To     : in out String_List_Access;
+      Last   : in out Natural)
+   is
+   begin
+      Add (Option => new String'(Option), To => To, Last => Last);
+   end Add;
+
+   -------------------------
+   -- Base_Name_Index_For --
+   -------------------------
+
+   function Base_Name_Index_For
+     (Main            : String;
+      Main_Index      : Int;
+      Index_Separator : Character) return File_Name_Type
+   is
+      Result : File_Name_Type;
+
+   begin
+      Name_Len := 0;
+      Add_Str_To_Name_Buffer (Base_Name (Main));
+
+      --  Remove the extension, if any, that is the last part of the base name
+      --  starting with a dot and following some characters.
+
+      for J in reverse 2 .. Name_Len loop
+         if Name_Buffer (J) = '.' then
+            Name_Len := J - 1;
+            exit;
+         end if;
+      end loop;
+
+      --  Add the index info, if index is different from 0
+
+      if Main_Index > 0 then
+         Add_Char_To_Name_Buffer (Index_Separator);
+
+         declare
+            Img : constant String := Main_Index'Img;
+         begin
+            Add_Str_To_Name_Buffer (Img (2 .. Img'Last));
+         end;
+      end if;
+
+      Result := Name_Find;
+      return Result;
+   end Base_Name_Index_For;
+
+   -----------------
+   -- Create_Name --
+   -----------------
+
+   function Create_Name (Name : String) return File_Name_Type is
+   begin
+      Name_Len := 0;
+      Add_Str_To_Name_Buffer (Name);
+      return Name_Find;
+   end Create_Name;
+
+   function Create_Name (Name : String) return Name_Id is
+   begin
+      Name_Len := 0;
+      Add_Str_To_Name_Buffer (Name);
+      return Name_Find;
+   end Create_Name;
+
+   function Create_Name (Name : String) return Path_Name_Type is
+   begin
+      Name_Len := 0;
+      Add_Str_To_Name_Buffer (Name);
+      return Name_Find;
+   end Create_Name;
+
+   ---------------------------
+   -- Ensure_Absolute_Path --
+   ---------------------------
+
+   procedure Ensure_Absolute_Path
+     (Switch               : in out String_Access;
+      Parent               : String;
+      Do_Fail              : Fail_Proc;
+      For_Gnatbind         : Boolean := False;
+      Including_Non_Switch : Boolean := True;
+      Including_RTS        : Boolean := False)
+   is
+   begin
+      if Switch /= null then
+         declare
+            Sw    : String (1 .. Switch'Length);
+            Start : Positive;
+
+         begin
+            Sw := Switch.all;
+
+            if Sw (1) = '-' then
+               if Sw'Length >= 3
+                 and then (Sw (2) = 'I'
+                            or else (not For_Gnatbind
+                                      and then (Sw (2) = 'L'
+                                                 or else
+                                                Sw (2) = 'A')))
+               then
+                  Start := 3;
+
+                  if Sw = "-I-" then
+                     return;
+                  end if;
+
+               elsif Sw'Length >= 4
+                 and then
+                   (Sw (2 .. 3) = "aL" or else
+                    Sw (2 .. 3) = "aO" or else
+                    Sw (2 .. 3) = "aI"
+                      or else (For_Gnatbind and then Sw (2 .. 3) = "A="))
+               then
+                  Start := 4;
+
+               elsif Including_RTS
+                 and then Sw'Length >= 7
+                 and then Sw (2 .. 6) = "-RTS="
+               then
+                  Start := 7;
+
+               else
+                  return;
+               end if;
+
+               --  Because relative path arguments to --RTS= may be relative to
+               --  the search directory prefix, those relative path arguments
+               --  are converted only when they include directory information.
+
+               if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
+                  if Parent'Length = 0 then
+                     Do_Fail
+                       ("relative search path switches ("""
+                        & Sw
+                        & """) are not allowed");
+
+                  elsif Including_RTS then
+                     for J in Start .. Sw'Last loop
+                        if Sw (J) = Directory_Separator then
+                           Switch :=
+                             new String'
+                               (Sw (1 .. Start - 1)
+                                & Parent
+                                & Directory_Separator
+                                & Sw (Start .. Sw'Last));
+                           return;
+                        end if;
+                     end loop;
+
+                  else
+                     Switch :=
+                       new String'
+                         (Sw (1 .. Start - 1)
+                          & Parent
+                          & Directory_Separator
+                          & Sw (Start .. Sw'Last));
+                  end if;
+               end if;
+
+            elsif Including_Non_Switch then
+               if not Is_Absolute_Path (Sw) then
+                  if Parent'Length = 0 then
+                     Do_Fail
+                       ("relative paths (""" & Sw & """) are not allowed");
+                  else
+                     Switch := new String'(Parent & Directory_Separator & Sw);
+                  end if;
+               end if;
+            end if;
+         end;
+      end if;
+   end Ensure_Absolute_Path;
+
+   ----------------------------
+   -- Executable_Prefix_Path --
+   ----------------------------
+
+   function Executable_Prefix_Path return String is
+      Exec_Name : constant String := Command_Name;
+
+      function Get_Install_Dir (S : String) return String;
+      --  S is the executable name preceded by the absolute or relative path,
+      --  e.g. "c:\usr\bin\gcc.exe". Returns the absolute directory where "bin"
+      --  lies (in the example "C:\usr"). If the executable is not in a "bin"
+      --  directory, return "".
+
+      ---------------------
+      -- Get_Install_Dir --
+      ---------------------
+
+      function Get_Install_Dir (S : String) return String is
+         Exec      : String  := S;
+         Path_Last : Integer := 0;
+
+      begin
+         for J in reverse Exec'Range loop
+            if Exec (J) = Directory_Separator then
+               Path_Last := J - 1;
+               exit;
+            end if;
+         end loop;
+
+         if Path_Last >= Exec'First + 2 then
+            To_Lower (Exec (Path_Last - 2 .. Path_Last));
+         end if;
+
+         if Path_Last < Exec'First + 2
+           or else Exec (Path_Last - 2 .. Path_Last) /= "bin"
+           or else (Path_Last - 3 >= Exec'First
+                     and then Exec (Path_Last - 3) /= Directory_Separator)
+         then
+            return "";
+         end if;
+
+         return Normalize_Pathname
+                  (Exec (Exec'First .. Path_Last - 4),
+                   Resolve_Links => Opt.Follow_Links_For_Dirs)
+           & Directory_Separator;
+      end Get_Install_Dir;
+
+   --  Beginning of Executable_Prefix_Path
+
+   begin
+      --  First determine if a path prefix was placed in front of the
+      --  executable name.
+
+      for J in reverse Exec_Name'Range loop
+         if Exec_Name (J) = Directory_Separator then
+            return Get_Install_Dir (Exec_Name);
+         end if;
+      end loop;
+
+      --  If we get here, the user has typed the executable name with no
+      --  directory prefix.
+
+      declare
+         Path : String_Access := Locate_Exec_On_Path (Exec_Name);
+      begin
+         if Path = null then
+            return "";
+         else
+            declare
+               Dir : constant String := Get_Install_Dir (Path.all);
+            begin
+               Free (Path);
+               return Dir;
+            end;
+         end if;
+      end;
+   end Executable_Prefix_Path;
+
+   ------------------
+   -- Fail_Program --
+   ------------------
+
+   procedure Fail_Program
+     (S              : String;
+      Flush_Messages : Boolean := True)
+   is
+   begin
+      if Flush_Messages and not No_Exit_Message then
+         if Total_Errors_Detected /= 0 or else Warnings_Detected /= 0 then
+            Errutil.Finalize;
+         end if;
+      end if;
+
+      Finish_Program (E_Fatal, S => S);
+   end Fail_Program;
+
+   --------------------
+   -- Finish_Program --
+   --------------------
+
+   procedure Finish_Program
+     (Exit_Code    : Osint.Exit_Code_Type := Osint.E_Success;
+      S            : String := "")
+   is
+   begin
+      if S'Length > 0 then
+         if Exit_Code /= E_Success then
+            if No_Exit_Message then
+               Osint.Exit_Program (E_Fatal);
+            else
+               Osint.Fail (S);
+            end if;
+
+         elsif not No_Exit_Message then
+            Write_Str (S);
+         end if;
+      end if;
+
+      --  Output Namet statistics
+
+      Namet.Finalize;
+
+      Exit_Program (Exit_Code);
+   end Finish_Program;
+
+   ----------
+   -- Hash --
+   ----------
+
+   function Hash is new GNAT.HTable.Hash (Header_Num => Header_Num);
+   --  Used in implementation of other functions Hash below
+
+   ----------
+   -- Hash --
+   ----------
+
+   function Hash (Name : File_Name_Type) return Header_Num is
+   begin
+      return Hash (Get_Name_String (Name));
+   end Hash;
+
+   function Hash (Name : Name_Id) return Header_Num is
+   begin
+      return Hash (Get_Name_String (Name));
+   end Hash;
+
+   function Hash (Name : Path_Name_Type) return Header_Num is
+   begin
+      return Hash (Get_Name_String (Name));
+   end Hash;
+
+   ------------
+   -- Inform --
+   ------------
+
+   procedure Inform (N : File_Name_Type; Msg : String) is
+   begin
+      Inform (Name_Id (N), Msg);
+   end Inform;
+
+   procedure Inform (N : Name_Id := No_Name; Msg : String) is
+   begin
+      Osint.Write_Program_Name;
+
+      Write_Str (": ");
+
+      if N /= No_Name then
+         Write_Str ("""");
+
+         declare
+            Name : constant String := Get_Name_String (N);
+         begin
+            if Debug.Debug_Flag_F and then Is_Absolute_Path (Name) then
+               Write_Str (File_Name (Name));
+            else
+               Write_Str (Name);
+            end if;
+         end;
+
+         Write_Str (""" ");
+      end if;
+
+      Write_Str (Msg);
+      Write_Eol;
+   end Inform;
+
+   -----------
+   -- Mains --
+   -----------
+
+   package body Mains is
+
+      package Names is new Table.Table
+        (Table_Component_Type => Main_Info,
+         Table_Index_Type     => Integer,
+         Table_Low_Bound      => 1,
+         Table_Initial        => 10,
+         Table_Increment      => 100,
+         Table_Name           => "Makeutl.Mains.Names");
+      --  The table that stores the mains
+
+      Current : Natural := 0;
+      --  The index of the last main retrieved from the table
+
+      Count_Of_Mains_With_No_Tree : Natural := 0;
+      --  Number of main units for which we do not know the project tree
+
+      --------------
+      -- Add_Main --
+      --------------
+
+      procedure Add_Main (Name : String; Index : Int := 0) is
+      begin
+         Name_Len := 0;
+         Add_Str_To_Name_Buffer (Name);
+         Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+
+         Names.Increment_Last;
+         Names.Table (Names.Last) := (Name_Find, Index);
+
+         Mains.Count_Of_Mains_With_No_Tree :=
+           Mains.Count_Of_Mains_With_No_Tree + 1;
+      end Add_Main;
+
+      ------------
+      -- Delete --
+      ------------
+
+      procedure Delete is
+      begin
+         Names.Set_Last (0);
+         Mains.Reset;
+      end Delete;
+
+      ---------------
+      -- Next_Main --
+      ---------------
+
+      function Next_Main return String is
+         Info : constant Main_Info := Next_Main;
+      begin
+         if Info = No_Main_Info then
+            return "";
+         else
+            return Get_Name_String (Info.File);
+         end if;
+      end Next_Main;
+
+      function Next_Main return Main_Info is
+      begin
+         if Current >= Names.Last then
+            return No_Main_Info;
+         else
+            Current := Current + 1;
+
+            declare
+               Orig_Main : constant File_Name_Type :=
+                 Names.Table (Current).File;
+               Current_Main : File_Name_Type;
+
+            begin
+               if Strip_Suffix (Orig_Main) = Orig_Main then
+                  Get_Name_String (Orig_Main);
+                  Add_Str_To_Name_Buffer (".adb");
+                  Current_Main := Name_Find;
+
+                  if Full_Source_Name (Current_Main) = No_File then
+                     Get_Name_String (Orig_Main);
+                     Add_Str_To_Name_Buffer (".ads");
+                     Current_Main := Name_Find;
+
+                     if Full_Source_Name (Current_Main) /= No_File then
+                        Names.Table (Current).File := Current_Main;
+                     end if;
+
+                  else
+                     Names.Table (Current).File := Current_Main;
+                  end if;
+               end if;
+            end;
+
+            return Names.Table (Current);
+         end if;
+      end Next_Main;
+
+      ---------------------
+      -- Number_Of_Mains --
+      ---------------------
+
+      function Number_Of_Mains return Natural is
+      begin
+         return Names.Last;
+      end Number_Of_Mains;
+
+      -----------
+      -- Reset --
+      -----------
+
+      procedure Reset is
+      begin
+         Current := 0;
+      end Reset;
+
+      --------------------------
+      -- Set_Multi_Unit_Index --
+      --------------------------
+
+      procedure Set_Multi_Unit_Index
+        (Index        : Int := 0)
+      is
+      begin
+         if Index /= 0 then
+            if Names.Last = 0 then
+               Fail_Program
+                 ("cannot specify a multi-unit index but no main "
+                  & "on the command line");
+
+            elsif Names.Last > 1 then
+               Fail_Program
+                 ("cannot specify several mains with a multi-unit index");
+
+            else
+               Names.Table (Names.Last).Index := Index;
+            end if;
+         end if;
+      end Set_Multi_Unit_Index;
+
+   end Mains;
+
+   -----------------------
+   -- Path_Or_File_Name --
+   -----------------------
+
+   function Path_Or_File_Name (Path : Path_Name_Type) return String is
+      Path_Name : constant String := Get_Name_String (Path);
+   begin
+      if Debug.Debug_Flag_F then
+         return File_Name (Path_Name);
+      else
+         return Path_Name;
+      end if;
+   end Path_Or_File_Name;
+
+   -------------------
+   -- Unit_Index_Of --
+   -------------------
+
+   function Unit_Index_Of (ALI_File : File_Name_Type) return Int is
+      Start  : Natural;
+      Finish : Natural;
+      Result : Int := 0;
+
+   begin
+      Get_Name_String (ALI_File);
+
+      --  First, find the last dot
+
+      Finish := Name_Len;
+
+      while Finish >= 1 and then Name_Buffer (Finish) /= '.' loop
+         Finish := Finish - 1;
+      end loop;
+
+      if Finish = 1 then
+         return 0;
+      end if;
+
+      --  Now check that the dot is preceded by digits
+
+      Start := Finish;
+      Finish := Finish - 1;
+      while Start >= 1 and then Name_Buffer (Start - 1) in '0' .. '9' loop
+         Start := Start - 1;
+      end loop;
+
+      --  If there are no digits, or if the digits are not preceded by the
+      --  character that precedes a unit index, this is not the ALI file of
+      --  a unit in a multi-unit source.
+
+      if Start > Finish
+        or else Start = 1
+        or else Name_Buffer (Start - 1) /= Multi_Unit_Index_Character
+      then
+         return 0;
+      end if;
+
+      --  Build the index from the digit(s)
+
+      while Start <= Finish loop
+         Result := Result * 10 +
+                     Character'Pos (Name_Buffer (Start)) - Character'Pos ('0');
+         Start := Start + 1;
+      end loop;
+
+      return Result;
+   end Unit_Index_Of;
+
+   -----------------
+   -- Verbose_Msg --
+   -----------------
+
+   procedure Verbose_Msg
+     (N1                : Name_Id;
+      S1                : String;
+      N2                : Name_Id := No_Name;
+      S2                : String  := "";
+      Prefix            : String := "  -> ";
+      Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low)
+   is
+   begin
+      if not Opt.Verbose_Mode
+        or else Minimum_Verbosity > Opt.Verbosity_Level
+      then
+         return;
+      end if;
+
+      Write_Str (Prefix);
+      Write_Str ("""");
+      Write_Name (N1);
+      Write_Str (""" ");
+      Write_Str (S1);
+
+      if N2 /= No_Name then
+         Write_Str (" """);
+         Write_Name (N2);
+         Write_Str (""" ");
+      end if;
+
+      Write_Str (S2);
+      Write_Eol;
+   end Verbose_Msg;
+
+   procedure Verbose_Msg
+     (N1                : File_Name_Type;
+      S1                : String;
+      N2                : File_Name_Type := No_File;
+      S2                : String  := "";
+      Prefix            : String := "  -> ";
+      Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low)
+   is
+   begin
+      Verbose_Msg
+        (Name_Id (N1), S1, Name_Id (N2), S2, Prefix, Minimum_Verbosity);
+   end Verbose_Msg;
+
+   -----------
+   -- Queue --
+   -----------
+
+   package body Queue is
+
+      type Q_Record is record
+         Info      : Source_Info;
+         Processed : Boolean;
+      end record;
+
+      package Q is new Table.Table
+        (Table_Component_Type => Q_Record,
+         Table_Index_Type     => Natural,
+         Table_Low_Bound      => 1,
+         Table_Initial        => 1000,
+         Table_Increment      => 100,
+         Table_Name           => "Makeutl.Queue.Q");
+      --  This is the actual Queue
+
+      type Mark_Key is record
+         File  : File_Name_Type;
+         Index : Int;
+      end record;
+      --  Identify either a mono-unit source (when Index = 0) or a specific
+      --  unit (index = 1's origin index of unit) in a multi-unit source.
+
+      Max_Mask_Num : constant := 2048;
+      subtype Mark_Num is Union_Id range 0 .. Max_Mask_Num - 1;
+
+      function Hash (Key : Mark_Key) return Mark_Num;
+
+      package Marks is new GNAT.HTable.Simple_HTable
+        (Header_Num => Mark_Num,
+         Element    => Boolean,
+         No_Element => False,
+         Key        => Mark_Key,
+         Hash       => Hash,
+         Equal      => "=");
+      --  A hash table to keep tracks of the marked units.
+      --  These are the units that have already been processed, when using the
+      --  gnatmake format. When using the gprbuild format, we can directly
+      --  store in the source_id whether the file has already been processed.
+
+      procedure Mark (Source_File : File_Name_Type; Index : Int := 0);
+      --  Mark a unit, identified by its source file and, when Index is not 0,
+      --  the index of the unit in the source file. Marking is used to signal
+      --  that the unit has already been inserted in the Q.
+
+      function Is_Marked
+        (Source_File : File_Name_Type;
+         Index       : Int := 0) return Boolean;
+      --  Returns True if the unit was previously marked
+
+      Q_Processed   : Natural := 0;
+      Q_Initialized : Boolean := False;
+
+      Q_First : Natural := 1;
+      --  Points to the first valid element in the queue
+
+      procedure Debug_Display (S : Source_Info);
+      --  A debug display for S
+
+      function Was_Processed (S : Source_Info) return Boolean;
+      --  Whether S has already been processed. This marks the source as
+      --  processed, if it hasn't already been processed.
+
+      -------------------
+      -- Was_Processed --
+      -------------------
+
+      function Was_Processed (S : Source_Info) return Boolean is
+      begin
+         if Is_Marked (S.File, S.Index) then
+            return True;
+         end if;
+
+         Mark (S.File, Index => S.Index);
+
+         return False;
+      end Was_Processed;
+
+      -------------------
+      -- Debug_Display --
+      -------------------
+
+      procedure Debug_Display (S : Source_Info) is
+      begin
+         Write_Name (S.File);
+
+         if S.Index /= 0 then
+            Write_Str (", ");
+            Write_Int (S.Index);
+         end if;
+      end Debug_Display;
+
+      ----------
+      -- Hash --
+      ----------
+
+      function Hash (Key : Mark_Key) return Mark_Num is
+      begin
+         return Union_Id (Key.File) mod Max_Mask_Num;
+      end Hash;
+
+      ---------------
+      -- Is_Marked --
+      ---------------
+
+      function Is_Marked
+        (Source_File : File_Name_Type;
+         Index       : Int := 0) return Boolean
+      is
+      begin
+         return Marks.Get (K => (File => Source_File, Index => Index));
+      end Is_Marked;
+
+      ----------
+      -- Mark --
+      ----------
+
+      procedure Mark (Source_File : File_Name_Type; Index : Int := 0) is
+      begin
+         Marks.Set (K => (File => Source_File, Index => Index), E => True);
+      end Mark;
+
+      -------------
+      -- Extract --
+      -------------
+
+      procedure Extract
+        (Found  : out Boolean;
+         Source : out Source_Info)
+      is
+      begin
+         Found := False;
+
+         if Q_First <= Q.Last then
+            Source := Q.Table (Q_First).Info;
+            Q.Table (Q_First).Processed := True;
+            Q_First := Q_First + 1;
+            Found := True;
+         end if;
+
+         if Found then
+            Q_Processed := Q_Processed + 1;
+         end if;
+
+         if Found and then Debug.Debug_Flag_Q then
+            Write_Str ("   Q := Q - [ ");
+            Debug_Display (Source);
+            Write_Str (" ]");
+            Write_Eol;
+
+            Write_Str ("   Q_First =");
+            Write_Int (Int (Q_First));
+            Write_Eol;
+
+            Write_Str ("   Q.Last =");
+            Write_Int (Int (Q.Last));
+            Write_Eol;
+         end if;
+      end Extract;
+
+      ---------------
+      -- Processed --
+      ---------------
+
+      function Processed return Natural is
+      begin
+         return Q_Processed;
+      end Processed;
+
+      ----------------
+      -- Initialize --
+      ----------------
+
+      procedure Initialize (Force : Boolean := False) is
+      begin
+         if Force or else not Q_Initialized then
+            Q_Initialized := True;
+            Q.Init;
+            Q_Processed := 0;
+            Q_First     := 1;
+         end if;
+      end Initialize;
+
+      ------------
+      -- Insert --
+      ------------
+
+      function Insert (Source  : Source_Info) return Boolean is
+      begin
+         --  Only insert in the Q if it is not already done, to avoid
+         --  simultaneous compilations if -jnnn is used.
+
+         if Was_Processed (Source) then
+            return False;
+         end if;
+
+         Q.Append (New_Val => (Info => Source, Processed => False));
+
+         if Debug.Debug_Flag_Q then
+            Write_Str ("   Q := Q + [ ");
+            Debug_Display (Source);
+            Write_Str (" ] ");
+            Write_Eol;
+
+            Write_Str ("   Q_First =");
+            Write_Int (Int (Q_First));
+            Write_Eol;
+
+            Write_Str ("   Q.Last =");
+            Write_Int (Int (Q.Last));
+            Write_Eol;
+         end if;
+
+         return True;
+      end Insert;
+
+      procedure Insert (Source : Source_Info) is
+         Discard : Boolean;
+      begin
+         Discard := Insert (Source);
+      end Insert;
+
+      --------------
+      -- Is_Empty --
+      --------------
+
+      function Is_Empty return Boolean is
+      begin
+         return Q_Processed >= Q.Last;
+      end Is_Empty;
+
+      ----------
+      -- Size --
+      ----------
+
+      function Size return Natural is
+      begin
+         return Q.Last;
+      end Size;
+
+      -------------
+      -- Element --
+      -------------
+
+      function Element (Rank : Positive) return File_Name_Type is
+      begin
+         if Rank <= Q.Last then
+            return Q.Table (Rank).Info.File;
+         else
+            return No_File;
+         end if;
+      end Element;
+
+      ------------------
+      -- Remove_Marks --
+      ------------------
+
+      procedure Remove_Marks is
+      begin
+         Marks.Reset;
+      end Remove_Marks;
+
+   end Queue;
+
+end Make_Util;