------------------------------------------------------------------------------
--                                                                          --
--                     ASIS UTILITY LIBRARY COMPONENTS                      --
--                                                                          --
--      A S I S _ U L . S O U R C E _ T A B L E . P R O C E S S I N G       --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2004-2007, 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).               --
--                                                                          --
------------------------------------------------------------------------------

pragma Ada_2005;  --  To make the unit compilable with Ada 95 compiler

with Ada.Characters.Conversions; use Ada.Characters.Conversions;

with GNAT.OS_Lib;                use GNAT.OS_Lib;

with Asis;                       use Asis;
with Asis.Ada_Environments;
with Asis.Compilation_Units;     use Asis.Compilation_Units;
with Asis.Errors;
with Asis.Exceptions;
with Asis.Extensions;            use Asis.Extensions;
with Asis.Implementation;

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

package body ASIS_UL.Source_Table.Processing is

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

   procedure Process_Sources_From_Table (Only_Bodies : Boolean := False);
   --  Processes sources stores in the sources table trying to minimize
   --  compilations needed to create the tree files. If Only_Bodies is set ON,
   --  only files with .adb suffixes are compiled for the trees.

   procedure Process_Source (SF : SF_Id);
   --  Processes the source file stored under SF index into source file table.
   --  The caller is responsible to keep the actual parameter inside the
   --  range of the existing table entries. The processing consists of
   --  creating the tree file for this source, and if the tree is successfully
   --  created, then the ASIS Compilation Unit corresponding to this source
   --  is processed. Then this routine tries to locate in the set of ASIS
   --  Compilation Units representing by this tree units corresponding to some
   --  other sources stored in the source table, and to process all these
   --  units. When the processing is complete, the tree file and the
   --  corresponding ALI file are deleted from the temporary directory.

   procedure ASIS_Processing (CU : Asis.Compilation_Unit; SF : SF_Id);
   --  This procedure incapsulates all the actions performed in the opened
   --  Context with the compilation unit CU corresponding to the source file
   --  SF (the caller is responsible for the fact that CU with this SF are
   --  represented by the tree making up the currently processed ASIS Context).
   --  The corresponding processing is entirely tool-specific, so each tool
   --  should provide its own subunit as the actual implementation of this
   --  routine.

   ---------------------
   -- ASIS_Processing --
   ----------------------

   --  This is entiraly tool-specific, so the ASIS Utility Library provides
   --  an empty place-holder here.

   procedure ASIS_Processing (CU : Asis.Compilation_Unit;  SF : SF_Id) is
     separate;

   ----------------
   -- Initialize --
   ----------------

   --  This is entiraly tool-specific, so the ASIS Utility Library provides
   --  an empty place-holder here.

   procedure Initialize is separate;

   --------------------
   -- Process_Source --
   --------------------

   procedure Process_Source (SF : SF_Id) is
      Success : Boolean;
   begin

      Output_Source (SF);

      Create_Tree (SF, Success);

      if not Success then
         return;
      end if;

      Asis.Ada_Environments.Associate
       (The_Context => The_Context,
        Name        => "",
        Parameters  => "-C1 "
                      & To_Wide_String (Suffixless_Name (SF) & ".adt"));

      declare
         use type Asis.Errors.Error_Kinds;
      begin
         Asis.Ada_Environments.Open (The_Context);
         Success := True;
      exception
         when Asis.Exceptions.ASIS_Failed =>
            --  The only known situation when we can not open a C1 context for
            --  newly created tree is recompilation of System (see D617-017)

            if Asis.Implementation.Status = Asis.Errors.Use_Error
              and then
               Asis.Implementation.Diagnosis = "Internal implementation error:"
               & " Asis.Ada_Environments.Open - System is recompiled"
            then
               Error ("can not process redefinition of System in " &
                       Source_Name (SF));

               Set_Source_Status (SF, Not_A_Legal_Source);
               Success := False;
            else
               raise;
            end if;

      end;

      if Success then

         The_CU := Main_Unit_In_Current_Tree (The_Context);
         ASIS_Processing (The_CU, SF);

         declare
            All_CUs : constant Asis.Compilation_Unit_List :=
              Asis.Compilation_Units.Compilation_Units (The_Context);
            Next_SF : SF_Id;
         begin

            for J in All_CUs'Range loop

               if Process_RTL_Units
                 or else
                  Unit_Origin (All_CUs (J)) = An_Application_Unit
               then

                  Next_SF :=
                    File_Find (Normalize_Pathname
                      (To_String (Text_Name (All_CUs (J))),
                       Resolve_Links  => False,
                       Case_Sensitive => False));

                  if Present (Next_SF) and then
                     Source_Status (Next_SF) = Waiting
                  then
                     The_CU := All_CUs (J);
                     Output_Source (Next_SF);
                     ASIS_Processing (All_CUs (J), Next_SF);
                  end if;

               end if;

            end loop;

         exception
            when Ex : others =>
               Error
                 ("unknown bug detected when processing " &
                   Source_Name (Next_SF));
               Error_No_Tool_Name
                 ("Please submit bug report to report@gnat.com");
               Report_Unhandled_Exception (Ex);
               Source_Clean_Up (Next_SF);
               raise Fatal_Error;

         end;

      end if;

      Source_Clean_Up (SF);

   exception

      when Program_Error =>
         Error ("installation problem - check gnatmetric and GNAT versions");
         raise Fatal_Error;

      when Fatal_Error =>
         raise;

      when Ex : others =>
         Error ("unknown bug detected when processing " & Source_Name (SF));
         Error_No_Tool_Name ("Please submit bug report to report@gnat.com");
         Report_Unhandled_Exception (Ex);
         Source_Clean_Up (SF);
         raise Fatal_Error;

   end Process_Source;

   ---------------------
   -- Process_Sources --
   ---------------------

   procedure Process_Sources is
   begin
      Asis.Implementation.Initialize ("-k");

      Process_Sources_From_Table (Only_Bodies => True);
      Process_Sources_From_Table;

      Asis.Implementation.Finalize;
   end Process_Sources;

   --------------------------------
   -- Process_Sources_From_Table --
   --------------------------------

   procedure Process_Sources_From_Table (Only_Bodies : Boolean := False) is
      Next_SF : SF_Id;
   begin
      Reset_Source_Iterator;

      Next_SF := Next_Non_Processed_Source (Only_Bodies);

      while Present (Next_SF) loop
         Process_Source (Next_SF);
         Next_SF := Next_Non_Processed_Source (Only_Bodies);
      end loop;

   end Process_Sources_From_Table;

   --------------
   -- Finalize --
   --------------

   --  This is entiraly tool-specific, so the ASIS Utility Library provides
   --  an empty place-holder here.

   procedure Finalize is separate;

end ASIS_UL.Source_Table.Processing;
