------------------------------------------------------------------------------
--                                                                          --
--                     ASIS UTILITY LIBRARY COMPONENTS                      --
--                                                                          --
--             A S I S _ U L . C O M P I L E R _ O P T I O N S              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2004-2010, AdaCore                     --
--                                                                          --
-- Asis Utility Library (ASIS UL) 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.  ASIS UL  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.                         --
--                                                                          --
-- ASIS UL is maintained by AdaCore (http://www.adacore.com).               --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Text_IO;       use Ada.Text_IO;

with GNAT.Command_Line; use GNAT.Command_Line;

with ASIS_UL.Common;    use ASIS_UL.Common;
with ASIS_UL.Debug;     use ASIS_UL.Debug;
with ASIS_UL.Options;
with ASIS_UL.Output;    use ASIS_UL.Output;

with Table;

package body ASIS_UL.Compiler_Options is

   Iterator_Count : Natural;
   --  For Source search path iterator

   package Compiler_Switches is new Table.Table (
      Table_Component_Type => String_Access,
      Table_Index_Type     => Natural,
      Table_Low_Bound      => 1,
      Table_Initial        => 20,
      Table_Increment      => 100,
      Table_Name           => "Compiler options");

   package Compiler_Switches_Filtered is new Table.Table (
      Table_Component_Type => String_Access,
      Table_Index_Type     => Natural,
      Table_Low_Bound      => 1,
      Table_Initial        => 20,
      Table_Increment      => 100,
      Table_Name           => "Compiler options");
   --  This table is supposed to keep all the specified compiler switches
   --  except -I<dir> (-I- is stored here, if specified)

   package I_Options is new Table.Table (
      Table_Component_Type => String_Access,
      Table_Index_Type     => Natural,
      Table_Low_Bound      => 1,
      Table_Initial        => 20,
      Table_Increment      => 100,
      Table_Name           => "Source search path options");

   ---------------------
   -- Next_Source_Dir --
   ---------------------

   function Next_Source_Dir return String is
      Result : constant String :=
        Compiler_Switches.Table (Iterator_Count).all;
   begin
      --  We have to strip away "-I"
      return Result (Result'First + 2 .. Result'Last);
   end Next_Source_Dir;

   ------------------------
   -- No_More_Source_Dir --
   ------------------------

   function No_More_Source_Dir return Boolean is
      First_Idx : Positive;
      Result    : Boolean := True;
   begin

      for J in Iterator_Count + 1 .. Compiler_Switches.Last loop
         First_Idx := Compiler_Switches.Table (J)'First;

         if Compiler_Switches.Table (J)'Length >= 3
           and then
            Compiler_Switches.Table (J) (First_Idx .. First_Idx + 1) = "-I"
           and then
            Compiler_Switches.Table (J) (First_Idx + 2) /= '-'
         then
            Iterator_Count := J;
            Result := False;
            exit;
         end if;

      end loop;

      return Result;
   end No_More_Source_Dir;

   ----------------------------------
   -- Process_ADA_PRJ_INCLUDE_FILE --
   ----------------------------------

   procedure Process_ADA_PRJ_INCLUDE_FILE is
      ADA_PRJ_INCLUDE_FILE_Name : String_Access :=
        Getenv ("ADA_PRJ_INCLUDE_FILE");

      ADA_PRJ_INCLUDE_FILE_File : File_Type;

      Next_Dir     : String (1 .. 1024);
      Next_Dir_Len : Natural;
   begin

      if not Is_Regular_File (ADA_PRJ_INCLUDE_FILE_Name.all) then
         return;
      end if;

      Open (File => ADA_PRJ_INCLUDE_FILE_File,
            Mode => In_File,
            Name => ADA_PRJ_INCLUDE_FILE_Name.all);

      while not End_Of_File (ADA_PRJ_INCLUDE_FILE_File) loop
         Get_Line (File => ADA_PRJ_INCLUDE_FILE_File,
                   Item => Next_Dir,
                   Last => Next_Dir_Len);

         Store_I_Option (Next_Dir (1 .. Next_Dir_Len));
      end loop;

      Close (ADA_PRJ_INCLUDE_FILE_File);
      Free (ADA_PRJ_INCLUDE_FILE_Name);
   end Process_ADA_PRJ_INCLUDE_FILE;

   ---------------------------
   -- Process_cargs_Section --
   ---------------------------

   procedure Process_cargs_Section (No_Preprocessing : Boolean := False) is
   begin

      Goto_Section ("cargs");

      loop
         case
            GNAT.Command_Line.Getopt
              ("* -RTS= I: gnatec! gnatep! gnateD? gnat05")
         is
            when ASCII.NUL =>
               exit;

            when 'I' | 'g' =>

               if Full_Switch = "gnatec" then
                  Store_GNAT_Option_With_Path (Full_Switch, Parameter);
               elsif Full_Switch = "I" then
                  Store_I_Option (Parameter);
               elsif Full_Switch = "gnatep"
                   or else
                     Full_Switch = "gnateD"
               then

                  if No_Preprocessing then
                     Error ("cannot preprocess argument file, " &
                            "do preprocessing as a separate step");
                     raise Parameter_Error;
                  else

                     if Full_Switch = "gnatep" then
                        Store_GNAT_Option_With_Path (Full_Switch, Parameter);
                     else
                        Store_Option ('-' & Full_Switch & Parameter);
                     end if;

                  end if;

               elsif Full_Switch = "gnat05" then
                  Store_Option ('-' & Full_Switch);
                  ASIS_UL.Options.ASIS_2005_Mode_Explicitely_Set := True;
               end if;

            when '-' =>

               if Full_Switch = "-RTS" then
                  Custom_RTS := new String'(Parameter);
                  Store_Option ("-" & Full_Switch & "=" & Parameter);
               end if;

            when others =>
               Store_Option (Full_Switch);
         end case;
      end loop;

   end Process_cargs_Section;

   --------------------------------
   -- Reset_Search_Path_Iterator --
   --------------------------------

   procedure Reset_Search_Path_Iterator is
   begin
      Iterator_Count := 0;
   end Reset_Search_Path_Iterator;

   ------------------
   -- Set_Arg_List --
   ------------------

   procedure Set_Arg_List is
      Ada_Include_Path_Value     : String_Access := new String'("");
      New_Ada_Include_Path_Value : String_Access;
      Tmp                        : String_Access;
   begin
      Compiler_Switches_Filtered.Init;

      for J in 1 .. Compiler_Switches.Last loop
         if not (Compiler_Switches.Table (J)'Length >= 3
              and then
                 Compiler_Switches.Table (J)
                   (Compiler_Switches.Table (J)'First ..
                    Compiler_Switches.Table (J)'First + 1) = "-I"
              and then
                 Compiler_Switches.Table (J)
                   (Compiler_Switches.Table (J)'First + 2) /= '-')
         then
            Compiler_Switches_Filtered.Append (Compiler_Switches.Table (J));
         end if;
      end loop;

      Arg_List := new Argument_List'
        (String_List (Compiler_Switches_Filtered.Table
           (1 .. Compiler_Switches_Filtered.Last)));

      if Source_Search_Path /= null
        and then
         Source_Search_Path.all /= ""
      then
         Ada_Include_Path_Value := new String'(Source_Search_Path.all);
      end if;

      Tmp := Getenv ("ADA_INCLUDE_PATH");

      if Tmp /= null then
         if Ada_Include_Path_Value.all = "" then
            Free (Ada_Include_Path_Value);
            Ada_Include_Path_Value := new String'(Tmp.all);
         else
            New_Ada_Include_Path_Value :=
              new String'(Ada_Include_Path_Value.all &
                          Path_Separator              &
                          Tmp.all);

            Free (Ada_Include_Path_Value);
            Ada_Include_Path_Value :=
              new String'(New_Ada_Include_Path_Value.all);
         end if;

         Free (New_Ada_Include_Path_Value);
         Free (Tmp);
      end if;

      if Debug_Flag_S then
         Info ("***ADA_INCLUDE_PATH***");

         if Ada_Include_Path_Value.all = "" then
            Info ("...empty");
         else

            declare
               First_Idx : Natural;
               Last_Idx  : Natural;
               SSP_Last  : constant Positive := Ada_Include_Path_Value'Last;
            begin
               First_Idx := Ada_Include_Path_Value'First;
               Last_Idx  := Index
                              (Ada_Include_Path_Value.all,
                               (1 => Path_Separator));

               while Last_Idx /= 0 loop
                  Info (Ada_Include_Path_Value (First_Idx .. Last_Idx - 1));
                  First_Idx := Last_Idx + 1;
                  Last_Idx  :=
                    Index (Ada_Include_Path_Value (First_Idx .. SSP_Last),
                           (1 => Path_Separator));
               end loop;

               Info (Ada_Include_Path_Value (First_Idx .. SSP_Last));
            end;
         end if;

         Info ("***Set as ADA_INCLUDE_PATH***");

         if Ada_Include_Path_Value.all = "" then
            Info ("...empty value...");
         else
            Info (Ada_Include_Path_Value.all);
         end if;

      end if;

      Setenv
        (Name  => "ADA_INCLUDE_PATH",
         Value => Ada_Include_Path_Value.all);

      Free (Ada_Include_Path_Value);
   end Set_Arg_List;

   ----------------------------
   -- Set_Source_Search_Path --
   ----------------------------

   procedure Set_Source_Search_Path is
      Tmp : String_Access;
   begin

      for J in 1 .. Compiler_Switches.Last loop

         if Compiler_Switches.Table (J)'Length >= 3
          and then
            Compiler_Switches.Table (J)
              (Compiler_Switches.Table (J)'First ..
               Compiler_Switches.Table (J)'First + 1) = "-I"
         then

            I_Options.Append (new String'(Compiler_Switches.Table (J).all));

            if Source_Search_Path = null then
               Source_Search_Path := new String'
                 (Compiler_Switches.Table (J)
                   (Compiler_Switches.Table (J)'First + 2 ..
                    Compiler_Switches.Table (J)'Last));
            else
               Tmp := new String'(Source_Search_Path.all);
               Free (Source_Search_Path);
               Source_Search_Path := new String'
                 (Tmp.all & Path_Separator & Compiler_Switches.Table (J)
                   (Compiler_Switches.Table (J)'First + 2 ..
                    Compiler_Switches.Table (J)'Last));
               Free (Tmp);
            end if;

         end if;

      end loop;

      if Look_Into_Current_Dir then
         if Source_Search_Path = null then
            Source_Search_Path := new String'(".");
         else
            Tmp := new String'(Source_Search_Path.all);
            Free (Source_Search_Path);
            Source_Search_Path := new String'("." & Path_Separator & Tmp.all);
            Free (Tmp);
         end if;
      else
         I_Options.Append (new String'("-I-"));
      end if;

      Tool_I_Options := new Argument_List'
        (String_List (I_Options.Table (1 .. I_Options.Last)));

      if Debug_Flag_S then
         Info ("***Source search path***");

         declare
            First_Idx : Natural;
            Last_Idx  : Natural;
            SSP_Last  : constant Positive := Source_Search_Path'Last;
         begin
            First_Idx := Source_Search_Path'First;
            Last_Idx  := Index (Source_Search_Path.all, (1 => Path_Separator));

            while Last_Idx /= 0 loop
               Info (Source_Search_Path (First_Idx .. Last_Idx - 1));
               First_Idx := Last_Idx + 1;
               Last_Idx  :=
                 Index (Source_Search_Path (First_Idx .. SSP_Last),
                        (1 => Path_Separator));
            end loop;

            Info (Source_Search_Path (First_Idx .. SSP_Last));
         end;

         Info ("***Tool -I options***");

         for J in Tool_I_Options'Range loop
            Info (Tool_I_Options (J).all);
         end loop;
      end if;

   end Set_Source_Search_Path;

   --------------------
   -- Store_I_Option --
   --------------------

   procedure Store_I_Option (Path : String) is
   begin

      if Path = "-" then
         Compiler_Switches.Append (new String'("-I-"));
         Look_Into_Current_Dir := False;
      else
         Compiler_Switches.Append
           (new String'("-I" & Normalize_Pathname (Path)));
      end if;

   end Store_I_Option;

   -----------------------
   -- Store_Path_Option --
   -----------------------

   procedure Store_Path_Option
     (Switch : String;
      Path   : String)
   is
   begin
      Compiler_Switches.Append
        (new String'(Switch & Normalize_Pathname (Path)));
   end Store_Path_Option;

   ---------------------------------
   -- Store_GNAT_Option_With_Path --
   ---------------------------------

   procedure Store_GNAT_Option_With_Path (Option : String; Path : String) is
      First_Idx : Natural          := Path'First;
      Last_Idx  : constant Natural := Path'Last;
   begin
      if Path (First_Idx) = '=' then
         First_Idx := First_Idx + 1;
      end if;

      Compiler_Switches.Append
        (new String'
           ('-' & Option & Normalize_Pathname (Path (First_Idx .. Last_Idx))));

   end Store_GNAT_Option_With_Path;

   ------------------
   -- Store_Option --
   ------------------

   procedure Store_Option (Switch : String) is
   begin
      Compiler_Switches.Append (new String'(Switch));
   end Store_Option;

end ASIS_UL.Compiler_Options;
