------------------------------------------------------------------------------
--                                                                          --
--                           GNATELIM COMPONENTS                            --
--                                                                          --
--                     G N A T E L I M .C L O S U R E                       --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                    Copyright (C) 2009-2011, AdaCore                      --
--                                                                          --
-- GNATELIM  is  free software;  you can  redistribute it and/or  modify it --
-- under the terms of the  GNU  General Public License  as published by the --
-- Free Software Foundation; either version 2 or (at your option) any later --
-- version. GNATELIM is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY; without even the implied warranty of  MERCHANTABI- --
-- LITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public Li- --
-- cense 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.                                              --
--                                                                          --
-- The original version  of  Gnatelim  was developed by  Alain  Le  Guennec --
-- It is now maintained by AdaCore (http://www.adacore.com)                 --
--                                                                          --
------------------------------------------------------------------------------

--  This package contains routines that compute (and process, if needed)
--  closures of the main unit.

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

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

with Asis.Implementation;

with ASIS_UL.Common;                  use ASIS_UL.Common;
with ASIS_UL.Compiler_Options;        use ASIS_UL.Compiler_Options;
with ASIS_UL.Debug;                   use ASIS_UL.Debug;
with ASIS_UL.Environment;             use ASIS_UL.Environment;
with ASIS_UL.Options;                 use ASIS_UL.Options;
with ASIS_UL.Output;                  use ASIS_UL.Output;
with ASIS_UL.Source_Table;            use ASIS_UL.Source_Table;
with ASIS_UL.Source_Table.Processing; use ASIS_UL.Source_Table.Processing;

with Table;

package body Gnatelim.Closure is

   Program_Output_File : File_Type;
   --  File used to redirect the program output into.

   Max_Str_Len : constant Positive := 1024;
   Str_Buff    : String (1 .. Max_Str_Len);
   Str_Len     : Natural;

   package Tool_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           => "Tool options");
   --  Used to compose a list of switches to call a tool

   -----------------------
   -- Local subprograms --
   -----------------------

   procedure Get_Next_Source (Source : in out String_Access);
   --  Computes the name of the next source to compile using the call to
   --  'gnatmake -n ...' with the mame of the main unit as the argument. If
   --  there is no source to compile any more, returns null;

   procedure Read_Sources_From_Binder_Output (Success : in out Boolean);
   --  Calls the binder for the main unit with '-R' option to get the list of
   --  source making up the main unit closure. If this attempt is successful,
   --  tries to read these sources into the source file table. Set the Success
   --  parameter ON if all these actions are successful, othertwise success
   --  is set to False.

   ---------------------
   -- Get_Next_Source --
   ---------------------

   procedure Get_Next_Source (Source : in out String_Access) is
   begin
      Free (Source);

      ASIS_UL.Output.Error
        ("gnatelim can only be called after a full successful build");
      raise ASIS_UL.Common.Fatal_Error;
   end Get_Next_Source;

   ---------------------
   -- Process_Closure --
   ---------------------

   procedure Process_Closure is
      Next_Source : String_Access;

      Tmp_Success : Boolean;
   begin
      --  Here we have to repeat manualy the general scheme of source
      --  processing from ASIS_UL.Source_Table.Processing.Process_Sources,
      --  but we have to add sources incrementally, after getting them from
      --  gnatmake

      Asis.Implementation.Initialize ("-k -ws -asis05");

      Next_Source := new String'(Main_Subprogram_Name.all);

      while Next_Source /= null loop

         Add_Source_To_Process
           (Fname              => Next_Source.all,
            Duplication_Report => False,
            No_Argument        => Tmp_Success);

         Process_Source
           (SF                 => Last_Source,
            Need_Semantic_Info => True,
            Add_Needed_Sources => True,
            Keep_ALI_Files     => True);

         Get_Next_Source (Next_Source);

      end loop;

   end Process_Closure;

   -------------------------------------
   -- Read_Sources_From_Binder_Output --
   -------------------------------------

   procedure Read_Sources_From_Binder_Output (Success : in out Boolean) is
      Command : String_Access;
      Arg     : String_Access;
      Tmp     : String_Access;

      Dot_Idx : Natural := 0;

      Return_Code : Integer;

      Bind_Out_File_Name : constant String := Tool_Temp_Dir.all & ".bind_out";
      Tmp_Success        : Boolean;
      pragma Unreferenced (Tmp_Success);

   begin
      --  Define the name of the command to call:
      Arg     := Locate_Exec_On_Path (Gnatmake_To_Call.all);
      Dot_Idx := Index (Arg.all, "make", Backward) - 1;
      Command := new String'(Arg.all (Arg'First .. Dot_Idx));

      if not Use_Project_File then
         --  In case if a project file is used we call
         --    'gnat bind -Pproject ...'
         --  otherwise we call 'gnatbind'
         Free (Arg);
         Arg := new String'(Command.all & "bind");
         Free (Command);
         Command := new String'(Arg.all);
      end if;

      Free (Arg);

      --  Compose binder parameters
      Tool_Switches.Init;

      if Use_Project_File then
         Tool_Switches.Append (new String'("bind"));
         Tool_Switches.Append (new String'("-P"));
         Tool_Switches.Append (new String'(Project_File.all));
      end if;

      if Custom_RTS /= null then
         Tool_Switches.Append (new String'("--RTS=" & Custom_RTS.all));
      end if;

      Tool_Switches.Append (new String'("-R"));

      Tool_Switches.Append (new String'("-ws"));

      --  If we are not using a project file, we have to provide the compiler
      --  -I options, if any. When doing this, we also create a search path
      --  for locating sources that we expect to get from the binder:

      --  Set binder argument:

      if Use_Project_File then
         Arg := new String'(Base_Name (Main_Subprogram_Name.all));
      else
         Arg := new String'(Main_Subprogram_Name.all);
      end if;

      for J in reverse Arg'Range loop

         if Arg (J) = '.' then
            Dot_Idx := J - 1;
            exit;
         elsif Arg (J) = Directory_Separator then
            exit;
         end if;

      end loop;

      if Dot_Idx > 0 then
         Tmp := new String'(Arg.all (Arg'First .. Dot_Idx));
         Free (Arg);
         Arg := new String'(Tmp.all);
         Free (Tmp);
      end if;

      --  Call binder

      if Debug_Flag_C then
         Info_No_EOL (Command.all);
         Info_No_EOL (" ");

         for J in 1 .. Tool_Switches.Last loop
            Info_No_EOL (Tool_Switches.Table (J).all);
            Info_No_EOL (" ");
         end loop;

         Info (Arg.all);

      end if;

      Spawn
        (Program_Name => Command.all,
         Args         => String_List
           (Tool_Switches.Table (1 .. Tool_Switches.Last)) &
            Arg,
         Output_File  => Bind_Out_File_Name,
         Success      => Success,
         Return_Code  => Return_Code,
         Err_To_Out   => True);

      --  Read source files

      if Success and then Return_Code = 0 then

         Open (Program_Output_File, In_File, Bind_Out_File_Name);

         Skip_Line (Program_Output_File);    --  ???
         Skip_Line (Program_Output_File);    --  ???

         while not  End_Of_File (Program_Output_File) loop
            Get_Line (Program_Output_File, Str_Buff, Str_Len);

            Add_Source_To_Process
              (Fname              => Trim (Str_Buff (1 .. Str_Len), Both),
               Duplication_Report => False,
               No_Argument        => Tmp_Success);

         end loop;

         Close (Program_Output_File);

         Total_Sources := Natural (Last_Source);
         Sources_Left  := Total_Sources;
      else
         Success := False;
      end if;

      --  Clean-up
      Free (Command);
      Free (Arg);

      if not (Debug_Mode or else Debug_Flag_N) then
         Delete_File (Bind_Out_File_Name, Tmp_Success);
      end if;

   exception
      when others =>
         if Is_Open (Program_Output_File) then
            Close (Program_Output_File);
         end if;

      if not (Debug_Mode or else Debug_Flag_N) then
         Delete_File (Bind_Out_File_Name, Tmp_Success);
      end if;

         raise;
   end Read_Sources_From_Binder_Output;

   ---------------------------------
   -- Try_Get_Sources_From_Binder --
   ---------------------------------

   procedure Try_Get_Sources_From_Binder (Success : in out Boolean) is
   begin
      Change_Dir (Tool_Current_Dir);

      Read_Sources_From_Binder_Output (Success);

      Change_Dir (Tool_Temp_Dir.all);
   end Try_Get_Sources_From_Binder;

end Gnatelim.Closure;
