------------------------------------------------------------------------------
--                                                                          --
--                     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-2014, 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 3, 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 --
-- COPYING3. If not,  go to http://www.gnu.org/licenses for a complete copy --
-- of the license.                                                          --
--                                                                          --
-- ASIS UL is maintained by AdaCore (http://www.adacore.com).               --
--                                                                          --
------------------------------------------------------------------------------

pragma Ada_2012;

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

with A4G.A_Types;       use A4G.A_Types;

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

with Opt;               use all type Opt.Ada_Version_Type;
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 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");

   -------------------------------
   -- Add_To_Source_Search_Path --
   -------------------------------

   procedure Add_To_Source_Search_Path (Dir : String) is
      Tmp : String_Access;
   begin

      if Source_Search_Path = null then
         Source_Search_Path := new String'(Dir);
      else
         Tmp := new String'(Source_Search_Path.all);
         Free (Source_Search_Path);
         Source_Search_Path :=
           new String'(Tmp.all & ASIS_Path_Separator & Dir);
         Free (Tmp);
      end if;

   end Add_To_Source_Search_Path;

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

   ---------
   -- PAL --
   ----------

   procedure PAL is
   begin
      if Arg_List = null then
         Info ("Arg_List is empty");
      else
         Info_No_EOL ("Arg_List is:");

         for J in Arg_List'Range loop
            Info_No_EOL (" " & Arg_List (J).all);
         end loop;

         Info ("");
      end if;
   end PAL;

   ----------------------------------
   -- 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;
      Tmp          : String_Access;
   begin
      I_Options_Specified := I_Options.Last >= I_Options.First;

      if not Is_Regular_File (ADA_PRJ_INCLUDE_FILE_Name.all) then
         Need_Tmp_ADA_PRJ_INCLUDE_FILE := True;
         return;
      end if;

      ADA_PRJ_INCLUDE_FILE_Full_Name :=
        new String'(Normalize_Pathname (ADA_PRJ_INCLUDE_FILE_Name.all));

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

         if Source_Search_Path = null then
            Source_Search_Path := new String'
              (Normalize_Pathname (Next_Dir (1 .. Next_Dir_Len)));
         else
            Tmp := new String'(Source_Search_Path.all);
            Free (Source_Search_Path);
            Source_Search_Path := new String'
              (Tmp.all & ASIS_Path_Separator &
               Normalize_Pathname (Next_Dir (1 .. Next_Dir_Len)));
            Free (Tmp);
         end if;

         --  We append these directories to the directories specified by
         --  '-Idir' options in case if we have to rewrite the file to add
         --  directories set by '-Idir' to it. As the result of this appending,
         --  I_Options will contain all the directories that should be in the
         --  source search path for the compiler/binder calls.
         I_Options.Append
           (new String'(Normalize_Pathname (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
     (Parser           : Opt_Parser := Command_Line_Parser;
      No_Preprocessing : Boolean    := False)
   is
      Idx : Natural;
   begin

      Goto_Section ("cargs", Parser => Parser);

      loop
         case
            GNAT.Command_Line.Getopt
             ("* -RTS= I: gnatec! gnatep! gnateD? " &

              --  switches to be ignored:

              "gnatQ gnatG gnatd! "                 &
              "gnat83 "                             &
              "gnat95 "                             &
              "gnat05 gnat2005 "                    &
              "gnat12 gnat2012 "                    &
              "gnatD gnats",
               Parser => Parser)
         is
            when ASCII.NUL =>
               exit;

            when 'I' | 'g' =>

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

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

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

                  end if;

               elsif Full_Switch (Parser => Parser) = "gnat83" then
                  Store_Option ('-' & Full_Switch (Parser => Parser));
                  Opt.Ada_Version     := Ada_83;
                  Ada_Version_Changed := True;
               elsif Full_Switch (Parser => Parser) = "gnat95" then
                  Store_Option ('-' & Full_Switch (Parser => Parser));
                  Opt.Ada_Version     := Ada_95;
                  Ada_Version_Changed := True;
               elsif Full_Switch (Parser => Parser) in
                       "gnat05" | "gnat2005"
               then
                  Store_Option ('-' & Full_Switch (Parser => Parser));
                  Opt.Ada_Version     := Ada_2005;
                  Ada_Version_Changed := True;
               elsif Full_Switch (Parser => Parser) in
                       "gnat12" | "gnat2012"
               then
                  Store_Option ('-' & Full_Switch (Parser => Parser));
                  Opt.Ada_Version     := Ada_2012;
                  Ada_Version_Changed := True;

               elsif Full_Switch (Parser => Parser) = "gnatD"
                 or else
                     Full_Switch (Parser => Parser) = "gnatQ"
                 or else
                     Full_Switch (Parser => Parser) = "gnatG"
                 or else
                     Full_Switch (Parser => Parser) = "gnats"
               then
                  null;
                  --  Just ignore this switch

               elsif Full_Switch (Parser => Parser) = "gnatd" then
                  declare
                     Param : constant String :=
                       Parameter (Parser => Parser);
                     Param_First : constant Natural := Param'First;
                  begin
                     --  We may need '-gnatdm' to allow VMS-specific constructs
                     --  on another platform
                     Idx := Index (Param, "m");

                     if Idx /= 0
                       and then
                        (Idx = Param_First
                        or else
                         Param (Idx - 1) /= '.')
                     then
                        Store_Option ("-gnatdm");
                     end if;
                  end;
               end if;

            when '-' =>

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

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

      Process_ADA_PRJ_INCLUDE_FILE;
      Set_Arg_List;

   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
   begin
      Arg_List := new Argument_List'
        (String_List (Compiler_Switches.Table (1 .. Compiler_Switches.Last)));
   end Set_Arg_List;

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

   procedure Store_I_Option (Path : String) is
   begin

      if Path = "-" then
         Compiler_Switches.Append (new String'("-I-"));
      else
         I_Options.Append
           (new String'(Normalize_Pathname (Path)));
      end if;

   end Store_I_Option;

   ---------------------
   -- Store_I_Options --
   ---------------------

   procedure Store_I_Options is
      ADA_PRJ_INCLUDE_FILE_File : File_Type;
      Tmp                       : String_Access;
   begin
      if I_Options_Specified then

         if Add_I_Options_To_Source_Search_Path then
            Free (Source_Search_Path);
         end if;

         if ADA_PRJ_INCLUDE_FILE_Full_Name /= null then
            Open (File => ADA_PRJ_INCLUDE_FILE_File,
                  Mode => Out_File,
                  Name => ADA_PRJ_INCLUDE_FILE_Full_Name.all);
         else
            ADA_PRJ_INCLUDE_FILE_Full_Name :=
              new String'(Normalize_Pathname ("tmp_ADA_PRJ_INCLUDE_FILE"));
            Create (File => ADA_PRJ_INCLUDE_FILE_File,
                    Mode => Out_File,
                    Name => ADA_PRJ_INCLUDE_FILE_Full_Name.all);

            Setenv
              ("ADA_PRJ_INCLUDE_FILE",
               ADA_PRJ_INCLUDE_FILE_Full_Name.all);
         end if;

         for J in I_Options.First .. I_Options.Last loop
            Put_Line
              (ADA_PRJ_INCLUDE_FILE_File,
               I_Options.Table (J).all);

            if Add_I_Options_To_Source_Search_Path then
               if Source_Search_Path = null then
                  Source_Search_Path := new String'(I_Options.Table (J).all);
               else
                  Tmp := new String'(Source_Search_Path.all);
                  Free (Source_Search_Path);
                  Source_Search_Path :=
                    new String'(Tmp.all & ASIS_Path_Separator &
                                I_Options.Table (J).all);
                  Free (Tmp);
               end if;
            end if;

         end loop;

         Close (ADA_PRJ_INCLUDE_FILE_File);

      end if;

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

         if Source_Search_Path /= null then
            Info (">>" & Source_Search_Path.all & "<<");
         else
            Info ("... is not set");
         end if;

      end if;

      if Debug_Flag_C then
         Info ("***ADA_PRJ_INCLUDE_FILE***");
         Tmp := Getenv ("ADA_PRJ_INCLUDE_FILE");

         if Is_Regular_File (Tmp.all) then
            declare
               Next_Dir     : String (1 .. 1024);
               Next_Dir_Len : Natural;
            begin
               Info ("File name >>" & Tmp.all & "<<");

               Open (File => ADA_PRJ_INCLUDE_FILE_File,
                     Mode => In_File,
                     Name => ADA_PRJ_INCLUDE_FILE_Full_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);

                  Info (">>" & Next_Dir (1 .. Next_Dir_Len) & "<<");
               end loop;

               Close (ADA_PRJ_INCLUDE_FILE_File);
            end;
         else
            Info ("  ... is not set");
         end if;

         Free (Tmp);
      end if;

   end Store_I_Options;

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