------------------------------------------------------------------------------
--                                                                          --
--                           GNATTEST COMPONENTS                            --
--                                                                          --
--           G N A T T E S T . S T U B . S O U R C E _ T A B L E            --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2011-2014, AdaCore                     --
--                                                                          --
-- GNATTEST  is  free  software;  you  can redistribute it and/or modify it --
-- under terms of the  GNU  General Public License as published by the Free --
-- Software  Foundation;  either  version  2, or (at your option) any later --
-- version.  GNATTEST  is  distributed  in the hope that it will be useful, --
-- but  WITHOUT  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 COPYING. If --
-- not, write to the  Free  Software  Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA.,                                      --
--                                                                          --
-- GNATTEST is maintained by AdaCore (http://www.adacore.com).              --
--                                                                          --
------------------------------------------------------------------------------

pragma Ada_2005;

with Ada.Containers.Indefinite_Ordered_Maps;
with Ada.Containers.Indefinite_Ordered_Sets;

with GNAT.OS_Lib;                use GNAT.OS_Lib;
with GNAT.Directory_Operations;  use GNAT.Directory_Operations;

with GNATtest.Options;          use GNATtest.Options;

with GNATCOLL.Projects;          use GNATCOLL.Projects;
with GNATCOLL.VFS;               use GNATCOLL.VFS;

with ASIS_UL.Output;  use ASIS_UL.Output;
with ASIS_UL.Options; use ASIS_UL.Options;

with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Text_IO;             use Ada.Text_IO;

package body GNATtest.Skeleton.Source_Table is

   -----------------------
   -- Source File table --
   -----------------------

   Sources_Left  : Natural := 0;
   Total_Sources : Natural := 0;

   type SF_Record;

   type SF_Record is record

      Full_Source_Name : String_Access;
      --  This field stores the source name with full directory information
      --  in absolute form

      Suffixless_Name : String_Access;
      --  The source name without directory information and suffix (if any)
      --  is used to create the names of the tree file and ALI files

      Test_Destination : String_Access;
      --  The path to the corresponding test unit location.

      Stub_Destination : String_Access;
      --  The path to the corresponding stub unit location.

      Status : SF_Status;
      --  Status of the given source. Initially is set to Waiting, then is
      --  changed according to the results of the metrics computation

      Corresponding_Body : String_Access;
      --  Set in Stub Mode for package specs.

      Stub_Data_Base_Spec : String_Access;
      Stub_Data_Base_Body : String_Access;
      --  Different projects in the hierarchy may have different naming
      --  schemes, but we won't have the access to this info once ASIS context
      --  is generated, so we need to calculate those names beforehand.

      Stub_Created : Boolean := False;

      Project_Name : String_Access;
      --  Name of corresponding project. Only relevant for bodies.
   end record;

   package Source_File_Table is new
     Ada.Containers.Indefinite_Ordered_Maps (String, SF_Record);

   package String_Set is new
     Ada.Containers.Indefinite_Ordered_Sets (String);
   use String_Set;

   use Source_File_Table;

   package Source_File_Locations renames String_Set;

   SF_Table : Source_File_Table.Map;
   --  Source Table itself

   SFL_Table : Source_File_Locations.Set;
   --  A set of paths to source files. Used for creation of project file.

   SF_Process_Iterator  : Source_File_Table.Cursor;
   SF_Access_Iterator   : Source_File_Table.Cursor;
   SFL_Iterator         : Source_File_Locations.Cursor;

   Short_Source_Name_String : String_Access;
   Full_Source_Name_String  : String_Access;

   procedure Reset_Source_Process_Iterator;
   --  Sets SF_Iterator to the begining of SF_Table.

   type Project_Record is record
      Path                : String_Access;
      Obj_Dir             : String_Access;
      Stub_Dir            : String_Access;
      Importing_List      : List_Of_Strings.List;
      Imported_List       : List_Of_Strings.List;
      Is_Externally_Built : Boolean;

      Needed_For_Extention : Boolean := False;
   end record;

   use List_Of_Strings;

   package Project_File_Table is new
     Ada.Containers.Indefinite_Ordered_Maps (String, Project_Record);
   use Project_File_Table;

   PF_Table : Project_File_Table.Map;

   -----------------------------
   --  Add_Source_To_Process  --
   -----------------------------

   procedure Add_Source_To_Process (Fname : String) is
      First_Idx : Natural;
      Last_Idx  : Natural;

      New_SF_Record : SF_Record;
   begin
      if not Is_Regular_File (Fname) then
         Report_Std ("gnattest: " & Fname & " not found");
         return;
      end if;

      --  Check if we already have a file with the same short name:
      Short_Source_Name_String := new String'(Base_Name (Fname));
      Full_Source_Name_String  :=
        new String'(Normalize_Pathname
          (Fname,
           Resolve_Links  => False,
             Case_Sensitive => False));

      --  Making the new SF_Record
      New_SF_Record.Full_Source_Name :=
        new String'(Full_Source_Name_String.all);

      First_Idx := Short_Source_Name_String'First;
      Last_Idx  := Short_Source_Name_String'Last;

      for J in reverse  First_Idx + 1 .. Last_Idx loop

         if Short_Source_Name_String (J) = '.' then
            Last_Idx := J - 1;
            exit;
         end if;

      end loop;

      New_SF_Record.Suffixless_Name :=
        new String'(Short_Source_Name_String.all (First_Idx .. Last_Idx));

      New_SF_Record.Status := Waiting;

      if Stub_Mode_ON then
         declare
            Given_File : constant GNATCOLL.VFS.Virtual_File :=
              Create (+Fname);
            Other_File : constant GNATCOLL.VFS.Virtual_File :=
              Source_Project_Tree.Other_File (Given_File);
            F_Info     : constant File_Info                 :=
              Source_Project_Tree.Info (Given_File);
         begin
            if Given_File /= Other_File
              and then Is_Regular_File (Other_File.Display_Full_Name)
            then
               New_SF_Record.Corresponding_Body :=
                 new String'(Other_File.Display_Full_Name);
            end if;

            New_SF_Record.Stub_Data_Base_Spec := new String'
              (+
                 (File_From_Unit
                      (Project         => F_Info.Project,
                       Unit_Name       =>
                         F_Info.Unit_Name & "." & Stub_Data_Unit_Name,
                       Part            => Unit_Spec,
                       Language        => F_Info.Language,
                       File_Must_Exist => False)));

            New_SF_Record.Stub_Data_Base_Body := new String'
              (+
                 (File_From_Unit
                      (Project         => F_Info.Project,
                       Unit_Name       =>
                         F_Info.Unit_Name & "." & Stub_Data_Unit_Name,
                       Part            => Unit_Body,
                       Language        => F_Info.Language,
                       File_Must_Exist => False)));

            New_SF_Record.Project_Name := new String'(F_Info.Project.Name);
         end;

      end if;

      Insert (SF_Table, Full_Source_Name_String.all, New_SF_Record);

      Include
        (SFL_Table,
         Normalize_Pathname (Name => Dir_Name (Full_Source_Name_String.all),
                             Case_Sensitive => False));

      Sources_Left  := Sources_Left + 1;
      Total_Sources := Total_Sources + 1;

      Free (Short_Source_Name_String);
      Free (Full_Source_Name_String);

   end Add_Source_To_Process;

   -------------------------
   -- Add_Body_To_Process --
   -------------------------

   procedure Add_Body_To_Process (Fname : String; Pname : String) is
      First_Idx : Natural;
      Last_Idx  : Natural;

      New_SF_Record : SF_Record;
   begin
      --  Check if we already have a file with the same short name:
      Short_Source_Name_String := new String'(Base_Name (Fname));
      Full_Source_Name_String  :=
        new String'(Normalize_Pathname
                    (Fname,
                       Resolve_Links  => False,
                       Case_Sensitive => False));

      --  Making the new SF_Record
      New_SF_Record.Full_Source_Name :=
        new String'(Full_Source_Name_String.all);

      First_Idx := Short_Source_Name_String'First;
      Last_Idx  := Short_Source_Name_String'Last;

      for J in reverse  First_Idx + 1 .. Last_Idx loop

         if Short_Source_Name_String (J) = '.' then
            Last_Idx := J - 1;
            exit;
         end if;

      end loop;

      New_SF_Record.Suffixless_Name :=
        new String'(Short_Source_Name_String.all (First_Idx .. Last_Idx));

      New_SF_Record.Status := To_Stub_Body;

      New_SF_Record.Project_Name := new String'(Pname);

      Insert (SF_Table, Full_Source_Name_String.all, New_SF_Record);

      Include
        (SFL_Table,
         Normalize_Pathname (Name => Dir_Name (Full_Source_Name_String.all),
                             Case_Sensitive => False));

      Free (Short_Source_Name_String);
      Free (Full_Source_Name_String);
   end Add_Body_To_Process;

   ------------------------
   -- Add_Body_Reference --
   ------------------------

   procedure Add_Body_Reference (Fname : String) is
      First_Idx : Natural;
      Last_Idx  : Natural;

      New_SF_Record : SF_Record;
   begin
      if not Is_Regular_File (Fname) then
         Report_Std ("gnattest: " & Fname & " not found");
         return;
      end if;

      Short_Source_Name_String := new String'(Base_Name (Fname));
      Full_Source_Name_String  :=
        new String'(Normalize_Pathname
          (Fname,
           Resolve_Links  => False,
             Case_Sensitive => False));

      --  Already present specs should not be overridden
      if
        SF_Table.Find
          (Full_Source_Name_String.all) /= Source_File_Table.No_Element
      then
         return;
      end if;

      --  Making the new SF_Record
      New_SF_Record.Full_Source_Name :=
        new String'(Full_Source_Name_String.all);

      First_Idx := Short_Source_Name_String'First;
      Last_Idx  := Short_Source_Name_String'Last;

      for J in reverse  First_Idx + 1 .. Last_Idx loop

         if Short_Source_Name_String (J) = '.' then
            Last_Idx := J - 1;
            exit;
         end if;

      end loop;

      New_SF_Record.Suffixless_Name :=
        new String'(Short_Source_Name_String.all (First_Idx .. Last_Idx));

      New_SF_Record.Status := Body_Reference;

      declare
         Given_File : constant GNATCOLL.VFS.Virtual_File :=
           Create (+Fname);
         Other_File : constant GNATCOLL.VFS.Virtual_File :=
           Source_Project_Tree.Other_File (Given_File);
         F_Info     : constant File_Info                 :=
           Source_Project_Tree.Info (Given_File);
      begin
         if Given_File /= Other_File
           and then Is_Regular_File (Other_File.Display_Full_Name)
         then
            New_SF_Record.Corresponding_Body :=
              new String'(Other_File.Display_Full_Name);
         end if;

         New_SF_Record.Stub_Data_Base_Spec := new String'
           (+
              (File_From_Unit
                   (Project         => F_Info.Project,
                    Unit_Name       =>
                      F_Info.Unit_Name & "." & Stub_Data_Unit_Name,
                    Part            => Unit_Spec,
                    Language        => F_Info.Language,
                    File_Must_Exist => False)));

         New_SF_Record.Stub_Data_Base_Body := new String'
           (+
              (File_From_Unit
                   (Project         => F_Info.Project,
                    Unit_Name       =>
                      F_Info.Unit_Name & "." & Stub_Data_Unit_Name,
                    Part            => Unit_Body,
                    Language        => F_Info.Language,
                    File_Must_Exist => False)));

         New_SF_Record.Project_Name := new String'(F_Info.Project.Name);
      end;

      Insert (SF_Table, Full_Source_Name_String.all, New_SF_Record);

      Free (Short_Source_Name_String);
      Free (Full_Source_Name_String);
   end Add_Body_Reference;

   ----------------
   --  Is_Empty  --
   ----------------
   function SF_Table_Empty return Boolean is
      Empty : constant Boolean := Is_Empty (SF_Table);
      Cur   : Source_File_Table.Cursor;
   begin
      if Empty then
         return Empty;
      else
         Cur := SF_Table.First;
         while Cur /= Source_File_Table.No_Element loop
            if Element (Cur).Status /= To_Stub_Body then
               return False;
            end if;

            Next (Cur);
         end loop;

         return True;
      end if;
   end SF_Table_Empty;

   -------------------------------
   -- Enforce_Project_Extention --
   -------------------------------

   procedure Enforce_Project_Extention is
      Relative_P_Path, Relative_I_Path : String_Access;

      Cur : Project_File_Table.Cursor := PF_Table.First;

      Arg_Proj : Project_Record;

      I_Cur : List_Of_Strings.Cursor;
   begin

      while Cur /= Project_File_Table.No_Element loop

         Arg_Proj := Project_File_Table.Element (Cur);

         if Arg_Proj.Needed_For_Extention then

            Relative_P_Path := new String'
              (+Relative_Path
                 (Create (+Arg_Proj.Path.all),
                  Create (+Arg_Proj.Stub_Dir.all)));

            declare
               F : File_Array_Access;
            begin
               Append
                 (F,
                  GNATCOLL.VFS.Create
                    (+(Arg_Proj.Stub_Dir.all)));
               Create_Dirs (F);
            end;

            Create
              (Output_File,
               Out_File,
               Arg_Proj.Stub_Dir.all
               & Directory_Separator
               & Unit_To_File_Name
                 (Stub_Project_Prefix
                  & Project_File_Table.Key (Cur))
               & ".gpr");

            I_Cur := Arg_Proj.Imported_List.First;
            while I_Cur /= List_Of_Strings.No_Element loop
               if
                 PF_Table.Element
                 (List_Of_Strings.Element (I_Cur)).Needed_For_Extention
               then
                  Relative_I_Path := new String'
                    (+Relative_Path
                       (Create
                            (+PF_Table.Element
                                 (List_Of_Strings.Element (I_Cur)).Path.all),
                        Create (+Arg_Proj.Stub_Dir.all)));
                  S_Put
                    (0,
                     "with """
                     & Relative_I_Path.all
                     & """;");
                  New_Line (Output_File);
               end if;
               Next (I_Cur);
            end loop;

            S_Put
              (0,
               "project "
               & Stub_Project_Prefix
               & Project_File_Table.Key (Cur)
               & " extends """
               & Relative_P_Path.all
               & """ is");
            New_Line (Output_File);
            S_Put (3, "for Source_Dirs use (""."");");
            New_Line (Output_File);
            S_Put
              (0,
               "end "
               & Stub_Project_Prefix
               & Project_File_Table.Key (Cur)
               & ";");

            Close (Output_File);
         end if;

         Next (Cur);
      end loop;

   end Enforce_Project_Extention;

   ---------------------------
   -- Get_Imported_Projects --
   ---------------------------

   function Get_Imported_Projects (Project_Name : String)
                                   return List_Of_Strings.List
   is
   begin
      return Project_File_Table.Element
        (PF_Table, Project_Name).Imported_List;
   end Get_Imported_Projects;

   ----------------------------
   -- Get_Importing_Projects --
   ----------------------------

   function Get_Importing_Projects (Project_Name : String)
                                    return List_Of_Strings.List
   is
   begin
      return Project_File_Table.Element
        (PF_Table, Project_Name).Importing_List;
   end Get_Importing_Projects;

   ----------------------
   -- Get_Project_Path --
   ----------------------

   function Get_Project_Path (Project_Name : String) return String is
   begin
      return Project_File_Table.Element
        (PF_Table, Project_Name).Path.all;
   end Get_Project_Path;

   --------------------------
   -- Get_Project_Stub_Dir --
   --------------------------

   function Get_Project_Stub_Dir (Project_Name : String) return String is
   begin
      return Project_File_Table.Element
        (PF_Table, Project_Name).Stub_Dir.all;
   end Get_Project_Stub_Dir;

   ---------------------
   -- Get_Source_Body --
   ---------------------

   function Get_Source_Body (Source_Name : String) return String
   is
      SN : constant String :=
        Normalize_Pathname
          (Name           => Source_Name,
           Case_Sensitive => False);
      SFR : SF_Record;
   begin
      if Source_Present (SN) then
         SFR := Source_File_Table.Element (SF_Table, SN);
      else
         Report_Std
           ("warning: "
            & Source_Name
            & " is not a source of argument project");
         Report_Std
           ("         cannot create stub");

         return "";
      end if;

      if SFR.Corresponding_Body = null then
         return "";
      else
         return SFR.Corresponding_Body.all;
      end if;
   end Get_Source_Body;

   -----------------------------
   --  Get_Source_Output_Dir  --
   -----------------------------
   function Get_Source_Output_Dir (Source_Name : String) return String
   is
      SN : constant String :=
        Normalize_Pathname
          (Name           => Source_Name,
           Case_Sensitive => False);
   begin
      return Source_File_Table.Element
        (SF_Table, SN).Test_Destination.all;
   end Get_Source_Output_Dir;

   ------------------------
   -- Get_Source_Project --
   ------------------------

   function Get_Source_Project_Name (Source_Name : String) return String
   is
      SN : constant String :=
        Normalize_Pathname
          (Name           => Source_Name,
           Case_Sensitive => False);
   begin
      return Source_File_Table.Element
        (SF_Table, SN).Project_Name.all;
   end Get_Source_Project_Name;

   -------------------------
   -- Get_Source_Stub_Dir --
   -------------------------

   function Get_Source_Stub_Dir (Source_Name : String) return String
   is
      SN : constant String :=
        Normalize_Pathname
          (Name           => Source_Name,
           Case_Sensitive => False);
   begin
      return Source_File_Table.Element
        (SF_Table, SN).Stub_Destination.all;
   end Get_Source_Stub_Dir;

   -------------------------------
   -- Get_Source_Stub_Data_Body --
   -------------------------------

   function Get_Source_Stub_Data_Body  (Source_Name : String) return String
   is
      SN : constant String :=
        Normalize_Pathname
          (Name           => Source_Name,
           Case_Sensitive => False);
   begin
      return Source_File_Table.Element
        (SF_Table, SN).Stub_Data_Base_Body.all;
   end Get_Source_Stub_Data_Body;

   -------------------------------
   -- Get_Source_Stub_Data_Spec --
   -------------------------------

   function Get_Source_Stub_Data_Spec  (Source_Name : String) return String
   is
      SN : constant String :=
        Normalize_Pathname
          (Name           => Source_Name,
           Case_Sensitive => False);
   begin
      return Source_File_Table.Element
        (SF_Table, SN).Stub_Data_Base_Spec.all;
   end Get_Source_Stub_Data_Spec;

   -------------------------
   --  Get_Source_Status  --
   -------------------------
   function Get_Source_Status (Source_Name : String) return SF_Status
   is
      SN : constant String :=
        Normalize_Pathname
          (Name           => Source_Name,
           Case_Sensitive => False);
   begin
      return Source_File_Table.Element
        (SF_Table, SN).Status;
   end Get_Source_Status;

   ----------------------------------
   --  Get_Source_Suffixless_Name  --
   ----------------------------------
   function Get_Source_Suffixless_Name (Source_Name : String) return String
   is
      SN : constant String :=
        Normalize_Pathname
          (Name           => Source_Name,
           Case_Sensitive => False);
   begin
      return Source_File_Table.Element
        (SF_Table, SN).Suffixless_Name.all;
   end Get_Source_Suffixless_Name;

   ------------------------------
   -- Initialize_Project_Table --
   ------------------------------

   procedure Initialize_Project_Table is
      Iter, Importing, Imported : Project_Iterator;
      P : Project_Type;

      Attr   : constant Attribute_Pkg_String := Build ("", "externally_built");
   begin
      Iter := Start (Source_Project_Tree.Root_Project);
      while Current (Iter) /= No_Project loop
         P := Current (Iter);

         declare
            PR : Project_Record;
         begin
            if Has_Attribute (P, Attr) then
               if To_Lower (Attribute_Value (P, Attr)) = "true" then
                  PR.Is_Externally_Built := True;
                  --  Nothing should be done for sources of externally built
                  --  projects, so no point in calculating obj dirs and so on.
                  goto Add_Project;
               end if;
            end if;

            PR.Path := new String'(P.Project_Path.Display_Full_Name);
            PR.Obj_Dir := new String'(P.Object_Dir.Display_Full_Name);
            if Is_Absolute_Path (Stub_Dir_Name.all) then
               PR.Stub_Dir := new String'
                 (Stub_Dir_Name.all
                  & Directory_Separator
                  & P.Name);
            else
               PR.Stub_Dir := new String'
                 (P.Object_Dir.Display_Full_Name
                  & Stub_Dir_Name.all
                  & Directory_Separator
                  & P.Name);
            end if;

            Imported := P.Start (Direct_Only => True);
            while Current (Imported) /= No_Project loop
               PR.Imported_List.Append (Current (Imported).Name);
               Next (Imported);
            end loop;

            Importing := P.Find_All_Projects_Importing (Direct_Only => True);
            while Current (Importing) /= No_Project loop
               PR.Importing_List.Append (Current (Importing).Name);
               Next (Importing);
            end loop;

            <<Add_Project>>

            PF_Table.Include (P.Name, PR);
         end;

         Next (Iter);
      end loop;
   end Initialize_Project_Table;

   ----------------------------------------
   -- Mark_Projects_With_Stubbed_Sources --
   ----------------------------------------

   procedure Mark_Projects_With_Stubbed_Sources is
      S_Cur : Source_File_Table.Cursor := SF_Table.First;
      PR : Project_Record;

      Processed_Projects : String_Set.Set;

      P_Cur : Project_File_Table.Cursor;

      procedure Process_Project (S : String);

      procedure Process_Project (S : String) is
         Cur : List_Of_Strings.Cursor;
         Local_PR : Project_Record;
      begin
         if Processed_Projects.Contains (S) then
            return;
         end if;

         Processed_Projects.Include (S);

         if PF_Table.Element (S).Is_Externally_Built then
            --  Nothing to do for those.
            return;
         end if;

         Local_PR := PF_Table.Element (S);
         Local_PR.Needed_For_Extention := True;
         PF_Table.Replace (S, Local_PR);

         Cur := Local_PR.Importing_List.First;
         while Cur /= List_Of_Strings.No_Element loop
            Process_Project (List_Of_Strings.Element (Cur));
            Next (Cur);
         end loop;

      end Process_Project;
   begin
      --  First, mark all projects that have sources that have been stubbed.
      while S_Cur /= Source_File_Table.No_Element loop
         if Source_File_Table.Element (S_Cur).Stub_Created then
            PR :=
              PF_Table.Element
                (Source_File_Table.Element (S_Cur).Project_Name.all);
            PR.Needed_For_Extention := True;
            PF_Table.Replace
              (Source_File_Table.Element (S_Cur).Project_Name.all,
               PR);
         end if;

         Next (S_Cur);
      end loop;

      --  Now we need to also mark all projects that are imported by any
      --  of already marked ones.

      P_Cur := PF_Table.First;
      while P_Cur /= Project_File_Table.No_Element loop
         if
           not Processed_Projects.Contains (Project_File_Table.Key (P_Cur))
           and then Project_File_Table.Element (P_Cur).Needed_For_Extention
         then
            Process_Project (Project_File_Table.Key (P_Cur));
         end if;

         Next (P_Cur);
      end loop;

   end Mark_Projects_With_Stubbed_Sources;

   -------------------------
   -- Mark_Sourse_Stubbed --
   -------------------------

   procedure Mark_Sourse_Stubbed (Source_Name : String) is
      SF_Rec : SF_Record;
      SN : constant String :=
        Normalize_Pathname
          (Name           => Source_Name,
           Case_Sensitive => False);
   begin
      SF_Rec := Source_File_Table.Element (SF_Table, SN);
      SF_Rec.Stub_Created := True;
      Replace (SF_Table, SN, SF_Rec);
   end Mark_Sourse_Stubbed;

   ---------------------------------
   --  Next_Non_Processed_Source  --
   ---------------------------------
   function Next_Non_Processed_Source return String is
      Cur : Source_File_Table.Cursor := Source_File_Table.No_Element;
   begin
      Reset_Source_Process_Iterator;

      loop
         if Cur = Source_File_Table.No_Element and then
           Source_File_Table.Element (SF_Process_Iterator).Status = Pending
         then
            Cur := SF_Process_Iterator;
         end if;
         if
           Source_File_Table.Element (SF_Process_Iterator).Status = Waiting
         then
            return Key (SF_Process_Iterator);
         end if;

         Next (SF_Process_Iterator);
         exit when SF_Process_Iterator = Source_File_Table.No_Element;
      end loop;

      if Cur /= Source_File_Table.No_Element then
         return Key (Cur);
      end if;

      return "";
   end Next_Non_Processed_Source;

   ----------------------------
   --  Next_Source_Location  --
   ----------------------------
   function Next_Source_Location return String is
      Cur : Source_File_Locations.Cursor;
   begin
      if SFL_Iterator /= Source_File_Locations.No_Element then
         Cur := SFL_Iterator;
         Source_File_Locations.Next (SFL_Iterator);
         return Source_File_Locations.Element (Cur);
      else
         return "";
      end if;
   end Next_Source_Location;

   ------------------------
   --  Next_Source_Name  --
   ------------------------
   function Next_Source_Name return String is
      Cur : Source_File_Table.Cursor;
   begin
      if SF_Access_Iterator /= Source_File_Table.No_Element then
         Cur := SF_Access_Iterator;
         Source_File_Table.Next (SF_Access_Iterator);
         return Key (Cur);
      else
         return "";
      end if;
   end Next_Source_Name;

   ----------------------
   -- Project_Extended --
   ----------------------

   function Project_Extended (Project_Name : String) return Boolean is
   begin
      return Project_File_Table.Element
        (PF_Table, Project_Name).Needed_For_Extention;
   end Project_Extended;

   -------------------
   -- Report_Source --
   -------------------
   procedure Report_Source (S : String) is
      Im : constant String := Natural'Image (Sources_Left - 1);
      SN : constant String :=
        Normalize_Pathname
          (Name           => S,
           Case_Sensitive => False);
   begin

      if not Source_Present (SN) then
         return;
      end if;

      if Progress_Indicator_Mode then
         declare
            Current : constant Integer := Total_Sources - Sources_Left + 1;
            Percent : String :=
              Integer'Image ((Current * 100) / Total_Sources);
         begin
            Percent (1) := '(';
            Info
              ("completed" & Integer'Image (Current) & " out of"
               & Integer'Image (Total_Sources) & " "
               & Percent & "%)...");
         end;
      end if;

      Sources_Left := Sources_Left - 1;

      if Verbose then
         Report_Std
           ("[" & Im (2 .. Im'Last) & "] " & Base_Name (SN));
      end if;
   end Report_Source;

   -------------------------------
   --  Reset_Location_Iterator  --
   -------------------------------
   procedure Reset_Location_Iterator is
   begin
      SFL_Iterator := First (SFL_Table);
   end Reset_Location_Iterator;

   -----------------------------
   --  Reset_Source_Iterator  --
   -----------------------------
   procedure Reset_Source_Iterator is
   begin
      SF_Access_Iterator := First (SF_Table);
   end Reset_Source_Iterator;

   -------------------------------------
   --  Reset_Source_Process_Iterator  --
   -------------------------------------
   procedure Reset_Source_Process_Iterator is
   begin
      SF_Process_Iterator := First (SF_Table);
   end Reset_Source_Process_Iterator;

   ------------------
   --  Set_Status  --
   ------------------

   procedure Set_Source_Status (Source_Name : String;
                                New_Status : SF_Status) is
      SF_Rec : SF_Record;
      SN : constant String :=
        Normalize_Pathname
          (Name           => Source_Name,
           Case_Sensitive => False);
   begin
      SF_Rec := Source_File_Table.Element (SF_Table, SN);
      SF_Rec.Status := New_Status;
      Replace (SF_Table, SN, SF_Rec);
   end Set_Source_Status;

   -------------------------
   --  Set_Subdir_Output  --
   -------------------------

   procedure Set_Subdir_Output is
      SF_Rec     : SF_Record;
      Tmp_Str    : String_Access;
      SF_Rec_Key : String_Access;
      Cur        : Source_File_Table.Cursor := SF_Table.First;
   begin

      loop
         exit when Cur = Source_File_Table.No_Element;

         SF_Rec := Source_File_Table.Element (Cur);
         SF_Rec_Key := new String'(Key (Cur));

         Tmp_Str := new String'(Dir_Name (SF_Rec.Full_Source_Name.all));

         SF_Rec.Test_Destination :=
           new String'(Tmp_Str.all          &
                       Test_Subdir_Name.all &
                       Directory_Separator);

         Replace (SF_Table, SF_Rec_Key.all, SF_Rec);

         Source_File_Table.Next (Cur);
         Free (SF_Rec_Key);
         Free (Tmp_Str);
      end loop;

   end Set_Subdir_Output;

   -------------------------
   --  Set_Separate_Root  --
   -------------------------
   procedure Set_Separate_Root (Max_Common_Root : String) is
      SF_Rec     : SF_Record;
      Tmp_Str    : String_Access;
      SF_Rec_Key : String_Access;
      Cur        : Source_File_Table.Cursor := SF_Table.First;

      Idx : Integer;
   begin

      loop
         exit when  Cur = Source_File_Table.No_Element;

         SF_Rec := Source_File_Table.Element (Cur);
         SF_Rec_Key := new String'(Key (Cur));
         Tmp_Str := new String'(Dir_Name (SF_Rec.Full_Source_Name.all));

         Idx := Max_Common_Root'Last + 1;

         SF_Rec.Test_Destination :=
           new String'(Separate_Root_Dir.all &
                       Directory_Separator   &
                       Tmp_Str.all (Idx .. Tmp_Str.all'Last));

         Replace (SF_Table, SF_Rec_Key.all, SF_Rec);

         Source_File_Table.Next (Cur);
         Free (SF_Rec_Key);
         Free (Tmp_Str);
      end loop;

   end Set_Separate_Root;

   -----------------------
   -- Set_Direct_Output --
   -----------------------

   procedure Set_Direct_Output is
      SF_Rec     : SF_Record;
      Tmp_Str    : String_Access;
      SF_Rec_Key : String_Access;
      Cur        : Source_File_Table.Cursor := SF_Table.First;

      Project : Project_Type;

      TD_Name : constant Virtual_File :=
        GNATCOLL.VFS.Create (+Test_Dir_Name.all);
   begin

      loop
         exit when  Cur = Source_File_Table.No_Element;

         SF_Rec := Source_File_Table.Element (Cur);
         SF_Rec_Key := new String'(Key (Cur));

         if TD_Name.Is_Absolute_Path then
            SF_Rec.Test_Destination := new String'(Test_Dir_Name.all);
         else
            Project := GNATCOLL.Projects.Project (Info
              (Source_Project_Tree,
               GNATCOLL.VFS.Create (+SF_Rec.Full_Source_Name.all)));
            SF_Rec.Test_Destination := new String'
              (Project.Object_Dir.Display_Full_Name & Test_Dir_Name.all);
         end if;

         Replace (SF_Table, SF_Rec_Key.all, SF_Rec);

         Source_File_Table.Next (Cur);
         Free (SF_Rec_Key);
         Free (Tmp_Str);
      end loop;
   end Set_Direct_Output;

   ----------------------------
   -- Set_Direct_Stub_Output --
   ----------------------------

   procedure Set_Direct_Stub_Output is
      SF_Rec     : SF_Record;
      Tmp_Str    : String_Access;
      SF_Rec_Key : String_Access;
      Cur        : Source_File_Table.Cursor := SF_Table.First;

      Project : Project_Type;

      TD_Name : constant Virtual_File :=
        GNATCOLL.VFS.Create (+Stub_Dir_Name.all);
   begin

      loop
         exit when  Cur = Source_File_Table.No_Element;

         SF_Rec := Source_File_Table.Element (Cur);
         SF_Rec_Key := new String'(Key (Cur));

         if TD_Name.Is_Absolute_Path then
            SF_Rec.Stub_Destination := new String'(Stub_Dir_Name.all);
         else
            Project := GNATCOLL.Projects.Project (Info
              (Source_Project_Tree,
               GNATCOLL.VFS.Create (+SF_Rec.Full_Source_Name.all)));
            --  Better use subdirs to separate stubs from different projects.
            SF_Rec.Stub_Destination := new String'
              (Project.Object_Dir.Display_Full_Name
               & Stub_Dir_Name.all
               & Directory_Separator
               & Project.Name);
         end if;

         Replace (SF_Table, SF_Rec_Key.all, SF_Rec);

         Source_File_Table.Next (Cur);
         Free (SF_Rec_Key);
         Free (Tmp_Str);
      end loop;
   end Set_Direct_Stub_Output;

   --------------------
   -- Set_Output_Dir --
   --------------------

   procedure Set_Output_Dir (Source_Name : String; Output_Dir : String) is
      SF_Rec : SF_Record;
      SN : constant String :=
        Normalize_Pathname
          (Name           => Source_Name,
           Case_Sensitive => False);
   begin
      SF_Rec := SF_Table.Element (SN);
      SF_Rec.Test_Destination := new String'(Output_Dir);
      Replace (SF_Table, SN, SF_Rec);
   end Set_Output_Dir;

   ---------------------------
   --  Set_Parallel_Output  --
   ---------------------------

   procedure Set_Parallel_Output is
      SF_Rec     : SF_Record;
      Tmp_Str    : String_Access;
      SF_Rec_Key : String_Access;
      Cur        : Source_File_Table.Cursor := SF_Table.First;

      Idx_F : Integer;
   begin

      loop
         exit when Cur = Source_File_Table.No_Element;

         SF_Rec := Source_File_Table.Element (Cur);
         SF_Rec_Key := new String'(Key (Cur));

         Tmp_Str := new String'(Dir_Name (SF_Rec.Full_Source_Name.all));

         Idx_F := Tmp_Str.all'First;
         for Idx_L in reverse Idx_F .. Tmp_Str.all'Last - 1 loop
            if Tmp_Str.all (Idx_L) = Directory_Separator then
               SF_Rec.Test_Destination :=
                 new String'(Tmp_Str.all (Idx_F .. Idx_L)                    &
                             Test_Dir_Prefix.all                             &
                             Tmp_Str.all (Idx_L + 1 .. Tmp_Str.all'Last - 1) &
                             Test_Dir_Suffix.all);
               exit;
            end if;
         end loop;

         Replace (SF_Table, SF_Rec_Key.all, SF_Rec);

         Source_File_Table.Next (Cur);
         Free (SF_Rec_Key);
         Free (Tmp_Str);
      end loop;

   end Set_Parallel_Output;

   ----------------------
   --  Source_Present  --
   ----------------------
   function Source_Present (Source_Name : String) return Boolean is
      SN : constant String :=
        Normalize_Pathname
          (Name           => Source_Name,
           Case_Sensitive => False);
   begin
      return Contains (SF_Table, SN);
   end Source_Present;

   --------------------
   -- Source_Stubbed --
   --------------------

   function Source_Stubbed (Source_Name : String) return Boolean is
      SN : constant String :=
        Normalize_Pathname
          (Name           => Source_Name,
           Case_Sensitive => False);
   begin
      return Source_File_Table.Element
        (SF_Table, SN).Stub_Created;
   end Source_Stubbed;

end GNATtest.Skeleton.Source_Table;
