------------------------------------------------------------------------------
--                                                                          --
--                          GNATCHECK COMPONENTS                            --
--                                                                          --
--             G N A T C H E C K . A S I S _ U T I L I T I E S              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2004-2007, AdaCore                     --
--                                                                          --
-- GNATCHECK  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.                                       --
--                                                                          --
-- GNATCHECK is maintained by AdaCore (http://www.adacore.com).             --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Wide_Text_IO;           use Ada.Wide_Text_IO;
with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
with GNAT.OS_Lib;                use GNAT.OS_Lib;

with Asis.Clauses;               use Asis.Clauses;
with Asis.Compilation_Units;     use Asis.Compilation_Units;
with Asis.Declarations;          use Asis.Declarations;
with Asis.Definitions;           use Asis.Definitions;
with Asis.Elements;              use Asis.Elements;
with Asis.Exceptions;
with Asis.Expressions;           use Asis.Expressions;
with Asis.Extensions;            use Asis.Extensions;
with Asis.Extensions.Flat_Kinds; use Asis.Extensions.Flat_Kinds;
with Asis.Iterator;              use Asis.Iterator;
with Asis.Statements;            use Asis.Statements;
with Asis.Text;                  use Asis.Text;

with ASIS_UL.Common;             use ASIS_UL.Common;
with ASIS_UL.Compiler_Options;   use ASIS_UL.Compiler_Options;
with ASIS_UL.Source_Table;       use ASIS_UL.Source_Table;

with Table;

with Atree;                      use Atree;
with Einfo;                      use Einfo;
with Nlists;                     use Nlists;
with Sinfo;                      use Sinfo;
with Stand;                      use Stand;
with Types;                      use Types;

with Asis.Set_Get;               use Asis.Set_Get;

with A4G.A_Sem;                  use A4G.A_Sem;
with A4G.Vcheck;                 use A4G.Vcheck;

with Gnatcheck.Traversal_Stack;  use Gnatcheck.Traversal_Stack;

package body Gnatcheck.ASIS_Utilities is
   Package_Name : constant String := "Gnatcheck.ASIS_Utilities";

   -------------------------
   -- ASIS Elements Table --
   -------------------------

   --  Here we define the same structure as A4G.Asis_Tables.Asis_Element_Table.
   --  We need it to create the results of the functions returning
   --  Element_List, but we can not reuse A4G.Asis_Tables.Asis_Element_Table
   --  because it may be used by the standard ASIS queries we may need for our
   --  gnatcheck ASIS utilities.

   package Gnatcheck_Element_Table is new Table.Table (
     Table_Component_Type => Asis.Element,
     Table_Index_Type     => Natural,
     Table_Low_Bound      => 1,
     Table_Initial        => 100,
     Table_Increment      => 100,
     Table_Name           => "GNATCHECK Element List");

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

   function Is_Limited (SM : Asis.Element) return Boolean;
   --  Supposing that SM represent a subtype mark, checks if the denoted type
   --  is limited. Returns False for any unexpected element.
   --
   --  Expected Expression_Kinds:
   --       An_Identifier
   --       A_Selected_Component
   --       An_Attribute_Reference

   function Is_Volatile_Type (Subtype_Ref : Asis.Element) return Boolean;
   --  Provided that Subtype_Ref is a subtype mark, check if it denotes a
   --  volatile type. The notion of a volatile type depends on our
   --  interpretation of the Volatile_Requires_Addr_Clause rule. At the moment
   --  we do not consider atomic types as volatile types, we also do not
   --  take into account the effect of the Atomic_Components and
   --  Volatile_Components pragmas.
   --
   --  When iterating through the derivations chain looking for Volatile
   --  pragma, we do not consider that record extensions can be volatile
   --
   --  This function returns False for any unexpected element
   --
   --  Expected Expression_Kinds:
   --       An_Identifier
   --       A_Selected_Component
   --       An_Attribute_Reference

   function Is_Compomnent_Default (Expr : Asis.Element) return Boolean;
   --  Checks that the argument Element is an initialization expression in
   --  A_Component_Declaration Element. returns False for any unexpected
   --  Element. Also returns false in case if this is an initialization
   --  expression from a single protected declaration (becauce this expression
   --  is from executable context, see the use of this function)

   function Is_Task_Object_Declaration (Expr : Asis.Element) return Boolean;
   --  Check if the element if a declaration of (one or more) task object(s)
   --  Returns False for any unexpected object
   --
   --  Expected Declaration_Kinds:
   --       A_Variable_Declaration
   --       A_Constant_Declaration

   function Get_Called_Task (Call : Asis.Element) return Asis.Element;
   --  Provided that Is_Task_Entry_Call (Call) computes the called
   --  task.
   --  What is "the called task" for different ways of defining a task
   --  object ???

   procedure Look_For_Loop_Pre_Op
     (Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Boolean);
   --  Actual for Traverse_Element instantiation.
   --  Terminates the traversal and sets State ON when visiting a loop
   --  statement. Skips traversal of declarations, expressions and simple
   --  statements

   procedure Look_For_Loop_Post_Op
     (Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Boolean);
   --  Actual for Traverse_Element instantiation.
   --  Does nothing.

   procedure Look_For_Loop is new Traverse_Element
     (State_Information => Boolean,
      Pre_Operation     => Look_For_Loop_Pre_Op,
      Post_Operation    => Look_For_Loop_Post_Op);
   --  Looks for a lood statement enclosed by its Element argument and sets
   --  the result of the search to its State parameter. Declarations are not
   --  searched.

   -------------------------
   -- Can_Have_Elab_Calls --
   -------------------------

   function Can_Have_Elab_Calls (El : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin
      --  Implementation may be incomplete!!!???

      case Flat_Element_Kind (El) is
         when A_Variable_Declaration     |
              A_Package_Instantiation    |
              A_Procedure_Instantiation  |
              A_Function_Instantiation   |
              A_Function_Call            |
              An_Allocation_From_Subtype |
              A_Procedure_Call_Statement |
              An_Entry_Call_Statement    =>

            Result := True;
         when others =>
            null;
      end case;

      return Result;
   end Can_Have_Elab_Calls;

   ---------------------------
   -- Can_Cause_Side_Effect --
   ---------------------------

   function Can_Cause_Side_Effect (El : Asis.Element) return Boolean is
      Arg_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (El);
      Result   :          Boolean := False;
   begin
      --  !!! Only partial implementation for now!!!

      case Arg_Kind is
         when An_Assignment_Statement    |
              A_Procedure_Call_Statement |
              A_Function_Call            =>
            --  What about entry calls???
            Result := True;
--         when =>
         when others =>
            null;
      end case;

      return Result;
   end Can_Cause_Side_Effect;

   ---------------------
   -- Call_Parameters --
   ---------------------

   function Call_Parameters (Call : Asis.Element) return Asis.Element_List is
   begin

      case Flat_Element_Kind (Call) is
         when A_Procedure_Call_Statement |
              An_Entry_Call_Statement    =>
            return Call_Statement_Parameters (Call);
         when A_Function_Call =>
            return Function_Call_Parameters (Call);
         when others =>
            pragma Assert (False);
            return Nil_Element_List;
      end case;

   end Call_Parameters;

   --------------------
   -- Called_Profile --
   --------------------

   function Called_Profile (Call : Asis.Element) return Asis.Element_List is
      Get_Profile_From : Asis.Element;
      Tmp              : Asis.Element;
   begin

      --  Filter out the case of a call to a predefined operator

      if Expression_Kind (Call) = A_Function_Call then
         Tmp := Prefix (Call);
         Tmp := Normalize_Reference (Tmp);

         if Is_Predefined_Operator (Tmp) then
            return Nil_Element_List;
         end if;

      end if;

      --  Filter out the case of a call to attribute subprogram:

      if Is_Call_To_Attribute_Subprogram (Call) then
         return Nil_Element_List;
      end if;

      case Flat_Element_Kind (Call) is
         when A_Procedure_Call_Statement |
              An_Entry_Call_Statement    =>
            Get_Profile_From := Corresponding_Called_Entity (Call);
         when A_Function_Call =>
            Get_Profile_From := Corresponding_Called_Function (Call);
         when others =>
            pragma Assert (False);
            return Nil_Element_List;
      end case;

      if Is_Nil (Get_Profile_From) then
         --  two possibilities: either a dispatching call or a dynamic call
         --  through access-to-subprogram value

         if Is_Dispatching_Call (Call) then
            Tmp              := Get_Called_Ref (Call);
            Tmp              := Normalize_Reference (Tmp);
            Get_Profile_From := Corresponding_Name_Declaration (Tmp);
         else
            --  Call through access-to-subprogram value
            Get_Profile_From := Get_Called_Ref (Call);

            if Expression_Kind (Get_Profile_From) =
                 An_Explicit_Dereference
            then
               Get_Profile_From := Prefix (Get_Profile_From);
            end if;

            Get_Profile_From :=
              Corresponding_Expression_Type (Get_Profile_From);

            if not Is_Nil (Get_Profile_From) then
               Get_Profile_From :=
                 Unwind_Derivations_And_Subtyping (Get_Profile_From);
            else
               raise Non_Implemented_Error;
            end if;

         end if;

      end if;

      if Declaration_Kind (Get_Profile_From) in
        A_Procedure_Instantiation  .. A_Function_Instantiation
      then
         Get_Profile_From := Corresponding_Declaration (Get_Profile_From);
      end if;

      case Declaration_Kind (Get_Profile_From) is

         when A_Procedure_Declaration          |
              A_Function_Declaration           |
              A_Procedure_Body_Declaration     |
              A_Function_Body_Declaration      |
              A_Procedure_Renaming_Declaration |
              A_Function_Renaming_Declaration  |
              An_Entry_Declaration             |
              An_Entry_Body_Declaration        |
              A_Procedure_Body_Stub            |
              A_Function_Body_Stub             |
              A_Generic_Procedure_Declaration  |
              A_Generic_Function_Declaration   |
              A_Formal_Procedure_Declaration   |
              A_Formal_Function_Declaration    =>

            return Parameter_Profile (Get_Profile_From);

         when An_Ordinary_Type_Declaration =>
            --  It should be an access-to-subprogram type, so
            Get_Profile_From := Type_Declaration_View (Get_Profile_From);

            pragma Assert (Access_Type_Kind (Get_Profile_From) in
                             Asis.Access_To_Subprogram_Definition);

            return Access_To_Subprogram_Parameter_Profile (Get_Profile_From);

         when others =>
            raise Non_Implemented_Error;
      end case;

   end Called_Profile;

   ----------------------------------------------
   -- Call_To_Complicated_Cuncurrent_Structure --
   ----------------------------------------------

   function Call_To_Complicated_Cuncurrent_Structure
     (Call : Asis.Element)
      return Boolean
   is
      Arg_Kind    : constant Flat_Element_Kinds := Flat_Element_Kind (Call);
      Result      : Boolean                     := True;
      Called_Pref : Asis.Element                := Nil_Element;
      Called_Obj  : Asis.Element                := Nil_Element;
      Tmp_El      : Asis.Element;
   begin

      case Arg_Kind is
         when An_Entry_Call_Statement    |
             A_Procedure_Call_Statement =>
            Called_Pref := Called_Name (Call);

            if Arg_Kind = An_Entry_Call_Statement
             and then
               Flat_Element_Kind (Called_Pref) = An_Indexed_Component
            then
               --  Call to an entry from an entry family
               Called_Pref := Prefix (Called_Pref);
            end if;

         when A_Function_Call =>
            Called_Pref := Prefix (Call);
         when others =>
            null;
      end case;

      --  Called_Pref should be of A_Selected_Component kind. We are interested
      --  in task or protected object now

      if Flat_Element_Kind (Called_Pref) = A_Selected_Component then
         Called_Pref := Prefix (Called_Pref);

         if Flat_Element_Kind (Called_Pref) = A_Selected_Component then
            Called_Pref := Selector (Called_Pref);
         end if;

      end if;

      if Expression_Kind (Called_Pref) = An_Identifier then

         begin
            Called_Obj := Corresponding_Name_Definition (Called_Pref);
         exception
            when others =>
               Called_Obj := Nil_Element;
         end;

      end if;

      if not Is_Nil (Called_Obj) then
         Tmp_El := Enclosing_Element (Called_Obj);

         case Declaration_Kind (Tmp_El) is
            when A_Single_Task_Declaration .. A_Single_Protected_Declaration =>
               Result := False;

            when A_Variable_Declaration | A_Constant_Declaration =>
               Tmp_El := Object_Declaration_View (Tmp_El);

               Tmp_El := Asis.Definitions.Subtype_Mark (Tmp_El);

               if Expression_Kind (Tmp_El) = A_Selected_Component then
                  Tmp_El := Selector (Tmp_El);
               end if;

               Tmp_El := Corresponding_Name_Declaration (Tmp_El);

               --  Now we check that the type of the object is a task or
               --  protected type

               Tmp_El := Corresponding_First_Subtype (Tmp_El);

               --  We can n0t have a private type here.

               if Declaration_Kind (Tmp_El) in
                 A_Task_Type_Declaration .. A_Protected_Type_Declaration
               then
                  Result := False;
               else
                  Tmp_El := Type_Declaration_View (Tmp_El);

                  if Asis.Elements.Type_Kind (Tmp_El) =
                    A_Derived_Type_Definition
                  then
                     Tmp_El := Corresponding_Root_Type (Tmp_El);

                     if Declaration_Kind (Tmp_El) in
                       A_Task_Type_Declaration .. A_Protected_Type_Declaration
                     then
                        Result := False;
                     end if;

                  end if;
               end if;

            when others =>
               null;
         end case;

      end if;

      return Result;
   end Call_To_Complicated_Cuncurrent_Structure;

   -----------------------------------
   -- Can_Be_Replaced_With_Function --
   -----------------------------------

   function Can_Be_Replaced_With_Function
     (Decl : Asis.Element)
      return Boolean
   is
      Out_Par : Asis.Element := Nil_Element;
      Result  : Boolean := False;
   begin

      case Declaration_Kind (Decl) is
         when A_Procedure_Declaration         |
              A_Procedure_Body_Declaration    |
              A_Procedure_Body_Stub           |
              A_Generic_Procedure_Declaration |
              A_Formal_Procedure_Declaration  =>

            declare
               Params : constant Asis.Element_List := Parameter_Profile (Decl);
            begin

               for J in Params'Range loop

                  case Mode_Kind (Params (J)) is
                     when An_Out_Mode =>

                        if Is_Nil (Out_Par) then
                           Out_Par := Object_Declaration_View (Params (J));

                           if Definition_Kind (Out_Par) =
                                 An_Access_Definition
                           then
                              Result := True;
                           else
                              --  If we are here, Out_Par represents a subtype
                              --  mark
                              Result := not Is_Limited (Out_Par);

                              exit when not Result;

                           end if;

                        else
                           Result := False;
                           exit;
                        end if;

                     when An_In_Out_Mode =>
                        Result := False;
                        exit;
                     when others =>
                        null;
                  end case;

               end loop;

            end;

         when others =>
            null;
      end case;

      return Result;
   end Can_Be_Replaced_With_Function;

   ---------------------
   -- Changed_Element --
   ---------------------

   function Changed_Element (El : Asis.Element) return Asis.Element is
      Arg_Elem :          Asis.Element       := El;
      Arg_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (El);
      Result   :          Asis.Element       := Nil_Element;
   begin

      --  Problem with access types!!!???

      case Arg_Kind is
         when An_Identifier =>
            --  Nothing to do:
            null;
         when A_Selected_Component =>
            Arg_Elem := Get_Whole_Object (Arg_Elem);

         when An_Indexed_Component    |
              A_Slice                 |
              An_Explicit_Dereference =>

            while not (Expression_Kind (Arg_Elem) = A_Selected_Component
                   or else
                       Expression_Kind (Arg_Elem) = An_Identifier)
            loop
               Arg_Elem := Prefix (Arg_Elem);
            end loop;

            if Expression_Kind (Arg_Elem) = A_Selected_Component then
               Arg_Elem := Get_Whole_Object (Arg_Elem);
            end if;

         when A_Type_Conversion =>
            return Changed_Element (Converted_Or_Qualified_Expression (El));

--         when  =>
         when others =>
            pragma Assert (False);
            null;
      end case;

      if Expression_Kind (Arg_Elem) = An_Identifier then
         Result := Corresponding_Name_Definition (Arg_Elem);
      else
         Result := Arg_Elem;
      end if;

      return Result;
   end Changed_Element;

   -------------------
   -- Contains_Loop --
   -------------------

   function Contains_Loop (El : Asis.Element) return Boolean is
      Control : Traverse_Control := Continue;
      Result  : Boolean          := False;

      Comps : constant Asis.Element_List := Components (El);
   begin

      --  We can not just apply Look_For_Loop tp El - if El itself is a loop
      --  statement, then Result will alvays be True:
      for J in Comps'Range loop
         Look_For_Loop (Comps (J), Control, Result);
         exit when Result;
      end loop;

      return Result;

   end Contains_Loop;

   ---------------------------
   -- Corresponding_Element --
   ---------------------------

   --  Implementation IS incomplete!!!???

   function Corresponding_Element (El : Asis.Element) return Asis.Element is
      Arg_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (El);
      Result   :          Asis.Element       := El;
   begin

      case Arg_Kind is
         when A_Procedure_Body_Declaration |
              A_Function_Body_Declaration  |
              A_Task_Body_Declaration      |
              An_Entry_Body_Declaration    |
              A_Package_Body_Declaration   |
              A_Procedure_Body_Stub        |
              A_Function_Body_Stub         |
              A_Package_Body_Stub          |
              A_Task_Body_Stub             |
              A_Protected_Body_Stub         =>

            Result := Corresponding_Declaration (Result);

            if Is_Nil (Result) then

               if Is_Subunit (El) then
                  Result :=
                    Corresponding_Element (Corresponding_Body_Stub (El));

               elsif Arg_Kind in A_Procedure_Body_Declaration ..
                                 A_Function_Body_Declaration
                   or else
                     Arg_Kind in A_Procedure_Body_Stub .. A_Function_Body_Stub
               then
                  --  No explicit spec
                  Result := El;

               end if;

            elsif Declaration_Kind (Result) = A_Task_Type_Declaration then
               Result := Type_Declaration_View (Result);
            elsif Declaration_Kind (Result) = A_Single_Task_Declaration then
               Result := Object_Declaration_View (Result);
            end if;

         when A_Procedure_Declaration |
              A_Function_Declaration  =>

            if Is_Implicit_Neq_Declaration (Result) then
               Result := Corresponding_Equality_Operator (Result);
            elsif Is_Part_Of_Inherited (Result) then
               Result := Corresponding_Declaration (Result);
            end if;

         when An_Entry_Declaration      |
              A_Task_Type_Declaration   |
              A_Defining_Identifier     |
              A_Single_Task_Declaration |
              A_Package_Declaration     |
              A_Task_Definition         |
              A_Protected_Definition    =>
            null;

         when A_Procedure_Instantiation |
              A_Function_Instantiation  =>

            Result := Corresponding_Declaration (El);

         when A_Package_Instantiation =>
            --  Only library-level  instantiations are considered:

            if not Is_Nil (Enclosing_Element (El)) then
               null;
               pragma Assert (False);
            end if;

         when A_Procedure_Renaming_Declaration |
              A_Function_Renaming_Declaration  =>

            if Is_Renaming_As_Body (El) then
               Result := Corresponding_Declaration (Result);
            end if;

         when others =>
            Put_Line (Standard_Error, Debug_Image (El));

            if Is_Text_Available (El) then
               Put_Line (Standard_Error, Element_Image (El));
            end if;

            pragma Assert (False);
            null;
      end case;

      return Result;
   end Corresponding_Element;

   ------------------------------------
   -- Corresponding_Protected_Object --
   ------------------------------------

   function Corresponding_Protected_Object
     (Pref : Asis.Element)
      return Asis.Element
   is
      Tmp    : Asis.Element := Pref;
      Result : Asis.Element := Nil_Element;
   begin

      if Expression_Kind (Tmp) = A_Function_Call then
         Tmp := Prefix (Tmp);
      else
         Tmp := Called_Name (Tmp);
      end if;

      --  At the moment the simplest case only is implemented: we can process
      --  only the argument Element of the form P_Obj_Name.P_Op_Name

      if Expression_Kind (Tmp) = A_Selected_Component then
         Tmp := Prefix (Tmp);

         if Expression_Kind (Tmp) = A_Selected_Component then
            Tmp := Selector (Tmp);
         end if;

         pragma Assert (Expression_Kind (Tmp) = An_Identifier);

         Result := Corresponding_Name_Definition (Tmp);

         if Declaration_Kind (Enclosing_Element (Result)) =
            A_Single_Protected_Declaration
         then
            Result := Enclosing_Element (Result);
         end if;

      end if;

      pragma Assert (not Is_Nil (Result));

      return Result;

   end Corresponding_Protected_Object;

   -----------------------------------
   -- Declaration_Of_Renamed_Entity --
   -----------------------------------

   function Declaration_Of_Renamed_Entity
     (R    : Asis.Element)
      return Asis.Element
   is
      Arg_Element : Asis.Element := Renamed_Entity (R);
      Result      : Asis.Element := Nil_Element;
   begin

      if Expression_Kind (Arg_Element) = A_Selected_Component then
         Arg_Element := Selector (Arg_Element);
      end if;

      case Expression_Kind (Arg_Element) is
         when An_Identifier          |
              An_Operator_Symbol     |
              A_Character_Literal    |
              An_Enumeration_Literal =>
            Result := Corresponding_Name_Declaration (Arg_Element);
         when others =>
            null;
      end case;

      return Result;
   exception
      when others =>
         return Nil_Element;
   end Declaration_Of_Renamed_Entity;

   ---------------------
   -- Enclosing_Scope --
   ---------------------

   function Enclosing_Scope (El : Asis.Element) return Asis.Element is
      Result : Asis.Element := El;
      Tmp    : Asis.Element;
   begin
      while not Is_Scope (Result) loop

         if Is_Subunit (Result) then
            Result := Corresponding_Body_Stub (Result);
         else
            Result := Enclosing_Element (Result);
         end if;

      end loop;

      Tmp    := Result;
      Result := Corresponding_Element (Result);

      if Is_Nil (Result)
        and then
         Declaration_Kind (Tmp) = A_Task_Body_Declaration
      then
         Result := Corresponding_Declaration (Tmp);
      end if;

      return Result;
   end Enclosing_Scope;

   ----------------
   -- First_Name --
   ----------------

   function First_Name (Dcl : Asis.Element) return Asis.Element is
      Name_List : constant Asis.Element_List := Names (Dcl);
   begin
      return Name_List (Name_List'First);
   end First_Name;

   ----------------------
   -- Get_Associations --
   ----------------------

   function Get_Associations (El : Asis.Element) return Asis.Element_List is
   begin

      case Flat_Element_Kind (El) is
         when A_Record_Aggregate     |
              An_Extension_Aggregate =>
            return Record_Component_Associations (El);
         when A_Positional_Array_Aggregate |
              A_Named_Array_Aggregate      =>
            return Array_Component_Associations (El);
--         when  =>
--            return  (El);
         when others =>
            return Nil_Element_List;
      end case;

   end Get_Associations;

   -------------------
   -- Get_Body_Name --
   -------------------

   function Get_Body_Name (El : Asis.Element) return String is
      Body_Name :               String := Short_Source_Name (File_Find (El));
      Spec_Dir_Name  : constant String :=
        Dir_Name (Source_Name (File_Find (El)));

      Null_Result : constant String := "";

      Next_Dir : String_Access;
   begin
      --  The current implementation only scans the search path set by
      --  '-I' options, it cannot work with project files

      if Body_Name'Length >= 5
        and then
         Body_Name (Body_Name'Last - 3 .. Body_Name'Last) = ".ads"
      then

         if Asis.Compilation_Units.Is_Body_Required
           (Enclosing_Compilation_Unit (El))
         then
            Body_Name (Body_Name'Last) := 'b';
         end if;

      elsif Body_Name'Length >= 5
        and then
         Body_Name (Body_Name'Last - 3 .. Body_Name'Last) = ".adb"
      then
         --  We may have a body represented by some tree (this body is not
         --  the main unit in this tree), but if this body contains some
         --  generic instantiations, then this tree does not tepresent the
         --  corresponding expanded bodies. These expanded bodies are
         --  represented only in the tree created for this body file. So
         --  we store this body file as needed file to be processed from
         --  its "own" tree
         null;
      else
         return Null_Result;
      end if;

      if Look_Into_Current_Dir then
         --  We are in the temporary directory, so

         if Is_Regular_File (".." & Directory_Separator & Body_Name) then
            return
              Normalize_Pathname
                (".." & Directory_Separator & Body_Name,
                 Case_Sensitive => False);
         end if;

      end if;

      --  If this the right approach?

      if Is_Regular_File (Spec_Dir_Name & Directory_Separator & Body_Name) then
         return Normalize_Pathname
           (Spec_Dir_Name & Directory_Separator & Body_Name,
            Case_Sensitive => False);
      end if;

      --  Traversing -I options

      Reset_Search_Path_Iterator;

      while not No_More_Source_Dir loop
         Next_Dir := new String'(Next_Source_Dir);

         if Is_Regular_File
              (Next_Dir.all  &  Directory_Separator & Body_Name)
         then

            declare
               Result : constant String :=
                 Next_Dir.all  & Directory_Separator & Body_Name;
            begin
               Free (Next_Dir);
               return Result;
            end;

         else
            Free (Next_Dir);
         end if;

      end loop;

      --  If we have no found anything then

      return Null_Result;
   end Get_Body_Name;

   ----------------------
   -- Get_Call_Element --
   ----------------------

   function Get_Call_Element return Asis.Element is
      Steps_Up     : Elmt_Idx := 0;
      Result       : Asis.Element := Get_Enclosing_Element (Steps_Up);
   begin
      loop
         exit when
            Expression_Kind (Result) = A_Function_Call
           or else
            Element_Kind (Result) /= An_Expression;

         Steps_Up := Steps_Up + 1;
         Result   := Get_Enclosing_Element (Steps_Up);
      end loop;

      return Result;
   end Get_Call_Element;

   ------------------------
   -- Get_Called_Element --
   ------------------------

   function Get_Called_Element (Call : Asis.Element) return Asis.Element is
      Result      : Asis.Element := Nil_Element;
   begin

      case Flat_Element_Kind (Call) is
         when A_Procedure_Call_Statement =>
            Result := Corresponding_Called_Entity (Call);

         when An_Entry_Call_Statement =>
            --  Here we have to return the declaration of the task object
            --  the entry belongs to

            if Is_Task_Entry_Call (Call) then
               Result := Get_Called_Task (Call);
            else

               Put_Line (Standard_Error, Debug_Image (Call));

               if Is_Text_Available (Call) then
                  Put_Line (Standard_Error, Element_Image (Call));
               end if;

               pragma Assert (False);
               null;
            end if;

         when A_Function_Call =>
            Result := Corresponding_Called_Function (Call);
         when others =>
            null;
      end case;

--        Result := Corresponding_Element (Result);

      return Result;
   end Get_Called_Element;

   --------------------
   -- Get_Called_Ref --
   --------------------

   function Get_Called_Ref (Call : Asis.Element) return Asis.Element is
   begin

      if Expression_Kind (Call) = A_Function_Call then
         return Prefix (Call);
      else
         return Called_Name (Call);
      end if;

   end Get_Called_Ref;

   ---------------------
   -- Get_Called_Task --
   ---------------------

   function Get_Called_Task (Call : Asis.Element) return Asis.Element is
      Result : Asis.Element := Nil_Element;
      Tmp    : Asis.Element;
      Tmp1   : Asis.Element;
   begin
      --  For now - the simplest case. We consider that the prefix has
      --  the form of Task_Name.Entry_Name

      Tmp := Called_Name (Call);

      if Expression_Kind (Tmp) = An_Indexed_Component then
         --  A call to an entry from an entry family
         Tmp := Prefix (Tmp);
      end if;

      if Expression_Kind (Tmp) = A_Selected_Component then
         Tmp := Prefix (Tmp);

         if Expression_Kind (Tmp) = A_Selected_Component then
            Tmp := Asis.Expressions.Selector (Tmp);
         end if;

         Tmp := Corresponding_Name_Definition (Tmp);

         if not Is_Nil (Tmp) then
            --  For a task declared by a single task declaration we return this
            --  single task declaration, otherwise we return a task defining
            --  identifier
            Tmp1 := Enclosing_Element (Tmp);

            if Declaration_Kind (Tmp1) = A_Single_Task_Declaration then
               Tmp := Tmp1;
            end if;

            Result := Tmp;
         end if;

      end if;

      pragma Assert (not Is_Nil (Result));
      --  A null result requires a special processing, so for the development
      --  period we just blow up

      return Result;
   end Get_Called_Task;

   -----------------
   -- Get_Choices --
   -----------------

   function Get_Choices (El : Asis.Element) return Asis.Element_List is
   begin

      case Association_Kind (El) is
         when An_Array_Component_Association =>
            return Array_Component_Choices (El);
         when A_Record_Component_Association =>
            return Record_Component_Choices (El);
         when others =>
            return Nil_Element_List;
      end case;

   end Get_Choices;

   ----------------------------------
   -- Get_Corresponding_Definition --
   ----------------------------------

   function Get_Corresponding_Definition
     (El   : Asis.Element)
      return Asis.Element
   is
      Arg_Kind : constant Expression_Kinds := Expression_Kind (El);
      Result   : Asis.Element;
   begin

      if not (Arg_Kind = An_Identifier
             or else
              Arg_Kind = An_Operator_Symbol
             or else
              Arg_Kind = A_Character_Literal
             or else
              Arg_Kind = An_Enumeration_Literal)
      then
         --  To avoid junk use of this query
         Raise_ASIS_Inappropriate_Element
           (Diagnosis =>
              "Gnatcheck.ASIS_Utilities.Get_Corresponding_Definition");
      end if;

      begin
         Result := Corresponding_Name_Definition (El);
      exception
         when Asis.Exceptions.ASIS_Inappropriate_Element =>
            Result := Nil_Element;
      end;

      return Result;
   end Get_Corresponding_Definition;

   ------------------
   -- Get_Handlers --
   ------------------

   function Get_Handlers
     (El              : Asis.Element;
      Include_Pragmas : Boolean := False)
      return            Asis.Element_List
   is
   begin

      case Flat_Element_Kind (El) is
         when A_Procedure_Body_Declaration |
              A_Function_Body_Declaration  |
              A_Package_Body_Declaration   |
              An_Entry_Body_Declaration    |
              A_Task_Body_Declaration      =>
            return Body_Exception_Handlers (El, Include_Pragmas);

         when A_Block_Statement =>
            return Block_Exception_Handlers (El, Include_Pragmas);

         when An_Extended_Return_Statement =>
            return Extended_Return_Exception_Handlers (El, Include_Pragmas);

         when An_Accept_Statement =>
            return Accept_Body_Exception_Handlers (El, Include_Pragmas);

         when others =>
            return Nil_Element_List;
      end case;

   end Get_Handlers;

   -------------------------
   -- Get_Name_Definition --
   -------------------------

   function Get_Name_Definition (Ref : Asis.Element) return Asis.Element is
      Result : Asis.Element := Normalize_Reference (Ref);
   begin

      Result := Corresponding_Name_Definition (Result);

      if Declaration_Kind (Enclosing_Element (Result)) in
           A_Renaming_Declaration
      then
         Result := Corresponding_Base_Entity (Enclosing_Element (Result));
         Result := Normalize_Reference (Result);
         Result := Corresponding_Name_Definition (Result);
      end if;

      return Result;
   end Get_Name_Definition;

   -------------------------------
   -- Get_Parameter_Declaration --
   -------------------------------

   function Get_Parameter_Declaration (El : Asis.Element) return Asis.Element
   is
      Formal_Par : constant Asis.Element := Formal_Parameter (El);
      Result     :          Asis.Element;
   begin

      if Is_Nil (Formal_Par) then

         declare
            Call    : constant Asis.Element      := Enclosing_Element (El);
            Profile : constant Asis.Element_List := Called_Profile (Call);
            Actuals : constant Asis.Element_List := Call_Parameters (Call);

            Move_Act  : Natural  := 0;
            Move_Form : Natural  := 0;
            Form_Idx  : Natural  := 0;
         begin

            for J in Actuals'Range loop
               if Is_Equal (Actuals (J), El) then
                  exit;
               end if;

               Move_Act := Move_Act + 1;
            end loop;

            --  Now Move_Act gives us a number of the actual parameter in
            --  question in the call minus 1. This parameter is in positional
            --  association, so we have to count to the corresponding formal.
            --  The problem here is that we can have more then one formal
            --  parameter declared in one parameter specification.

            for J in Profile'Range loop
               Move_Form := Move_Form + Names (Profile (J))'Length;

               if Move_Form > Move_Act then
                  Form_Idx := J;
                  exit;
               end if;

            end loop;

            Result := Profile (Form_Idx);
         end;

      else
         Result := Corresponding_Name_Declaration (Formal_Par);
      end if;

      return Result;
   end Get_Parameter_Declaration;

   -------------------
   -- Get_Root_Type --
   -------------------

   function Get_Root_Type (Decl : Asis.Element) return Asis.Element is
      Arg_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (Decl);
      Type_Def :          Asis.Element;
      Result   :          Asis.Element;
   begin

      case Arg_Kind is
         when A_Variable_Declaration |
              A_Constant_Declaration =>
            null;
         when others =>
            Raise_ASIS_Inappropriate_Element
              (Package_Name & "Get_Root_Type");
      end case;

      Result := Object_Declaration_View (Decl);
      Result := Asis.Definitions.Subtype_Mark (Result);

      if Expression_Kind (Result) = A_Selected_Component then
         Result := Selector (Result);
      end if;

      Result := Corresponding_Name_Declaration (Result);

      if Declaration_Kind (Result) = A_Subtype_Declaration then
         Result := Corresponding_First_Subtype (Result);
      end if;

      if Declaration_Kind (Result) = An_Ordinary_Type_Declaration then
         Type_Def := Type_Declaration_View (Result);

         if Asis.Elements.Type_Kind (Type_Def) in
            A_Derived_Type_Definition .. A_Derived_Record_Extension_Definition
         then
            Result := Corresponding_Root_Type (Type_Def);
         end if;

      end if;

      return Result;

   end Get_Root_Type;

   -------------------------
   -- Get_Type_Components --
   -------------------------

   function Get_Type_Components
     (El                    : Asis.Element;
      Include_Discriminants : Boolean)
      return                  Asis.Element_List
   is
      Type_Def : Asis.Element;

      procedure Add_Components (Comps : Asis.Element_List);
      --  Adds record components to the result, recursively going down into
      --  variant part(s)

      procedure Add_Components (Comps : Asis.Element_List) is
      begin

         for J in Comps'Range loop

            if Declaration_Kind (Comps (J)) = A_Component_Declaration then
               Gnatcheck_Element_Table.Append (Comps (J));
            elsif Definition_Kind (Comps (J)) = A_Variant_Part then

               declare
                  Vars : constant Asis.Element_List := Variants (Comps (J));
               begin
                  for K in Vars'Range loop
                     Add_Components (Record_Components (Vars (K)));
                  end loop;
               end;

            end if;

         end loop;

      end Add_Components;

   begin
      Gnatcheck_Element_Table.Init;

      if Include_Discriminants then

         Type_Def :=  Discriminant_Part (El);

         if Definition_Kind (Type_Def) = A_Known_Discriminant_Part then

            declare
               Discr_List : constant Asis.Element_List :=
                  Discriminants (Type_Def);
            begin

               for J in Discr_List'Range loop
                  Gnatcheck_Element_Table.Append (Discr_List (J));
               end loop;

            end;

         end if;

      end if;

      Type_Def := Type_Declaration_View (El);

      case Flat_Element_Kind (Type_Def) is
         when A_Protected_Definition =>

            declare
               Items : constant Asis.Element_List :=
                 Private_Part_Items (Type_Def);
            begin

               for J in Items'Range loop

                  if Declaration_Kind (Items (J)) =
                     A_Component_Declaration
                  then
                     Gnatcheck_Element_Table.Append (Items (J));
                  end if;

               end loop;

            end;

         when A_Derived_Type_Definition ..
              A_Derived_Record_Extension_Definition =>

            declare
               Items : constant Asis.Element_List :=
                 Implicit_Inherited_Declarations (Type_Def);
            begin

               for J in Items'Range loop

                  if Declaration_Kind (Items (J)) =
                     A_Component_Declaration
                  then
                     Gnatcheck_Element_Table.Append (Items (J));
                  end if;

               end loop;

            end;

         when others =>
            null;
      end case;

      --  Now add explicit record components, if any

      if Asis.Elements.Type_Kind (Type_Def) =
         A_Derived_Record_Extension_Definition
        or else
         Asis.Elements.Type_Kind (Type_Def) = A_Record_Type_Definition
        or else
         Asis.Elements.Type_Kind (Type_Def) = A_Tagged_Record_Type_Definition
      then
         Type_Def := Asis.Definitions.Record_Definition (Type_Def);

         if Definition_Kind (Type_Def) /= A_Null_Record_Definition then

            declare
               Comps : constant Asis.Element_List :=
                 Record_Components (Type_Def);
            begin
               Add_Components (Comps);
            end;

         end if;

      end if;

      return Asis.Element_List
        (Gnatcheck_Element_Table.Table (1 .. Gnatcheck_Element_Table.Last));
   end Get_Type_Components;

   -------------------------------------
   -- Get_Type_Decl_From_Subtype_Mark --
   -------------------------------------

   function Get_Type_Decl_From_Subtype_Mark
     (SM   : Asis.Element)
      return Asis.Element
   is
      Result : Asis.Element := SM;
   begin

      if Expression_Kind (Result) = A_Selected_Component then
         Result := Selector (Result);
      end if;

      Result := Corresponding_Name_Declaration (Result);

      if Declaration_Kind (Result) = A_Subtype_Declaration then
         Result := Corresponding_First_Subtype (Result);
      end if;

      if Declaration_Kind (Result) in
           A_Private_Type_Declaration .. A_Private_Extension_Declaration
      then
         Result := Corresponding_Type_Declaration (Result);
      end if;

      return Result;
   end Get_Type_Decl_From_Subtype_Mark;

   ----------------------
   -- Get_Whole_Object --
   ----------------------

   function Get_Whole_Object (El : Asis.Element) return Asis.Element is
      Pref   : Asis.Element := El;
      --  Pref represents the (left) part of the argument name that has not
      --  been traversed yet

      Result : Asis.Element := Selector (El);
      --  The selector part of the current Pref

      procedure Step_To_The_Left;
      --  Resets the values of Pref and Result, moving them to the beginning
      --  (that is - to the left end) of the name represented by El: as a
      --  result of calling this procedure we should always have Result to be
      --  Selector (Prefix) except we are in the very beginning of El

      procedure Step_To_The_Left is
      begin
         case Expression_Kind (Pref) is
            when Not_An_Expression =>
               --  That is, Pref just is Nil_Element, and we have traversed the
               --  whole name represented by El

               Result := Nil_Element;

            when An_Identifier =>
               --  Approaching the left part of El
               Result := Pref;
               Pref   := Nil_Element;
            when A_Selected_Component =>
               Pref   := Prefix (Pref);

               if Expression_Kind (Pref) = An_Identifier then
                  Result := Pref;
                  Pref := Nil_Element;
               elsif Expression_Kind (Pref) = A_Selected_Component then
                  Result := Selector (Pref);
               else
                  pragma Warnings (Off);
                  Step_To_The_Left;
                  pragma Warnings (On);
               end if;

            when A_Slice                 |
                 An_Explicit_Dereference |
                 An_Indexed_Component    =>
               Pref := Prefix (Pref);

               pragma Warnings (Off);
               Step_To_The_Left;
               pragma Warnings (ON);

            when A_Function_Call =>
               --  A rather exotic case - a function call (or a component
               --  therteof) as a changen element...
               Result := Corresponding_Called_Function (Pref);

            when A_Type_Conversion =>

               Pref := Converted_Or_Qualified_Expression (Pref);

               pragma Warnings (Off);
               Step_To_The_Left;
               pragma Warnings (ON);

            when others =>
               Put_Line (Standard_Error, Debug_Image (Pref));

               if Is_Text_Available (Pref) then
                  Put_Line (Standard_Error, Element_Image (Pref));
               end if;

               pragma Assert (False);
         end case;

      end Step_To_The_Left;

   begin

      while not Is_Nil (Result) loop

         if Is_Function_Declaration (Result) then
            --  Actually, a more detailed analyzis is possible for this case
            exit;
         elsif No (Entity (R_Node (Result)))
           and then
            not Is_Nil (Pref)
         then
            --  We have a case of an expaded name - the Entity field is not
            --  set for a selector, but it is set for a whole expanded name.
            --  So what we now have in Result is what we are looking for:
            exit;

         elsif Is_Nil (Pref) then
            --  That means that we get to the beginning (rightmost identifier)
            --  in the expanded name. It can not be a subcomponent, so:
            exit;
         end if;

         Step_To_The_Left;

      end loop;

      return Result;
   end Get_Whole_Object;

   ------------------------
   -- Has_Address_Clause --
   ------------------------

   function Has_Address_Clause (Def_Name : Asis.Element) return Boolean is
      Object_Decl : constant Asis.Element := Enclosing_Element (Def_Name);

      Corr_Rep_Clauses : constant Asis.Element_List :=
        Corresponding_Representation_Clauses (Object_Decl);

      Result : Boolean := False;
   begin

      for J in Corr_Rep_Clauses'Range loop

         if Representation_Clause_Kind (Corr_Rep_Clauses (J)) =
            An_Attribute_Definition_Clause
           and then
             Attribute_Kind
               (Representation_Clause_Expression (Corr_Rep_Clauses (J))) =
            An_Address_Attribute
           and then
             Is_Equal
               (Corresponding_Name_Definition
                 (Prefix (Representation_Clause_Name
                   (Corr_Rep_Clauses (J)))),
                Def_Name)
         then
            Result := True;
            exit;
         end if;

      end loop;

      return Result;
   end Has_Address_Clause;

   -----------------------
   -- Has_One_Parameter --
   -----------------------

   function Has_One_Parameter (El : Asis.Element) return Boolean is
      Call_Node : Node_Id;
      Result    : Boolean := False;
   begin

      if Expression_Kind (El) = A_Function_Call
        or else
         Statement_Kind (El) = A_Procedure_Call_Statement
        or else
         Statement_Kind (El) = An_Entry_Call_Statement
      then
         Call_Node := Node (El);

         if Nkind (Call_Node) = N_Attribute_Reference then

            if Sinfo.Expressions (Call_Node) /= No_List
              and then
               List_Length (Sinfo.Expressions (Call_Node)) = 1
            then
               Result := True;
            end if;

         else

            if Parameter_Associations (Call_Node) /= No_List
              and then
               List_Length (Parameter_Associations (Call_Node)) = 1
            then
               Result := True;
            end if;

         end if;

      end if;

      return Result;
   end Has_One_Parameter;

   --------------------------------
   -- Has_Positional_Association --
   --------------------------------

   function Has_Positional_Association (El : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin

      if Expression_Kind (El) in
           A_Record_Aggregate .. An_Extension_Aggregate
         --  The condition can be extended
      then

         declare
            Associations : constant Asis.Element_List := Get_Associations (El);
         begin
            if Associations'Length > 0 then
               Result := Is_Positional (Associations (Associations'First));
            end if;
         end;

      end if;

      return Result;
   end Has_Positional_Association;

   ------------------------------
   -- Has_Statements_And_Decls --
   ------------------------------

   function Has_Statements_And_Decls (Decl : Asis.Element) return Boolean is
      Result    : Boolean := False;
   begin

      Result := not Is_Nil (Body_Statements (Decl))
              and then
                not Is_Nil (Body_Declarative_Items (Decl));

      return Result;
   end Has_Statements_And_Decls;

   -------------
   -- Is_Body --
   -------------

   function Is_Body (El : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin

      case Flat_Element_Kind (El) is
         when A_Procedure_Body_Declaration |
              A_Function_Body_Declaration  |
              A_Package_Body_Declaration   |
              A_Task_Body_Declaration      |
              An_Entry_Body_Declaration    =>
            Result := True;
         when  others =>
            null;
      end case;

      return Result;

   end Is_Body;

   ---------------------------
   -- Is_Boolean_Logical_Op --
   ---------------------------

   function Is_Boolean_Logical_Op (Op : Asis.Element) return Boolean is
      Result   : Boolean := False;
      Entity_N : Entity_Id;
   begin

      if Operator_Kind (Op) in An_And_Operator .. An_Xor_Operator then
         Entity_N := Entity (R_Node (Op));

         if Present (Entity_N)
           and then
            Sloc (Entity_N) <= Standard_Location
           and then
            Ekind (Etype (R_Node (Op))) = E_Enumeration_Type
         then
            Result := True;
         end if;

      end if;

      return Result;
   end Is_Boolean_Logical_Op;

   -------------------------------------
   -- Is_Call_To_Attribute_Subprogram --
   -------------------------------------

   function Is_Call_To_Attribute_Subprogram
     (El   : Asis.Element)
      return Boolean
   is
      Result      : Boolean      := False;
      Call_Prefix : Asis.Element := Nil_Element;
   begin

      case Flat_Element_Kind (El) is
         when A_Procedure_Call_Statement =>
            Call_Prefix := Called_Name (El);

         when A_Function_Call =>

            if Is_Prefix_Call (El) then
               Call_Prefix := Prefix (El);
            end if;

         when others =>
            null;
      end case;

      if Expression_Kind (Call_Prefix) = An_Attribute_Reference then
         Result := True;
      end if;

      return Result;

   end Is_Call_To_Attribute_Subprogram;

   ----------------------------------
   -- Is_Call_To_Operator_Function --
   ----------------------------------

   function Is_Call_To_Operator_Function (El : Asis.Element) return Boolean is
      Pref   : Asis.Element;
      Result : Boolean := False;
   begin

      if Expression_Kind (El) = A_Function_Call then

         if not Is_Prefix_Call (El) then
            Result := True;
         else
            Pref := Prefix (El);

            if Expression_Kind (Pref) = A_Selected_Component then
               Pref := Selector (Pref);
            end if;

            Result := Expression_Kind (Pref) = An_Operator_Symbol;

         end if;

      end if;

      return Result;
   end Is_Call_To_Operator_Function;

   -------------------------------------
   -- Is_Call_To_Predefined_Operation --
   -------------------------------------

   function Is_Call_To_Predefined_Operation
     (Call : Asis.Element)
      return Boolean
   is
      Result    : Boolean := False;
      Pref_Node : Node_Id;

      function Is_Call_To_Predefined_Op_Of_User_Type
        (N    : Node_Id)
         return Boolean;
      --  This function covers the cases not covered by
      --  A4G.A_Sem.Defined_In_Standard. For example, a predefined
      --  concatenation for a user-defined one-dimentioal array type

      function Is_Call_To_Predefined_Op_Of_User_Type
        (N    : Node_Id)
         return Boolean
      is
         N_Entity : Node_Id := Empty;
         Result   : Boolean := False;
      begin

         if Nkind (N) in N_Has_Entity then
            N_Entity := Entity (N);
         elsif Nkind (N) in Sinfo.N_Entity then
            N_Entity := N;
         end if;

         Result :=
           Present (N_Entity)
          and then
           not Comes_From_Source (N_Entity)
          and then
           No (Parent (N_Entity))
          and then
           Is_Intrinsic_Subprogram (N_Entity);

         return Result;

      end Is_Call_To_Predefined_Op_Of_User_Type;

   begin

      if Is_Static (Call) then
         Result := True;
      elsif Expression_Kind (Call) = A_Function_Call
        and then
         Function_Call_Parameters (Call)'Length in 1 .. 2
      then
         --  We use the direct access into the GNAT tree
         Pref_Node := R_Node (Call);

         if Nkind (Pref_Node) not in N_Op then
            Pref_Node := Node (Call);
         end if;

         if Nkind (Pref_Node) in N_Op
          and then
            (Defined_In_Standard (Pref_Node)
            or else
             Is_Call_To_Predefined_Op_Of_User_Type (Pref_Node))
         then
            Result := True;
         end if;

      end if;

      return Result;

   end Is_Call_To_Predefined_Operation;

   ---------------
   -- Is_Caller --
   ---------------

   function Is_Caller (El : Asis.Element) return Boolean is
      Spec_El : Asis.Element;
      Result  : Boolean := False;
   begin
      --  Implementation is incomplete!!! ???
      --  Protected operations is a huge hole!!!

      case Flat_Element_Kind (El) is
         when A_Procedure_Declaration |
              A_Function_Declaration  =>

            Result := Trait_Kind (El) /= An_Abstract_Trait;

         when An_Entry_Body_Declaration =>

            Result := True;

         when A_Procedure_Body_Declaration |
              A_Function_Body_Declaration  |
              A_Procedure_Body_Stub        |
              A_Function_Body_Stub         =>

            Spec_El := El;

            if Is_Subunit (El) then
               Spec_El := Corresponding_Body_Stub (El);
            end if;

            Spec_El := Corresponding_Declaration (El);

            Result :=
              Declaration_Kind (Spec_El) not in
                A_Generic_Procedure_Declaration ..
                A_Generic_Function_Declaration;

         when An_Entry_Declaration =>

            if Definition_Kind (Get_Enclosing_Element) =
               A_Protected_Definition
            then
               Result := True;
            end if;

         when others =>
            null;
      end case;

      return Result;
   end Is_Caller;

   ---------------------------
   -- Is_Compomnent_Default --
   ---------------------------

   function Is_Compomnent_Default (Expr : Asis.Element) return Boolean is
      Encl_El : Asis.Element;
      Result  : Boolean := False;
   begin

      if Element_Kind (Expr) = An_Expression then
         Encl_El := Get_Enclosing_Element;

         if Declaration_Kind (Encl_El) = A_Component_Declaration
          and then
            Is_Equal (Expr, Initialization_Expression (Encl_El))
          and then
            Declaration_Kind (Get_Enclosing_Element (Steps_Up => 2)) /=
            A_Single_Protected_Declaration
         then
            Result := True;
         end if;

      end if;

      return Result;
   end Is_Compomnent_Default;

   --------------------------
   -- Is_Control_Structure --
   --------------------------

   function Is_Control_Structure (Stmt : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin

      case Statement_Kind (Stmt) is
         when An_If_Statement                    |
              A_Case_Statement                   |
              A_Loop_Statement                   |
              A_While_Loop_Statement             |
              A_For_Loop_Statement               |
              A_Selective_Accept_Statement       |
              A_Timed_Entry_Call_Statement       |
              A_Conditional_Entry_Call_Statement |
              An_Asynchronous_Select_Statement   =>
            Result := True;
         when others =>
            null;
      end case;

      return Result;
   end Is_Control_Structure;

   --------------
   -- Is_Frame --
   --------------

   function Is_Frame (El : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin

      case Flat_Element_Kind (El) is
         when A_Procedure_Body_Declaration |
              A_Function_Body_Declaration  |
              A_Package_Body_Declaration   |
              An_Entry_Body_Declaration    |
              A_Task_Body_Declaration      |
              A_Block_Statement            |
              An_Extended_Return_Statement |
              An_Accept_Statement          =>

            Result := True;
         when others =>
            null;
      end case;

      return Result;
   end Is_Frame;

   ----------------------
   -- Is_From_Standard --
   ----------------------

   function Is_From_Standard (El : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin

      if not Is_Nil (El) then
         Result := Sloc (Node (El)) <= Standard_Location;
      end if;

      return Result;
   end Is_From_Standard;

   -----------------------------
   -- Is_Function_Declaration --
   -----------------------------

   function Is_Function_Declaration (El : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin

      case Declaration_Kind (El) is
         when A_Function_Declaration          |
              A_Function_Body_Declaration     |
              A_Function_Body_Stub            |
              A_Function_Renaming_Declaration |
              A_Function_Instantiation        |
              A_Formal_Function_Declaration   |
              A_Generic_Function_Declaration  =>

            Result := True;

         when others =>
            null;
      end case;

      return Result;
   end Is_Function_Declaration;

   ---------------------------
   -- Is_Indefinite_Subtype --
   ---------------------------

   function Is_Indefinite_Subtype (SM : Asis.Element) return Boolean is
      Result    : Boolean      := False;
      SM_Entity : Entity_Id;
   begin

      if Expression_Kind (SM) = A_Selected_Component
       or else
         Expression_Kind (SM) = An_Identifier
      then
         SM_Entity := Entity (R_Node  (SM));

         pragma Assert (Ekind (SM_Entity) in Einfo.Type_Kind);

         Result := not Is_Constrained (SM_Entity);

      end if;

      return Result;
   end Is_Indefinite_Subtype;

   -------------------
   -- Is_Controlled --
   -------------------

   function Is_Controlled (Type_Name : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin
      if Defining_Name_Kind (Type_Name) = A_Defining_Identifier then
         if Is_Controlled (R_Node (Type_Name)) then
            Result := True;
         end if;
      end if;

      return Result;
   end Is_Controlled;

   ---------------------
   -- Is_Dynamic_Call --
   ---------------------

   function Is_Dynamic_Call (Call : Asis.Element) return Boolean is
      Tmp    : Asis.Element;
      Result : Boolean := False;
   begin

      if Expression_Kind (Call) = A_Function_Call then
         Tmp := Prefix (Call);
      else
         Tmp := Called_Name (Call);
      end if;

      if Expression_Kind (Tmp) = An_Explicit_Dereference
        or else
         Is_True_Expression (Tmp)
      then
         --  If the prefix of a (procedure or function) call is a true
         --  expression that is, if it has a type, the only possibility for
         --  this prefix is to be of an access to procedure/function type, so
         Result := True;
      end if;

      return Result;
   end Is_Dynamic_Call;

   ------------------------------
   -- Is_Enum_Literal_Renaming --
   ------------------------------

   function Is_Enum_Literal_Renaming (El : Asis.Element) return Boolean is
      Result         : Boolean := False;
      Renamed_Entity : Entity_Id;
   begin
      if Declaration_Kind (El) = A_Function_Renaming_Declaration then

         Renamed_Entity := Sinfo.Name (Node (El));
         Renamed_Entity := Entity (Renamed_Entity);

         if Present (Renamed_Entity)
           and then
            Ekind (Renamed_Entity) = E_Enumeration_Literal
         then
            Result := True;
         end if;

      end if;

      return Result;
   end Is_Enum_Literal_Renaming;

   ------------------
   -- Is_Exec_Call --
   ------------------

   function Is_Exec_Call (El : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin
      case Flat_Element_Kind (El) is
         when A_Function_Call            |
              A_Procedure_Call_Statement |
              An_Entry_Call_Statement    =>

            Result := True;
         when others =>
            null;
      end case;

      return Result;
   end Is_Exec_Call;

   --------------
   -- Is_Float --
   --------------

   function Is_Float (Expr : Asis.Element) return Boolean is
      Result      : Boolean := False;
      Type_Entity : Entity_Id;
   begin

      if Asis.Extensions.Is_True_Expression (Expr) then
         Type_Entity := Etype (R_Node (Expr));
         Result      := Ekind (Type_Entity) in Float_Kind;
      end if;

      return Result;

   end Is_Float;

   ----------------
   -- Is_Handled --
   ----------------

   function Is_Handled
     (Exc  : Asis.Element;
      By   : Asis.Element_List)
      return Boolean
   is
      Exc_To_Catch : Asis.Element := Exc;
      Result       : Boolean  := False;
      Last_Handler : Boolean := True;
   begin

      if By'Length > 0 then

         if Declaration_Kind (Enclosing_Element (Exc_To_Catch)) =
            An_Exception_Renaming_Declaration
         then
            Exc_To_Catch :=
              Get_Name_Definition
                (Renamed_Entity (Enclosing_Element (Exc_To_Catch)));
         end if;

         Traverse_Handlers : for J in reverse By'Range loop

            declare
               Handled_Excs : constant Asis.Element_List :=
                 Exception_Choices (By (J));
            begin

               if Last_Handler
                 and then
                  Definition_Kind (Handled_Excs (Handled_Excs'Last)) =
                  An_Others_Choice
               then
                  Result := True;
                  exit Traverse_Handlers;
               end if;

               Last_Handler := False;

               for K in Handled_Excs'Range loop

                  if Is_Equal
                       (Get_Name_Definition (Handled_Excs (K)),
                        Exc_To_Catch)
                  then
                     Result := True;
                     exit Traverse_Handlers;
                  end if;

               end loop;

            end;

         end loop Traverse_Handlers;

      end if;

      return Result;
   end Is_Handled;

   ----------------
   -- Is_Limited --
   ----------------

   function Is_Limited (SM : Asis.Element) return Boolean is
      Type_Entity : Entity_Id;
      Result      : Boolean := False;
   begin

      case Expression_Kind (SM) is
         when An_Identifier          |
              A_Selected_Component   |
              An_Attribute_Reference =>

            Type_Entity := Etype (R_Node (SM));

            Result :=
              Is_Limited_Type (Type_Entity)
             or else
              (Is_Interface (Type_Entity)
              and then
               Is_Limited_Interface (Type_Entity));

         when others =>
            null;
      end case;

      return Result;
   end Is_Limited;

   ---------------------------------
   -- Is_Non_Executable_Construct --
   ---------------------------------

   function Is_Non_Executable_Construct (El : Asis.Element) return Boolean is
      Corr_Decl : Asis.Element;
      Tmp       : Asis.Element;
      Result    : Boolean := False;
   begin

      --  Some nonexecutable constructs may include some other non-executable
      --  constructs. From the performance point of view, the more code we
      --  exclude as non-executable when building the call graph - the better.
      --  That's why we consider the whole task type declaration as a
      --  non-executable context instead of excluding separately the profiles
      --  in the entry declarations. But we cannot exclude the tack object -
      --  it may contain function calls in representation clauses

      case Flat_Element_Kind (El) is
         when A_Private_Type_Declaration      |
              A_Parameter_Specification       | -- in a body declaration
              A_Generic_Procedure_Declaration |
              A_Generic_Function_Declaration  |
              A_Generic_Package_Declaration =>
            Result := True;

         when A_Procedure_Body_Declaration |
              A_Function_Body_Declaration  |
              A_Package_Body_Declaration   |
              A_Task_Body_Declaration      |
              A_Protected_Body_Declaration =>

            if Is_Subunit (El) then

               --  We have to traverse a possible chain of "nested" subunits
               Corr_Decl := Corresponding_Body_Stub (El);
               Tmp       := Corresponding_Declaration (Corr_Decl);

               if not Is_Nil (Tmp) then
                  Corr_Decl := Tmp;
               end if;

               if Flat_Element_Kind (Corr_Decl) in
                  A_Generic_Procedure_Declaration ..
                    A_Generic_Package_Declaration
               then
                  Result := True;
               else
                  --  We are in some unit, and we do not know if this
                  --  unit is an executable unit
                  Corr_Decl := Enclosing_Element (Corr_Decl);

                  while not Is_Nil (Corr_Decl) loop
                     Result := Is_Non_Executable_Construct (Corr_Decl);

                     if Result then
                        exit;
                     else
                        Corr_Decl := Enclosing_Element (Corr_Decl);
                     end if;

                  end loop;

               end if;

            else

               if Flat_Element_Kind (Corresponding_Declaration (El)) in
                  A_Generic_Procedure_Declaration ..
                    A_Generic_Package_Declaration
               then
                  Result := True;
               end if;

            end if;

         when Flat_Expression_Kinds =>

            if Is_Compomnent_Default (El) then
               Result := True;
            end if;

         when others =>
            null;
      end case;

      return Result;
   end Is_Non_Executable_Construct;

   -------------------
   -- Is_Positional --
   -------------------

   function Is_Positional (El : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin

      if not Is_Normalized (El) then

         case Association_Kind (El) is
            when A_Pragma_Argument_Association |
                 A_Parameter_Association       |
                 A_Generic_Association         =>
               Result := Is_Nil (Formal_Parameter (El));
            when A_Discriminant_Association =>
               Result := Is_Nil (Discriminant_Selector_Names (El));
            when A_Record_Component_Association =>
               Result := Is_Nil (Record_Component_Choices (El));
            when An_Array_Component_Association =>
               Result := Is_Nil (Array_Component_Choices (El));
            when others =>
               null;
         end case;

      end if;

      return Result;
   end Is_Positional;

   -------------------
   -- Is_Predefined --
   -------------------

   function Is_Predefined (Operation : Asis.Element) return Boolean is
      Tmp_Element : Asis.Element;
      Op_Entity   : Entity_Id := Empty;
      Result      : Boolean := False;
   begin

      if Expression_Kind (Operation) = An_Operator_Symbol
        and then
         Is_Uniquely_Defined (Operation)
      then

         Tmp_Element := Corresponding_Name_Definition (Operation);

         if Is_Nil (Tmp_Element) then
            --  This also includes the case of "/=" implicitly declared by
            --  an explicit declaration of "="

            Tmp_Element := Enclosing_Element (Operation);

            if Expression_Kind (Tmp_Element) = A_Selected_Component then
               Op_Entity := R_Node (Tmp_Element);
            else
               Op_Entity := R_Node (Operation);
            end if;

            if Nkind (Op_Entity) = N_Raise_Constraint_Error then
               Op_Entity := Node (Operation);
            end if;

            if Nkind (Op_Entity) = N_Function_Call then
               Op_Entity := Sinfo.Name (Op_Entity);
            end if;

            Op_Entity := Entity (Op_Entity);

            Result := Sloc (Op_Entity) = Standard_Location;

         end if;
      end if;

      return Result;

   end Is_Predefined;

   --------------------------------------
   -- Is_Predefined_Operation_Renaming --
   --------------------------------------

   function Is_Predefined_Operation_Renaming
     (Ren  : Asis.Element)
      return Boolean
   is
      Op_Entity : Entity_Id;
      Result    : Boolean := False;
   begin

      if Declaration_Kind (Ren) = A_Function_Renaming_Declaration then
         Op_Entity := Defining_Unit_Name (Specification (Node (Ren)));

         if Nkind (Op_Entity) /= N_Defining_Program_Unit_Name
           and then
            Ekind (Op_Entity) = E_Function
         then

            while Present (Alias (Op_Entity)) loop
               Op_Entity := Alias (Op_Entity);
            end loop;

            Result := Defined_In_Standard (Op_Entity);

         end if;

      end if;

      return Result;
   end Is_Predefined_Operation_Renaming;

   ----------------------------------
   -- Is_Prefix_Notation_Exception --
   ----------------------------------

   function Is_Prefix_Notation_Exception (El : Asis.Element) return Boolean is
      Call_Node : Node_Id;
      Result    : Boolean := False;
   begin
      Call_Node := Parent (R_Node (El));

      --  We can be sure, that El is a subprogram call that has at least one
      --  parameter, so Parameter_Associations (Call_Node) definitely presents.
      if List_Length (Parameter_Associations (Call_Node)) <= 2 then
         Result := True;
      else
         Result := R_Node (El) = First (Parameter_Associations (Call_Node));
      end if;

      return Result;
   end Is_Prefix_Notation_Exception;

   ---------------------------------
   -- Is_Protected_Operation_Call --
   ---------------------------------

   function Is_Protected_Operation_Call (Call : Asis.Element) return Boolean is
      Tmp_Node : Node_Id;
      Result   : Boolean := False;
   begin
      Tmp_Node := R_Node (Call);

      if Nkind (Tmp_Node) = N_Entry_Call_Statement then
         Tmp_Node := Prefix (Sinfo.Name (Tmp_Node));
         Tmp_Node := Etype (Tmp_Node);

         if Ekind (Tmp_Node) in Private_Kind then
            Tmp_Node := Full_View (Tmp_Node);
         end if;

         Result := Ekind (Tmp_Node) in Protected_Kind;
      end if;

      return Result;
   end Is_Protected_Operation_Call;

   ------------------------------------
   -- Is_Ref_To_Standard_Num_Subtype --
   ------------------------------------

   function Is_Ref_To_Standard_Num_Subtype
     (Ref  : Asis.Element)
      return Boolean
   is
      Result     : Boolean := False;
      Arg_Entity : Entity_Id;
   begin
      Arg_Entity := Node (Ref);

      if No (Entity (Arg_Entity))
        and then
         Nkind (Parent (Arg_Entity)) = N_Expanded_Name
        and then
         Arg_Entity = Selector_Name (Parent (Arg_Entity))
      then
         Arg_Entity := Parent (Arg_Entity);
      end if;

      Arg_Entity := Entity (Arg_Entity);

      if Present (Arg_Entity)
        and then
         Sloc (Arg_Entity) = Standard_Location
        and then
         Ekind (Arg_Entity) in Numeric_Kind
      then
         Result := True;
      end if;

      return Result;

   end Is_Ref_To_Standard_Num_Subtype;

   ---------------
   -- Is_Public --
   ---------------

   function Is_Public (Def_Name : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin

      case Defining_Name_Kind (Def_Name) is
         when A_Defining_Identifier .. A_Defining_Operator_Symbol =>
            Result := not Is_Hidden (Node (Def_Name));
         when A_Defining_Expanded_Name =>
            Result := not Is_Hidden (Node (Defining_Selector (Def_Name)));
         when others =>
            null;
      end case;

      return Result;
   end Is_Public;

   -----------------
   -- Is_Renaming --
   -----------------

   function Is_Renaming (El : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin
      --  A very simple test at the moment

      case Flat_Element_Kind (El) is
         when A_Procedure_Renaming_Declaration |
              A_Function_Renaming_Declaration  =>
            Result := True;
         when others =>
            null;
      end case;

      return Result;
   end Is_Renaming;

   --------------
   -- Is_Scope --
   --------------

   function Is_Scope (El : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin
      case Flat_Element_Kind (El) is
         when A_Procedure_Body_Declaration |
              A_Function_Body_Declaration  |
              An_Entry_Body_Declaration    |
              A_Task_Body_Declaration      =>

            --  Note, that the treatment of task and protected entries is
            --  different. We consider only protected entries, but not task
            --  entries as callable entities

            Result := True;

         when  A_Package_Declaration      |
               A_Package_Body_Declaration |
               A_Package_Instantiation    =>

            --  We consider library-level packages and package instantiations
            --  as scopes

            if Is_Nil (Enclosing_Element (El))
             and then
               Unit_Class (Enclosing_Compilation_Unit (El)) /= A_Separate_Body
            then
               Result := True;
            end if;

         when others =>
            null;
      end case;

      return Result;
   end Is_Scope;

   -------------------------
   -- Is_Standard_Boolean --
   -------------------------

   function Is_Standard_Boolean (Expr : Asis.Element) return Boolean is
      Result      : Boolean := False;
      Type_Entity : Entity_Id;
   begin

      if Asis.Extensions.Is_True_Expression (Expr) then
         Type_Entity := Etype (R_Node (Expr));
         Result      := Type_Entity = Standard_Boolean;
      end if;

      return Result;

   end Is_Standard_Boolean;

   ----------------------
   -- Is_Task_Creation --
   ----------------------

   function Is_Task_Creation (El : Asis.Element) return Boolean is
      Arg_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (El);
      Result   :          Boolean := False;
   begin

      case Arg_Kind is
         when A_Variable_Declaration |
              A_Constant_Declaration =>
            Result := Is_Task_Object_Declaration (El);
         when A_Single_Task_Declaration =>
            Result := True;
         when others =>
            null;
      end case;

      return Result;
   end Is_Task_Creation;

   ------------------------
   -- Is_Task_Entry_Call --
   ------------------------

   function Is_Task_Entry_Call (Call : Asis.Element) return Boolean is
      Pref_Node      : Node_Id;
      Pref_Type_Node : Entity_Id;
      Result         : Boolean   := False;
   begin

      if Statement_Kind (Call) = An_Entry_Call_Statement then
         Pref_Node      := Node (Called_Name (Call));

         if Nkind (Pref_Node) = N_Indexed_Component then
            --  Call to an entry from an entrty family
            Pref_Node := Prefix (Pref_Node);
         end if;

         Pref_Type_Node := Etype (Pref_Node);

         if (No (Pref_Type_Node)
            or else
             Ekind (Pref_Type_Node) = E_Void)
           and then
             Nkind (Pref_Node) = N_Selected_Component
         then
            Pref_Node      := Sinfo.Prefix (Pref_Node);
            Pref_Type_Node := Etype (Pref_Node);
         end if;

         if Present (Pref_Type_Node)
           and then
            Ekind (Pref_Type_Node) in
              E_Private_Type .. E_Limited_Private_Subtype
         then
            Pref_Type_Node := Full_View (Pref_Type_Node);
         end if;

         Result := Ekind (Pref_Type_Node) in Task_Kind;
      end if;

      return Result;
   end Is_Task_Entry_Call;

   --------------------------------
   -- Is_Task_Object_Declaration --
   --------------------------------

   function Is_Task_Object_Declaration (Expr : Asis.Element) return Boolean is
      N      : Node_Id;
      Result : Boolean := False;
   begin

      case Flat_Element_Kind (Expr) is
         when A_Variable_Declaration |
              A_Constant_Declaration =>

            N := Defining_Identifier (R_Node (Expr));
            N := Etype (N);

            Result := Ekind (N) in Task_Kind;
         when others =>
            null;
      end case;

      return Result;
   end Is_Task_Object_Declaration;

   ------------------------
   -- Is_Template_Caller --
   ------------------------

   function Is_Template_Caller (El : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin
      case Flat_Element_Kind (El) is
         when A_Task_Type_Declaration =>
            Result := True;
         when others =>
            null;
      end case;

      return Result;
   end Is_Template_Caller;

   ----------------------------
   -- Is_Unconstrained_Array --
   ----------------------------

   function Is_Unconstrained_Array (Type_Decl : Asis.Element) return Boolean is
      Type_Entity : Entity_Id;
      Result      : Boolean := False;
   begin

      if Declaration_Kind (Type_Decl) = An_Ordinary_Type_Declaration
        or else
         Declaration_Kind (Type_Decl) = A_Subtype_Declaration
      then
         Type_Entity := R_Node (Names (Type_Decl) (1));

         if Is_Array_Type (Type_Entity)
           and then
            not Is_Constrained (Type_Entity)
         then
            Result := True;
         end if;

      end if;

      return Result;

   end Is_Unconstrained_Array;

   -----------------
   -- Is_Volatile --
   -----------------

   function Is_Volatile (Def_Name : Asis.Element) return Boolean is
      Object_Decl  : constant Asis.Element := Enclosing_Element (Def_Name);
      Corr_Pragmas : constant Asis.Element_List :=
        Corresponding_Pragmas (Object_Decl);
      Tmp          : Asis.Element;

      Result : Boolean := False;
   begin

      --  Note, that the implementation of this function depends on our
      --  representation of the rule about volatile objects and address clauses
      --  that has been formulated rather vaguely by the customer

      --  Two possibilities here: either a pragma Volatile is applied to the
      --  object, or - to its type

      for J in Corr_Pragmas'Range loop

         if Pragma_Kind (Corr_Pragmas (J)) = A_Volatile_Pragma then
            Tmp := Pragma_Argument_Associations (Corr_Pragmas (J)) (1);
            Tmp := Actual_Parameter (Tmp);

            if Expression_Kind (Tmp) = An_Identifier then
               Tmp := Corresponding_Name_Definition (Tmp);

               if Is_Equal (Tmp, Def_Name) then
                  Result := True;
                  exit;
               end if;

            end if;
         end if;

      end loop;

      if not Result then
         --  We have to check the type of the object
         Tmp := Object_Declaration_View (Object_Decl);

         if Definition_Kind (Tmp) = A_Subtype_Indication then
            Tmp := Asis.Definitions.Subtype_Mark (Tmp);

            Result := Is_Volatile_Type (Tmp);

         end if;

      end if;

      return Result;
   end Is_Volatile;

   ----------------------
   -- Is_Volatile_Type --
   ----------------------

   function Is_Volatile_Type (Subtype_Ref : Asis.Element) return Boolean is
      Tmp        : Asis.Element;
      Pragma_Arg : Asis.Element;
      Result     : Boolean := False;
   begin

      if Attribute_Kind (Subtype_Ref) /= A_Class_Attribute then
         Tmp := Normalize_Reference (Subtype_Ref);
         Tmp := Corresponding_Name_Declaration (Tmp);
         Tmp := Corresponding_First_Subtype (Tmp);

         if Declaration_Kind (Tmp) = An_Ordinary_Type_Declaration then

            declare
               Corr_Pragmas : constant Asis.Element_List :=
                 Corresponding_Pragmas (Tmp);
            begin

               for J in Corr_Pragmas'Range loop

                  if Pragma_Kind (Corr_Pragmas (J)) = A_Volatile_Pragma then
                     Pragma_Arg :=
                       Pragma_Argument_Associations (Corr_Pragmas (J)) (1);

                     Pragma_Arg := Actual_Parameter (Pragma_Arg);

                     if Expression_Kind (Pragma_Arg) = An_Identifier then
                        Pragma_Arg :=
                          Corresponding_Name_Definition (Pragma_Arg);

                        if Is_Equal (Pragma_Arg, Names (Tmp) (1)) then
                           Result := True;
                           exit;
                        end if;

                     end if;
                  end if;

               end loop;

               if not Result then
                  Tmp := Type_Declaration_View (Tmp);

                  if Asis.Elements.Type_Kind (Tmp) =
                    A_Derived_Type_Definition
                  then
                     --  Here we have to traverse the derivation chain looking
                     --  for the Volatile pragma applied to some of the parent
                     --  types

                     Tmp    := Parent_Subtype_Indication (Tmp);
                     Tmp    := Asis.Definitions.Subtype_Mark (Tmp);
                     Result := Is_Volatile_Type (Tmp);
                  end if;

               end if;

            end;

         end if;

      end if;

      return Result;
   end Is_Volatile_Type;

   --------------------------
   -- Look_For_Loop_Pre_Op --
   --------------------------

   procedure Look_For_Loop_Pre_Op
     (Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Boolean)
   is
   begin

      case Element_Kind (Element) is
         when A_Statement =>

            case Statement_Kind (Element) is
               when An_If_Statement                    |
                    A_Case_Statement                   |
                    A_Block_Statement                  |
                    An_Extended_Return_Statement       |
                    An_Accept_Statement                |
                    A_Selective_Accept_Statement       |
                    A_Timed_Entry_Call_Statement       |
                    A_Conditional_Entry_Call_Statement |
                    An_Asynchronous_Select_Statement   =>
                  null;
               when A_Loop_Statement       |
                    A_While_Loop_Statement |
                    A_For_Loop_Statement   =>

                  State   := True;
                  Control := Terminate_Immediately;

               when others =>
                  Control := Abandon_Children;
            end case;

         when A_Path =>
            null;
         when others =>
            Control := Abandon_Children;
      end case;

   end Look_For_Loop_Pre_Op;

   ---------------------------
   -- Look_For_Loop_Post_Op --
   ---------------------------

   procedure Look_For_Loop_Post_Op
     (Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Boolean)
   is
      pragma Unreferenced (Element, Control, State);
   begin
      null;
   end Look_For_Loop_Post_Op;

   ----------------------
   -- Needs_Completion --
   ----------------------

   function Needs_Completion (El : Asis.Element) return Boolean is
      Arg_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (El);
      Result   : Boolean                     := False;
      Entity_N : Entity_Id;
   begin

      case Arg_Kind is
         when A_Task_Type_Declaration        |
              A_Protected_Type_Declaration   |
              A_Single_Task_Declaration      |
              A_Single_Protected_Declaration |
              A_Procedure_Body_Stub          |
              A_Function_Body_Stub           |
              A_Package_Body_Stub            |
              A_Task_Body_Stub               |
              A_Protected_Body_Stub          =>
            Result := True;

         when A_Package_Declaration         |
              A_Generic_Package_Declaration =>

            --  Now we make the check for library packages only!

            if Is_Nil (Enclosing_Element (El)) then
               Result :=
                 Asis.Compilation_Units.Is_Body_Required
                   (Enclosing_Compilation_Unit (El));
            end if;

         when A_Generic_Procedure_Declaration |
              A_Generic_Function_Declaration  |
              A_Procedure_Declaration         |
              A_Function_Declaration          =>

            Entity_N := Defining_Unit_Name (Specification (Node (El)));

            if Nkind (Entity_N) = N_Defining_Program_Unit_Name then
               Entity_N := Defining_Identifier (Entity_N);
            end if;

            if not (Is_Intrinsic_Subprogram (Entity_N)
                 or else
                    Is_Imported (Entity_N))
            then
               Result := True;
            end if;

         when others =>
            null;
      end case;

      return Result;
   end Needs_Completion;

   -------------------------
   -- Normalize_Reference --
   -------------------------

   function Normalize_Reference (Ref : Asis.Element) return Asis.Element is
      Result : Asis.Element := Ref;
   begin
      case Expression_Kind (Ref) is
         when A_Selected_Component =>
            Result := Selector (Ref);
         when An_Attribute_Reference =>
            Result := Normalize_Reference (Prefix (Ref));
         when others =>
            null;
      end case;

      return Result;
   end Normalize_Reference;

   --------------------------------------
   -- Unwind_Derivations_And_Subtyping --
   --------------------------------------

   function Unwind_Derivations_And_Subtyping
     (Decl : Asis.Element)
      return Asis.Element
   is
      Result : Asis.Element := Decl;
      Def    : Asis.Element := Type_Declaration_View (Result);
   begin

      if Definition_Kind (Def) = A_Subtype_Indication then
         Result := Corresponding_First_Subtype (Def);
         Def    := Type_Declaration_View (Result);
      end if;

      if Asis.Elements.Type_Kind (Def) in A_Derived_Type_Definition ..
            A_Derived_Record_Extension_Definition
      then
         Result := Corresponding_Root_Type (Def);
      end if;

      return Result;

   end Unwind_Derivations_And_Subtyping;

   -------------------------------
   -- Used_To_Pass_Actual_Subpr --
   -------------------------------

   function Used_To_Pass_Actual_Subpr (El : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin

      if Declaration_Kind (El) in A_Procedure_Renaming_Declaration ..
        A_Function_Renaming_Declaration
      then
         Result := Pass_Generic_Actual (Node (El));
      end if;

      return Result;
   end Used_To_Pass_Actual_Subpr;

end Gnatcheck.ASIS_Utilities;
