------------------------------------------------------------------------------
--                                                                          --
--                           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.Common;           use GNATtest.Common;
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;

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
   end record;

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

   package Source_File_Locations is new
     Ada.Containers.Indefinite_Ordered_Sets (String);

   use Source_File_Table;
   use Source_File_Locations;

   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.

   -----------------------------
   --  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;

--        Insert (SF_Table, Short_Source_Name_String.all, New_SF_Record);
      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;

   ----------------
   --  Is_Empty  --
   ----------------
   function SF_Table_Empty return Boolean is
   begin
      return Is_Empty (SF_Table);
   end SF_Table_Empty;

   -----------------------------
   --  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_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_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;

   ---------------------------------
   --  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;

   -------------------
   -- 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)));
            SF_Rec.Stub_Destination := new String'
              (Project.Object_Dir.Display_Full_Name & Stub_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_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;

end GNATtest.Skeleton.Source_Table;
