-----------------------------------------------------------------------------
--                                                                          --
--                          GNATCHECK COMPONENTS                            --
--                                                                          --
--                 G N A T S Y N C . G L O B A L _ I N F O                  --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                    Copyright (C) 2007-2008, AdaCore                      --
--                                                                          --
-- GNATSYNC  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.  GNATCHECK  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.                                       --
--                                                                          --
-- GNATSYNC is maintained by AdaCore (http://www.adacore.com).              --
--                                                                          --
------------------------------------------------------------------------------

with Asis.Declarations;                 use Asis.Declarations;
with Asis.Elements;                     use Asis.Elements;
with Asis.Exceptions;

with ASIS_UL.Common;                    use ASIS_UL.Common;
with ASIS_UL.Output;                    use ASIS_UL.Output;
with ASIS_UL.Strings;                   use ASIS_UL.Strings;

with Gnatsync.ASIS_Utilities;           use Gnatsync.ASIS_Utilities;
with Gnatsync.Global_Info.Call_Graph;   use Gnatsync.Global_Info.Call_Graph;
with Gnatsync.Global_Info.Data;         use Gnatsync.Global_Info.Data;
with Gnatsync.Global_Info.Data_Objects; use Gnatsync.Global_Info.Data_Objects;
with Gnatsync.Threads;                  use Gnatsync.Threads;

package body Gnatsync.Global_Info is

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

   procedure Increase_Nonexec_Level
     (State : in out Global_Info_Collection_State);
   procedure Decrease_Nonexec_Level
     (State : in out Global_Info_Collection_State);
   --  Non-executable constructs may be enclosed one in another. So during the
   --  traversal process we have to count the nesting level of such constructs
   --  to have the possibility to detect if we are in executable or in
   --  non-executable context. Increase_Nonexec_Level should be called by the
   --  traversal pre-operation when we enter a non-executable construct,
   --  and Decrease_Nonexec_Level should be called in the Post-operation for
   --  this construct

   function In_Executable_Code
     (State : Global_Info_Collection_State)
      return  Boolean;
   --  Tells if we are in the executable context at the given stage of
   --  traversal.

   Definition                    : Asis.Element;
   Is_Global_Reference           : Boolean;
   Can_Be_Accessed_By_Local_Task : Boolean;
   Reference_Kind                : Reference_Kinds;
   --  We define these variables as global for Pre_Operation because of
   --  performance reasons (to awoind their allocation for each identifier
   --  element being visited during traversal)

   ----------------------------
   -- Decrease_Nonexec_Level --
   ----------------------------

   procedure Decrease_Nonexec_Level
     (State : in out Global_Info_Collection_State)
   is
   begin
      State.Level_Of_Nonexecutable_Construct :=
        State.Level_Of_Nonexecutable_Construct - 1;
   end Decrease_Nonexec_Level;

   ------------------------
   -- In_Executable_Code --
   ------------------------

   function In_Executable_Code
     (State : Global_Info_Collection_State)
      return  Boolean
   is
   begin
      return State.Level_Of_Nonexecutable_Construct = 0;
   end In_Executable_Code;

   ----------------------------
   -- Increase_Nonexec_Level --
   ----------------------------

   procedure Increase_Nonexec_Level
     (State : in out Global_Info_Collection_State)
   is
   begin
      State.Level_Of_Nonexecutable_Construct :=
        State.Level_Of_Nonexecutable_Construct + 1;
   end Increase_Nonexec_Level;

   -------------------
   -- Pre_Operation --
   -------------------

   procedure Pre_Operation
     (Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Global_Info_Collection_State)
   is
      Expanded_Code : Asis.Element;
      --  Used to place the expanded generic spec or body into

--      Enclosed_Decl : Asis.Element;
      --  Used to analyse variable declarations

   begin

      if Is_Of_No_Interest (Element) then
--         Gnatcheck.ASIS_Utilities.Is_Non_Executable_Construct (Element)
--         --  In gnatsync we do not analyse protected definitions and
--         --  protected bodies at all!
--        or else
--         Is_Protected (Element)
--      then
         --  Why not just:
         --  Control := Abandon_Children;
         --  ????????

         Increase_Nonexec_Level (State);
      end if;

      if In_Executable_Code (State) then

         if Foreign_Critical_Sections_Specified
           and then
            In_Critical_Section
         then

            if Statement_Kind (Element) = A_Procedure_Call_Statement then
               Check_For_Critical_Section (Element);
            end if;

         else

            Collect_Call_Graph_Info (Element);

            if Expression_Kind (Element) = An_Identifier then

               Check_If_Global_Reference
                 (Element                       => Element,
                  Definition                    => Definition,
                  Is_Global_Reference           => Is_Global_Reference,
                  Can_Be_Accessed_By_Local_Task =>
                    Can_Be_Accessed_By_Local_Task,
                  Reference_Kind                => Reference_Kind,
                  Compute_Reference_Kind        => True);

               if Is_Global_Reference
                 or else
                  Can_Be_Accessed_By_Local_Task
               then
                  Process_Global_Reference
                    (Element,
                     Definition,
                     Reference_Kind,
                     Can_Be_Accessed_By_Local_Task);
               end if;

            end if;

         end if;

         if Declaration_Kind (Element) in
              A_Package_Instantiation .. A_Function_Instantiation
         then
            Expanded_Code := Corresponding_Declaration (Element);

            Collect_Global_Info
              (Element => Expanded_Code,
               Control => Control,
               State   => State);

            Expanded_Code := Corresponding_Body (Element);

            if not Is_Nil (Expanded_Code) then
               Collect_Global_Info
                 (Element => Expanded_Code,
                  Control => Control,
                  State   => State);
            end if;

         end if;

      end if;

   exception
      when ASIS_UL.Common.Non_Implemented_Error =>
         Tool_Failures := Tool_Failures + 1;

         Error (" processing incomplete because of non-implemented feature " &
                "detected at " & Build_GNAT_Location (Element));

      when Ex : Asis.Exceptions.ASIS_Inappropriate_Context          |
                Asis.Exceptions.ASIS_Inappropriate_Container        |
                Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit |
                Asis.Exceptions.ASIS_Inappropriate_Element          |
                Asis.Exceptions.ASIS_Inappropriate_Line             |
                Asis.Exceptions.ASIS_Inappropriate_Line_Number      |
                Asis.Exceptions.ASIS_Failed                         =>

         Tool_Failures := Tool_Failures + 1;

         Error ("ASIS failure (pre-operation) at "  &
                Build_GNAT_Location (Element));

         ASIS_UL.Output.Report_Unhandled_ASIS_Exception (Ex);

      when Ex : others =>
         Tool_Failures := Tool_Failures + 1;

         Error ("pre-operation failed at " & Build_GNAT_Location (Element));

         ASIS_UL.Output.Report_Unhandled_Exception (Ex);
   end Pre_Operation;

   --------------------
   -- Post_Operation --
   --------------------

   procedure Post_Operation
     (Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Global_Info_Collection_State)
   is
      pragma Unreferenced (Control);
   begin

      if In_Executable_Code (State) then
         Complete_Call_Graph_Info (Element);
      end if;

      if Is_Of_No_Interest (Element) then
         Decrease_Nonexec_Level (State);
      end if;

   exception
      when ASIS_UL.Common.Non_Implemented_Error =>
         Tool_Failures := Tool_Failures + 1;

         Error ("processing incomplete because of non-implemented feature " &
                "detected at " & Build_GNAT_Location (Element));

      when Ex : Asis.Exceptions.ASIS_Inappropriate_Context          |
                Asis.Exceptions.ASIS_Inappropriate_Container        |
                Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit |
                Asis.Exceptions.ASIS_Inappropriate_Element          |
                Asis.Exceptions.ASIS_Inappropriate_Line             |
                Asis.Exceptions.ASIS_Inappropriate_Line_Number      |
                Asis.Exceptions.ASIS_Failed                         =>

         Tool_Failures := Tool_Failures + 1;

         Error ("ASIS failure (post-operation) at "  &
                Build_GNAT_Location (Element));

         ASIS_UL.Output.Report_Unhandled_ASIS_Exception (Ex);

      when Ex : others =>
         Tool_Failures := Tool_Failures + 1;

         Error ("post-operation failed at " & Build_GNAT_Location (Element));

         ASIS_UL.Output.Report_Unhandled_Exception (Ex);
   end Post_Operation;

end Gnatsync.Global_Info;
