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

pragma Ada_2012;

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

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.Debug;
with ASIS_UL.Misc;               use ASIS_UL.Misc;
with ASIS_UL.Utilities;          use ASIS_UL.Utilities;

with GNAT.Table;

with Atree;                      use Atree;
with Einfo;                      use Einfo;
with Elists;                     use Elists;
with Namet;                      use Namet;
with Nlists;                     use Nlists;
with Sem_Aux;                    use Sem_Aux;
with Sinfo;                      use Sinfo;
with Snames;                     use Snames;
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.Int_Knds;               use A4G.Int_Knds;
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 GNAT.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 Has_Predicate (Type_E : Entity_Id) return Boolean with
      Pre => Is_Type (Type_E);
   --  Checks if the argument denotes a subtype with dynamic predicate. Assumes
   --  the Type_E denotes a (sub)type.

   function Is_Constr_Error_Declaration (Decl : Asis.Element) return Boolean;
   function Is_Num_Error_Declaration (Decl : Asis.Element) return Boolean;
   --  Checks if the argument represents the declaration of the predefined
   --  exception Constraint_Error/Numeric_Error

   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;
   pragma Unreferenced (Get_Called_Task);
   --  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 Empty_Bool_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    => Empty_Bool_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.

   procedure Check_For_Discr_Reference
     (Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Boolean);
   --  If Element is An_Identifier, checks if it is reference to discriminant;
   --  and if it is - sets State ON and terminates traversing

   procedure Check_For_Discriminant_Reference is new Traverse_Element
     (State_Information => Boolean,
      Pre_Operation     => Check_For_Discr_Reference,
      Post_Operation    => Empty_Bool_Post_Op);
   --  Checks if Element has a reference to a discriminant

   function Is_Ancestor
     (Ancestor : Entity_Id;
      Source   : Entity_Id)
      return     Boolean;
   --  Assumes that both arguments are interface type entities. Check if
   --  Ancestor is indeed an ancestor of Source

   --  The folowing stuff is needed for No_Inherited_Classwide_Pre rule. The
   --  implementation of the rule is far from being good, so this definitely
   --  needs revision at some point. At least to eliminate code duplications.

   type List_Of_Nodes is array (Natural range <>) of Node_Id;
   function Get_Overridden_Ops (Op : Asis.Element) return List_Of_Nodes;
   function Get_Overridden_Ops (Op : Entity_Id) return List_Of_Nodes;
   --  Assuming that Op is a declaration of an overridding operation, gets a
   --  full list of operations (their entity nodes) that are overridden or
   --  implemented by this declaration.
   --
   --  The Get_Overridden_Ops function that works directly on operation entity
   --  node does NOT include in the result the operation pointed by the
   --  Overridden_Operation (Op) link

   function Primitive_Owner (Op : Entity_Id) return Entity_Id;
   --  Assuming that Op is a discpatching operation, returns the type for that
   --  this operation is defined. In case of private types/extensions a private
   --  view is returned.

   function Overridden_Interface_Ops
     (Type_Entity : Entity_Id;
      Op_Entity   : Entity_Id)
      return   List_Of_Nodes;
   --  Assuming that Type_Entity is a tagged type entity node, and Op_Entity
   --  is an entity node of a primitive of this type, returns the list of
   --  interface primitibes that are implemented by Op_Entity.

   function Has_Class_Wide_Pre (Op : Entity_Id) return Boolean;
   --  Checks if Op has an explicitly defined or inherited Pre'Class attribute
   --  specified for it.

   function Contract_Contains_Pre_Class (C : Node_Id) return Boolean;
   --  Assuming that C is of N_Contract kind checks if it defines class-wide
   --  Precondition

   function Add_Scope_Name (El : Asis.Element) return String;
   --  Assumes that El is an Element where
   --  Gnatcheck.Rules.Traversing.All_Rules_Pre_Op stands now (needed to apply
   --  fast Get_Enclosing_Element instead of standard Enclosing_Element query).
   --  returns the full Ada name of the inermost scope that encloses El.
   --  Returns an empty string if there is no such scope (library-level
   --  renaming or instantiation, compilation pragmas etc.)

   function Is_Named_Scope (E : Asis.Element) return Boolean;
   --  Checks if E is a named scope (in a sense needed to add the scope name
   --  in the diagnostic message if -dJ is specified).

   function Encl_Scope_Full_Name (El : Asis.Element) return String;
   --  Returns the full expanded Ada name of a scope that encloses El (not
   --  counting El itself if El is also a scope) with a dot character appended.
   --  Return an empty string if El is a library-level declaration

   function Overloading_Index (El : Asis.Element) return String;
   --  Assuming that Is_Named_Scope (El), and that El is a subprogram body,
   --  checks if there are other subprograms in the same declarative region
   --  that overloads this subprogram and precedes this one. If there are some,
   --  returns string of the forms "#n" where 'n' is a positional number of
   --  this subprogram in sequence of overloaded subprograms, otherwise an
   --  empty string is returned. Note, that when computing this chain and
   --  detecting this number, we do not consider subprogram body/stub/renaming
   --  declarations that are completions of other declarations, that is we are
   --  trying to follow the compiler's way of computing this suffix if -gnatdJ
   --  is set.

   --------------------
   -- Add_Scope_Name --
   --------------------

   function Add_Scope_Name (El : Asis.Element) return String is
      Step_Up         : Elmt_Idx     := 0;
      Enclosing_Scope : Asis.Element := Nil_Element;
      EE              : Asis.Element := El;
   begin
      while not Is_Nil (EE) loop
         if Is_Named_Scope (EE) then
            Enclosing_Scope := EE;
            exit;
         end if;

         EE      := Get_Enclosing_Element (Step_Up);
         Step_Up := Step_Up + 1;
      end loop;

      if Is_Nil (Enclosing_Scope) then
         return "";
      else
         return Encl_Scope_Full_Name (Enclosing_Scope)                 &
                To_String
                  (Defining_Name_Image (First_Name (Enclosing_Scope))) &
                Overloading_Index (Enclosing_Scope)                    &
                ":" & Build_GNAT_Location (Enclosing_Scope, 0, 0);
      end if;

   end Add_Scope_Name;

   ---------------------------
   -- 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_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 Names (Params (J))'Length > 1 then
                           Result := False;
                           exit;
                        end if;

                        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;

   -----------------------------------
   -- Check_Classwide_Pre_Vioaltion --
   -----------------------------------

   procedure Check_Classwide_Pre_Vioaltion
     (Op       : Asis.Element;
      Detected : out Boolean;
      At_SLOC  : out String_Loc)
   is
      Overridden_Ops : constant List_Of_Nodes := Get_Overridden_Ops (Op);
      Template_El    : Asis.Element := Nil_Element;
   begin
      Detected := False;
      At_SLOC := Nil_String_Loc;

      for J in Overridden_Ops'Range loop
         if not Has_Class_Wide_Pre (Overridden_Ops (J)) then
            Detected := True;
            Set_Encl_Unit_Id (Template_El, Encl_Unit_Id (Op));
            Set_Node (Template_El, Overridden_Ops (J));
            At_SLOC :=
              Enter_String ("%1%" & Build_GNAT_Location (Template_El));
            exit;
         end if;
      end loop;

   end Check_Classwide_Pre_Vioaltion;

   -------------------------------
   -- Check_For_Discr_Reference --
   -------------------------------

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

      case Expression_Kind (Element) is
         when An_Identifier =>

            begin
               if Declaration_Kind (Corresponding_Name_Declaration (Element)) =
                    A_Discriminant_Specification
               then
                  State   := True;
                  Control := Terminate_Immediately;
               end if;
            exception
               when Asis.Exceptions.ASIS_Inappropriate_Element =>
                  null;
            end;

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

   end Check_For_Discr_Reference;

   ----------------------------------------
   -- Constraint_Depends_On_Discriminant --
   ----------------------------------------

   function Constraint_Depends_On_Discriminant
     (Constr : Asis.Element)
      return   Boolean
   is
      Control : Traverse_Control := Continue;
      Result  : Boolean          := False;
   begin

      if Constraint_Kind (Constr) in
           An_Index_Constraint | A_Discriminant_Constraint
      then
         Check_For_Discriminant_Reference
           (Element => Constr, Control => Control, State => Result);
      end if;

      return Result;
   end Constraint_Depends_On_Discriminant;

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

   ---------------------------------
   -- Contract_Contains_Pre_Class --
   ---------------------------------

   function Contract_Contains_Pre_Class (C : Node_Id) return Boolean is
      Result   : Boolean := False;
      N_Pragma : Node_Id;
   begin
      pragma Assert (Nkind (C) = N_Contract);

      N_Pragma := Pre_Post_Conditions (C);

      while Present (N_Pragma) loop

         if Chars (Pragma_Identifier (N_Pragma)) = Name_Precondition
          and then
            Class_Present (N_Pragma)
         then
            Result := True;
            exit;
         end if;

         N_Pragma := Next_Pragma (N_Pragma);
      end loop;

      return Result;
   end Contract_Contains_Pre_Class;

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

   ------------------------
   -- Defines_Components --
   ------------------------

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

      if Declaration_Kind (Decl) = An_Ordinary_Type_Declaration then

         Type_Def := Type_Declaration_View (Decl);

         case Asis.Elements.Type_Kind (Type_Def) is
            when A_Derived_Record_Extension_Definition |
                 A_Record_Type_Definition              |
                 A_Tagged_Record_Type_Definition       =>
               Result := True;
            when others =>
               null;
         end case;

      end if;

      return Result;

   end Defines_Components;

   ----------------------------
   -- Denotes_Access_Subtype --
   ----------------------------

   function Denotes_Access_Subtype (N : Asis.Element) return Boolean is
   begin
      return Ekind (Node (N)) in Access_Kind;
   end Denotes_Access_Subtype;

   --------------------------------
   -- Denotes_Class_Wide_Subtype --
   --------------------------------

   function Denotes_Class_Wide_Subtype (N : Asis.Element) return Boolean is
      E      : Entity_Id;
      Result : Boolean := False;
   begin

      E := R_Node (N);

      if Nkind (E) in  N_Expanded_Name | N_Identifier then
         E := Entity (E);

         if Present (E) then
            Result := Ekind (E) = E_Class_Wide_Subtype;
         end if;
      end if;

      return Result;
   end Denotes_Class_Wide_Subtype;

   ------------------------------------
   -- Denotes_Subtype_With_Predicate --
   ------------------------------------

   function Denotes_Subtype_With_Predicate
     (E    : Asis.Element)
      return Boolean
   is
      Result : Boolean := False;
      N      : Node_Id;
      E_Id   : Entity_Id;
   begin
      if Expression_Kind (E) not in An_Identifier | A_Selected_Component then
         return False;
      end if;

      N := R_Node (E);

      if Nkind (N) in N_Has_Entity then
         E_Id := Entity (N);

         Result := Present (E_Id)
                 and then
                   Is_Type (E_Id)
                 and then
                   Has_Predicate (E_Id);
      end if;

      return Result;
   end Denotes_Subtype_With_Predicate;

   ---------------------------
   -- Empty_Bool_Post_Op --
   ---------------------------

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

   --------------------------
   -- Encl_Scope_Full_Name --
   --------------------------

   function Encl_Scope_Full_Name (El : Asis.Element) return String is
      Encl_Scope : Asis.Element := Enclosing_Element (El);
   begin
      while not Is_Nil (Encl_Scope)
          and then
            not Is_Named_Scope (Encl_Scope)
      loop
         Encl_Scope := Enclosing_Element (Encl_Scope);
      end loop;

      if Is_Nil (Encl_Scope) then
         return "";
      else
         return Encl_Scope_Full_Name (Encl_Scope)                         &
                To_String (Defining_Name_Image (First_Name (Encl_Scope))) &
                '.';
      end if;

   end Encl_Scope_Full_Name;

   ---------------------------------
   -- From_Subtype_With_Predicate --
   ---------------------------------

   function From_Subtype_With_Predicate
     (E    : Asis.Element)
      return Boolean
   is
      Result : Boolean := False;
      N      : Node_Id;
      E_Id   : Entity_Id;
   begin
      N := R_Node (E);

      if Nkind (N) in N_Has_Etype then
         E_Id := Etype (N);

         Result := Present (E_Id)
                 and then
                   Is_Type (E_Id)
                 and then
                   Has_Predicate (E_Id);
      end if;

      return Result;
   end From_Subtype_With_Predicate;

   -----------------------
   -- Full_View_Visible --
   -----------------------

   function Full_View_Visible
     (Type_Decl : Asis.Declaration;
      At_Place  : Asis.Element)
      return      Boolean
   is
      Result              : Boolean := False;
      Full_View           : Asis.Declaration;
      Enclosing_Pack_Spec : Asis.Declaration;
      Enclosing_Pack_Body : Asis.Declaration;

      Type_Spec_CU     : Asis.Compilation_Unit;
      Type_Body_CU     : Asis.Compilation_Unit := Nil_Compilation_Unit;
      Location_CU      : Asis.Compilation_Unit;
      Next_Parent      : Asis.Compilation_Unit;

      Stub_El          : Asis.Element;
   begin
      --  First, check if we have expected elements and return False if we
      --  do not.

      if Declaration_Kind (Type_Decl) not in
           A_Private_Type_Declaration .. A_Private_Extension_Declaration
        or else
         Is_Part_Of_Implicit (Type_Decl)
        or else
         Is_Part_Of_Implicit (At_Place)
        or else
         Is_Part_Of_Instance (Type_Decl)
        or else
         Is_Part_Of_Instance (At_Place)
      then
         return False;
      end if;

      Full_View           := Corresponding_Type_Declaration (Type_Decl);
      Enclosing_Pack_Spec := Enclosing_Element (Type_Decl);
      Enclosing_Pack_Body := Corresponding_Body (Enclosing_Pack_Spec);

      if Declaration_Kind (Enclosing_Pack_Body) = A_Package_Body_Stub then
         Enclosing_Pack_Body := Corresponding_Subunit (Enclosing_Pack_Body);
      end if;

      Type_Spec_CU := Enclosing_Compilation_Unit (Enclosing_Pack_Spec);
      Location_CU  := Enclosing_Compilation_Unit (At_Place);

      if not Is_Nil (Enclosing_Pack_Body) then
         Type_Body_CU := Enclosing_Compilation_Unit (Enclosing_Pack_Body);
      end if;

      --  Type declaration and location to check are in the same CU:

      if Is_Equal (Type_Spec_CU, Location_CU) then
         if In_Private_Part (Enclosing_Pack_Spec, At_Place) then
            Result := Before (Full_View, At_Place);
         elsif Is_Equal (Type_Body_CU, Location_CU) then
            Result :=
              Inclides (Whole => Enclosing_Pack_Body, Part => At_Place);
         end if;

         return Result;
      end if;

      --  If we are here, then type declaration and location to check are
      --  in different compilation units. First, check if location is in
      --  the body of the package that defines the type. (Subunits are a
      --  pain in this case)

      if not Is_Nil (Type_Body_CU) then

         if not Is_Equal (Type_Body_CU, Location_CU) then

            if Unit_Kind (Location_CU) in A_Subunit then
               Stub_El := Unit_Declaration (Location_CU);
               Stub_El := Corresponding_Body_Stub (Stub_El);
            end if;

            while Unit_Kind (Location_CU) in A_Subunit loop
               exit when Is_Equal (Type_Body_CU, Location_CU);

               Stub_El     := Unit_Declaration (Location_CU);
               Stub_El     := Corresponding_Body_Stub (Stub_El);
               Location_CU := Corresponding_Subunit_Parent_Body (Location_CU);

            end loop;

         else
            Stub_El := At_Place;
         end if;

         if Is_Equal (Type_Body_CU, Location_CU) then
            Result := Inclides (Whole => Enclosing_Pack_Body, Part => Stub_El);
            return Result;
         end if;

      end if;

      --  If we are here, the only possibility when the full view is visible
      --  at a given place is:
      --
      --  - Type_Decl is declared in a visible part of a library package
      --
      --  - At_Place is either in the child unit of this package - either in
      --    the body, or in the private part of the public child, or in the
      --    spec of a private child.

      if (Unit_Kind (Type_Spec_CU) = A_Package
         or else
          Unit_Kind (Type_Spec_CU) = A_Generic_Package)
        and then
          Is_Equal (Enclosing_Element (Type_Decl),
                    Unit_Declaration (Type_Spec_CU))
      then

         while Unit_Kind (Location_CU) in A_Subunit loop
            Location_CU := Corresponding_Subunit_Parent_Body (Location_CU);
         end loop;

         Next_Parent := Location_CU;

         while not Is_Nil (Next_Parent) loop
            exit when Is_Equal (Next_Parent, Type_Spec_CU);
            Next_Parent := Corresponding_Parent_Declaration (Next_Parent);
         end loop;

         if not Is_Equal (Next_Parent, Type_Spec_CU) then
            return False;
         elsif Unit_Kind (Location_CU) in A_Library_Unit_Body then
            return True;
         elsif Unit_Kind (Location_CU) in
                 A_Procedure          |
                 A_Function           |
                 A_Generic_Procedure  |
                 A_Generic_Function   |
                 A_Procedure_Instance |
                 A_Function_Instance  |
                 A_Package_Instance   |
                 A_Procedure_Renaming |
                 A_Function_Renaming
         then
            return False;

         elsif Unit_Kind (Location_CU) = A_Package
             or else
                Unit_Kind (Location_CU) = A_Generic_Package
         then
            if Unit_Class (Location_CU) = A_Private_Declaration
              and then
               Is_Equal (Corresponding_Parent_Declaration (Location_CU),
                         Type_Spec_CU)
            then
               return True;
            else
               Result :=
                 In_Private_Part (Pack    => Unit_Declaration (Location_CU),
                                  Element => At_Place);
               return Result;
            end if;
         end if;

         pragma Assert (False);
         return False;
      end if;

      return False;
   end Full_View_Visible;

   ----------------------
   -- 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_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_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",
            Wrong_Kind => Int_Kind (El));
      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_Overridden_Ops --
   ------------------------

   function Get_Overridden_Ops (Op : Entity_Id) return List_Of_Nodes is
      Type_Entity : Entity_Id := Primitive_Owner (Op);
   begin
      if Ekind (Type_Entity) in E_Private_Type         |
                                E_Limited_Private_Type
      then
         Type_Entity := Full_View (Type_Entity);
      end if;

      return Overridden_Interface_Ops (Type_Entity, Op);
   end Get_Overridden_Ops;

   function Get_Overridden_Ops (Op : Asis.Element) return List_Of_Nodes is
      Result : List_Of_Nodes (1 .. 6000);
      --  6000 looks as infinity here
      Res_Last : Natural := 0;

      Op_Entity           : constant Entity_Id := R_Node (First_Name (Op));
      Directly_Overridded :          Entity_Id;
      Type_Entity         :          Entity_Id;

      Type_Def : Asis.Element;

   begin
      if not Is_Overriding_Operation (Op) then
         return Result (1 .. 0);
      end if;

      if Present (Overridden_Operation (Op_Entity)) then
         Directly_Overridded := Overridden_Operation (Op_Entity);
         Res_Last            := Res_Last + 1;
         Result (Res_Last)   := Directly_Overridded;
      end if;

      --  Check if we may have multiple inheritance:
      Type_Def := Primitive_Owner (Op);

      if Definition_Kind (Type_Def) in
           A_Private_Type_Definition |
           A_Private_Extension_Definition
      then
         Type_Def := Enclosing_Element (Type_Def);
         Type_Def := Corresponding_Type_Completion (Type_Def);
         Type_Def := Type_Declaration_View (Type_Def);
      end if;

      if Int_Kind (Type_Def) not in
           A_Derived_Record_Extension_Definition |
           A_Private_Extension_Definition        |
           Internal_Interface_Kinds              |
           A_Formal_Derived_Type_Definition      |
           Internal_Formal_Interface_Kinds
        or else
         Is_Nil (Definition_Interface_List (Type_Def))
      then
         --  Nothing else to do!
         return Result (1 .. Res_Last);
      end if;

      Type_Def    := First_Name (Enclosing_Element (Type_Def));
      Type_Entity := R_Node (Type_Def);

      return Result (1 .. Res_Last) &
             Overridden_Interface_Ops (Type_Entity, Op_Entity);
   end Get_Overridden_Ops;

   -------------------
   -- 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",
               Wrong_Kind => Int_Kind (Decl));
      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_Underlying_Type --
   -------------------------

   function Get_Underlying_Type
     (SM              : Asis.Element;
      Stop_At_Private : Boolean := False)
      return            Asis.Element
   is
      Result : Asis.Element := Nil_Element;
      Tmp    : Asis.Element := SM;

   begin
      while Attribute_Kind (Tmp) = A_Base_Attribute loop
         Tmp := Prefix (Tmp);
      end loop;

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

      if Expression_Kind (Tmp) = An_Identifier then
         begin
            Tmp := Corresponding_Name_Declaration (Tmp);
         exception
            when Asis.Exceptions.ASIS_Inappropriate_Element =>
               Tmp := Nil_Element;
         end;
      else
         Tmp := Nil_Element;
      end if;

      if Declaration_Kind (Tmp) in
           An_Ordinary_Type_Declaration         |
           A_Task_Type_Declaration              |
           A_Protected_Type_Declaration         |
           An_Incomplete_Type_Declaration       |
           A_Tagged_Incomplete_Type_Declaration |
           A_Private_Type_Declaration           |
           A_Private_Extension_Declaration      |
           A_Subtype_Declaration                |
           A_Formal_Type_Declaration            |
           A_Formal_Incomplete_Type_Declaration
      then
         Result := Unwind_Type (Tmp, Stop_At_Private);
      end if;

      return Result;
   end Get_Underlying_Type;

   ----------------------
   -- 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_Name (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_Class_Wide_Pre --
   ------------------------

   function Has_Class_Wide_Pre (Op : Entity_Id) return Boolean is
      Result : Boolean := False;
      Directly_Overridden_Op : Entity_Id := Empty;
   begin
      if Present (Contract (Op)) then
         Result := Contract_Contains_Pre_Class (Contract (Op));
      end if;

      if not Result then
         Directly_Overridden_Op := Overridden_Operation (Op);

         if Present (Directly_Overridden_Op) then
            Result := Has_Class_Wide_Pre (Directly_Overridden_Op);
         end if;

      end if;

      if not Result then

         declare
            Overridden_Ops : constant List_Of_Nodes := Get_Overridden_Ops (Op);
         begin
            for J in Overridden_Ops'Range loop
               if Overridden_Ops (J) /= Directly_Overridden_Op then
                  Result := Has_Class_Wide_Pre (Overridden_Ops (J));
               end if;

               exit when Result;
            end loop;
         end;

      end if;

      return Result;
   end Has_Class_Wide_Pre;

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

   function Has_One_Parameter (El : Asis.Element) return Boolean is
      Template_El : Asis.Element;
      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;

      elsif Declaration_Kind (El) in A_Generic_Instantiation then
         Template_El := Normalize_Reference (Generic_Unit_Name (El));
         Template_El := Corresponding_Name_Declaration (Template_El);

         if Declaration_Kind (Template_El) in
              A_Generic_Package_Renaming_Declaration ..
              A_Generic_Function_Renaming_Declaration
         then
            Template_El := Corresponding_Base_Entity (Template_El);
            Template_El := Normalize_Reference (Template_El);
            Template_El := Corresponding_Name_Declaration (Template_El);
         end if;

         Result := Generic_Formal_Part (Template_El)'Length = 1;
      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_Predicate --
   -------------------

   function Has_Predicate (Type_E : Entity_Id) return Boolean is
      N      : Node_Id;
      Result : Boolean := False;
   begin
      if Has_Dynamic_Predicate_Aspect (Type_E) then
         Result := True;
      elsif Present (First_Rep_Item (Type_E)) then
         N := First_Rep_Item (Type_E);

         while Present (N) loop
            if Nkind (N) = N_Aspect_Specification
              and then
               Chars (Sinfo.Identifier (N)) in
                 Name_Dynamic_Predicate | Name_Static_Predicate
            then
               Result := True;
               exit;
            end if;

            N := Next_Rep_Item (N);
         end loop;
      end if;

      return Result;
   end Has_Predicate;

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

   function Is_Ancestor
     (Ancestor : Entity_Id;
      Source   : Entity_Id)
      return     Boolean
   is
      Result   : Boolean := False;
      Type_Def : Node_Id;
      Next_T   : Entity_Id;
   begin
      Result := Source = Ancestor;

      if not Result then
         --  Starting from source, go to its definition (and it should be an
         --  interface type definition!) and check Is_Ancestor for all the
         --  interfaces listed in this definition
         Next_T := Parent (Source);

         if Nkind (Next_T) = N_Private_Type_Declaration then
            --  nothing to analyze!
            return False;
         end if;

         pragma Assert (Nkind (Next_T) = N_Full_Type_Declaration);

         Type_Def := Sinfo.Type_Definition (Next_T);

         if Nkind (Type_Def) = N_Derived_Type_Definition then
            --  First element from the interface list can be reached by the
            --  Subtype_Indication (Type_Def) link, the other (if any) are
            --  the members of Interface_List (Type_Def) list

            Next_T := Sinfo.Subtype_Indication (Type_Def);
            Next_T := Entity (Next_T);

            while Present (Next_T)
                and then
                  Nkind (Parent (Next_T)) /= N_Full_Type_Declaration
                and then
                  Etype (Next_T) /= Next_T
            loop
               Next_T := Etype (Next_T);
            end loop;

            pragma Assert (Nkind (Parent (Next_T)) = N_Full_Type_Declaration);

            Result := Is_Ancestor (Ancestor, Next_T);

            if not Result
              and then
               not Is_Empty_List (Interface_List (Type_Def))
            then
               Next_T := First (Interface_List (Type_Def));

               while Present (Next_T) loop

                  Next_T := Entity (Next_T);

                  while Present (Next_T)
                      and then
                        Nkind (Parent (Next_T)) /= N_Full_Type_Declaration
                      and then
                        Etype (Next_T) /= Next_T
                  loop
                     Next_T := Etype (Next_T);
                  end loop;

                  pragma Assert (Nkind (Parent (Next_T)) =
                                 N_Full_Type_Declaration);

                  Result := Is_Ancestor (Ancestor, Next_T);

                  exit when Result;

                  Next_T := Next (Next_T);
               end loop;
            end if;

         end if;

      end if;

      return Result;
   end Is_Ancestor;

   -------------
   -- 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
      Entity_N : Entity_Id;
      Call     : Asis.Element;
      Arg_Node : Node_Id := Node (Op);
      Result   : Boolean := False;
   begin

      if Operator_Kind (Op) in An_And_Operator .. An_Xor_Operator then

         Call := Enclosing_Element (Op);

         if Is_Prefix_Call (Call) then
            Arg_Node := R_Node (Call);
         end if;

         if Nkind (Arg_Node) = N_Type_Conversion and then
            not Comes_From_Source (Arg_Node)
         then
            --  Implicit conversion added by front-end
            Arg_Node := Sinfo.Expression (Arg_Node);
         end if;

         if Nkind (Arg_Node) = N_Op_And
           or else
            Nkind (Arg_Node) = N_Op_Or
           or else
            Nkind (Arg_Node) = N_Op_Xor
         then
            Entity_N := Entity (Arg_Node);

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

      end if;

      return Result;
   end Is_Boolean_Logical_Op;

   ----------------------------------
   -- 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_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_Constant --
   -----------------

   function Is_Constant (E : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin
      if Defining_Name_Kind (E) = A_Defining_Identifier then
         Result := Ekind (Node (E)) = E_Constant;
      end if;

      return Result;
   end Is_Constant;

   ---------------------------------
   -- Is_Constr_Error_Declaration --
   ---------------------------------

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

      if Declaration_Kind (Decl) = An_Exception_Declaration
        and then
         Is_Standard (Enclosing_Compilation_Unit (Decl))
        and then
         Defining_Name_Image (First_Name (Decl)) = "Constraint_Error"
      then
         Result := True;
      end if;

      return Result;
   end Is_Constr_Error_Declaration;

   -------------------------
   -- Is_Constraint_Error --
   -------------------------

   function Is_Constraint_Error (Ref : Asis.Element) return Boolean is
      Next_Exception_Decl : Asis.Element;

      Result : Boolean := False;
   begin
      Next_Exception_Decl := Corresponding_Name_Declaration (Ref);

      while not Is_Nil (Next_Exception_Decl) loop

         if Is_Constr_Error_Declaration (Next_Exception_Decl) then
            Result := True;
            exit;
         elsif Is_Num_Error_Declaration (Next_Exception_Decl) then
            exit;
         elsif Declaration_Kind (Next_Exception_Decl) =
               An_Exception_Renaming_Declaration
         then
            Next_Exception_Decl := Renamed_Entity (Next_Exception_Decl);
            Next_Exception_Decl := Normalize_Reference (Next_Exception_Decl);
            Next_Exception_Decl :=
              Corresponding_Name_Declaration (Next_Exception_Decl);
         else
            exit;
         end if;

      end loop;

      return Result;
   end Is_Constraint_Error;

   --------------------
   -- Is_Constructor --
   --------------------

   function Is_Constructor (Element : Asis.Element) return Boolean is
      Name     : Asis.Element;
      N        : Node_Id;
      Result   : Boolean := False;

   begin

      if Declaration_Kind (Element) in
            A_Function_Declaration             |
            An_Expression_Function_Declaration |
            A_Function_Body_Declaration        |
            A_Function_Renaming_Declaration    |
            A_Function_Body_Stub
        and then
         Is_Dispatching_Operation (Element)
      then
         Name := First_Name (Element);
         N    := Node (Name);

         if Has_Controlling_Result (N) then
            --  The last thing to check is that we do not have any controlling
            --  parameter
            Result := True;

            declare
               Pars : constant Asis.Element_List :=
                 Parameter_Profile (Element);
            begin
               if Pars'Length > 0 then
                  --  All we have to check in a legal code is if we have at
                  --  least one parameter of a tagged type, and this type is
                  --  not a class-wide type.

                  for J in Pars'Range loop
                     Name := First_Name (Pars (J));
                     N    := Node (Name);
                     N    := Etype (N);

                     if Ekind (N) in
                          E_Access_Type          |
                          E_Access_Subtype       |
                          E_Anonymous_Access_Type
                     then
                        N := Directly_Designated_Type (N);
                     end if;

                     if Is_Tagged_Type (N)
                       and then
                        Ekind (N) not in
                          E_Class_Wide_Type | E_Class_Wide_Subtype
                     then
                        --  We already have a controlling result, so in a legal
                        --  code this type should be the same as the result
                        --  type. Therefore:
                        Result := False;
                        exit;
                     end if;
                  end loop;
               end if;
            end;
         end if;
      end if;

      return Result;
   end Is_Constructor;

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

   function Is_Downward_View_Conversion
     (Element : Asis.Element)
      return    Boolean
   is
      Result : Boolean := False;
      Source : Asis.Element;
      Target : Asis.Element;

      Source_T : Entity_Id;
      Target_T : Entity_Id;
   begin
      if Expression_Kind (Element) /= A_Type_Conversion then
         return False;
      end if;

      Source   := Converted_Or_Qualified_Expression (Element);
      Source_T := R_Node (Source);
      Source_T := Etype (Source_T);

      --  We are interested in view conversions in the context of
      --  Downward_View_Conversions gnatcheck rule, so both source and target
      --  types should be tagged

      if not Is_Tagged_Type (Source_T) then
         return False;
      end if;

      Target   := Converted_Or_Qualified_Subtype_Mark (Element);
      Target_T := R_Node (Target);
      Target_T := Etype (Target_T);

      if Ekind (Source_T) = E_Class_Wide_Type then
         Source_T := Etype (Source_T);
      end if;

      if Ekind (Target_T) = E_Class_Wide_Type then
         Target_T := Etype (Target_T);
      end if;

      --  Conversion of non-interface type into interface type is always OK

      if Is_Interface (Target_T) and then not Is_Interface (Source_T) then
         return False;
      end if;

      --  Simple case - both source and target are not interfaces

      if not Is_Interface (Target_T) and then not Is_Interface (Source_T) then

         Result := True;

         loop

            if Source_T = Target_T then
               Result := False;
               exit;
            end if;

            exit when Etype (Source_T) = Source_T;

            Source_T := Etype (Source_T);
         end loop;

      end if;

      if Is_Interface (Target_T) and then Is_Interface (Source_T) then
         --  The hardest case - both source and target are interfaces.
         Result := not Is_Ancestor (Target_T, Source_T);
      end if;

      return Result;
   end Is_Downward_View_Conversion;

   --------------
   -- 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_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_Fixed --
   --------------

   function Is_Fixed (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 Fixed_Point_Kind;
      end if;

      return Result;

   end Is_Fixed;

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

   function Is_Named_Scope (E : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin
      case Declaration_Kind (E) is
         when A_Task_Type_Declaration       |
              A_Protected_Type_Declaration  |
              A_Procedure_Body_Declaration  |
              A_Function_Body_Declaration   |
              A_Package_Declaration         |
              A_Package_Body_Declaration    |
              A_Task_Body_Declaration       |
              A_Protected_Body_Declaration  |
              A_Generic_Package_Declaration =>
            Result := True;
         when A_Procedure_Declaration                  |
              A_Function_Declaration                   |
              A_Package_Renaming_Declaration           |
              A_Procedure_Renaming_Declaration         |
              A_Function_Renaming_Declaration          |
              A_Generic_Package_Renaming_Declaration   |
              A_Generic_Procedure_Renaming_Declaration |
              A_Generic_Function_Renaming_Declaration  |
              A_Generic_Procedure_Declaration          |
              A_Generic_Function_Declaration           |
              A_Package_Instantiation                  |
              A_Procedure_Instantiation                |
              A_Function_Instantiation                 =>
            --  This should be considered as a scope only if it is a top-level
            --  declaration of a compilation unit
            Result := Is_Nil (Enclosing_Element (E));
         when others =>
            null;
      end case;

      return Result;
   end Is_Named_Scope;

   ------------------------------
   -- Is_Num_Error_Declaration --
   ------------------------------

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

      if Declaration_Kind (Decl) = An_Exception_Renaming_Declaration
        and then
         Is_Standard (Enclosing_Compilation_Unit (Decl))
        and then
         Defining_Name_Image (First_Name (Decl)) = "Numeric_Error"
      then
         Result := True;
      end if;

      return Result;
   end Is_Num_Error_Declaration;

   ----------------------
   -- Is_Numeric_Error --
   ----------------------

   function Is_Numeric_Error (Ref : Asis.Element) return Boolean is
      Next_Exception_Decl : Asis.Element;

      Result : Boolean := False;
   begin
      Next_Exception_Decl := Corresponding_Name_Declaration (Ref);

      while not Is_Nil (Next_Exception_Decl) loop

         if Is_Num_Error_Declaration (Next_Exception_Decl) then
            Result := True;
            exit;
         elsif Declaration_Kind (Next_Exception_Decl) =
               An_Exception_Renaming_Declaration
         then
            Next_Exception_Decl := Renamed_Entity (Next_Exception_Decl);
            Next_Exception_Decl := Normalize_Reference (Next_Exception_Decl);
            Next_Exception_Decl :=
              Corresponding_Name_Declaration (Next_Exception_Decl);
         else
            exit;
         end if;

      end loop;

      return Result;
   end Is_Numeric_Error;

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

            case Nkind (Op_Entity) is
               when N_Function_Call =>
                  Op_Entity := Sinfo.Name (Op_Entity);
               when N_Type_Conversion =>
                  Op_Entity := Sinfo.Expression (Op_Entity);
               when others =>
                  null;
            end case;

            Op_Entity := Entity (Op_Entity);

            Result := Sloc (Op_Entity) = Standard_Location;

         end if;
      end if;

      return Result;

   end Is_Predefined;

   --------------------------
   -- Is_Predefined_String --
   --------------------------

   function Is_Predefined_String (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));

         while Etype (Type_Entity) /= Type_Entity loop
            Type_Entity := Etype (Type_Entity);
         end loop;

         Result := Type_Entity = Stand.Standard_String;

      end if;

      return Result;

   end Is_Predefined_String;

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

   function Is_Prefix_Notation_Exception
     (El                 : Asis.Element;
      Exclude_Second_Par : Boolean)
      return Boolean
   is
      Call_Node      : Node_Id;
      Par_Node       : Node_Id;
      Firts_Par_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)) = 1 then
         Result := True;
      else
         Par_Node       := R_Node (El);
         Firts_Par_Node := First (Parameter_Associations (Call_Node));

         if Par_Node = Firts_Par_Node then
            Result := True;
         elsif List_Length (Parameter_Associations (Call_Node)) = 2
            and then
             Exclude_Second_Par
         then
            Result := Par_Node = Next (Firts_Par_Node);
         end if;

      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 Nkind (Arg_Entity) in N_Has_Entity then

         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;

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

         while Present (Type_Entity)
            and then
               Type_Entity /= Etype (Type_Entity)
            and then
               Ekind (Type_Entity) /= E_Enumeration_Type
         loop
            Type_Entity := Etype (Type_Entity);
         end loop;

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

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

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

   -----------------------
   -- Overloading_Index --
   -----------------------

   function Overloading_Index (El : Asis.Element) return String is
      Dcl      : Asis.Element;
      Dcl_N    : Asis.Element;
      Dcl_Name : Program_Text_Access;

      Res : Positive := 1;

      Scope     : Asis.Element := Nil_Element;
      Dcl_Scope : Asis.Element := Nil_Element;

      Detected : Boolean := False;

      procedure Get_Overloding_Index (Dcls : Asis.Element_List);
      --  Parses its argument and counts in Res declarations that overloads El.
      --  If founds the declaration that Is_Equal to El, sets Detected ON and
      --  returns (without increasing Res).
      procedure Get_Overloding_Index (Dcls : Asis.Element_List) is
      begin
         for J in Dcls'Range loop
            if Is_Equal (Dcls (J), Dcl) then
               Detected := True;
               exit;
            end if;

            if Declaration_Kind (Dcls (J)) in
                  A_Procedure_Declaration            |
                  An_Entry_Declaration               |
                  A_Procedure_Instantiation          |
                  A_Function_Declaration             |
                  A_Function_Instantiation
               or else
                (Declaration_Kind (Dcls (J)) in
                   A_Procedure_Body_Declaration       |
                   A_Null_Procedure_Declaration       |
                   A_Procedure_Body_Stub              |
                   A_Function_Body_Declaration        |
                   A_Function_Body_Stub               |
                   An_Expression_Function_Declaration
                 and then
                Acts_As_Spec (Dcls (J)))
               or else
                (Declaration_Kind (Dcls (J)) in
                  A_Procedure_Renaming_Declaration   |
                  A_Function_Renaming_Declaration
                 and then
                not Is_Renaming_As_Body (Dcls (J)))
            then
               if To_Lower_Case (Defining_Name_Image (First_Name (Dcls (J)))) =
                    Dcl_Name.all
               then
                  Res := Res + 1;
               end if;
            end if;

         end loop;
      end Get_Overloding_Index;

   begin
      if Declaration_Kind (El) in
           A_Procedure_Body_Declaration |
           A_Function_Body_Declaration
      then
         Dcl := Corresponding_Declaration (El);

         if Is_Nil (Dcl) then
            if Acts_As_Spec (El) then
               Dcl := El;
            elsif Is_Subunit (El) then
               Dcl := Corresponding_Body_Stub (El);

               if not Acts_As_Spec (Dcl) then
                  Dcl := Corresponding_Declaration (Dcl);
               end if;
            else
               pragma Assert (False);
            end if;
         end if;
      else
         return "";
      end if;

      if Declaration_Kind (Dcl) in
           A_Generic_Procedure_Declaration |
           A_Generic_Function_Declaration
      then
         return "";
      end if;

      Dcl_N := First_Name (Dcl);

      if Defining_Name_Kind (Dcl_N) = A_Defining_Expanded_Name
        or else
         not Has_Homonym (R_Node (Dcl_N))
      then
         return "";
      end if;

      Scope    := Enclosing_Element (Dcl);

      Dcl_Name := new Program_Text'(To_Lower_Case
                        (Defining_Name_Image (Dcl_N)));

      if Is_Nil (Scope) then
         --  We are at the library level
         return "";
      end if;

      if Declaration_Kind (Scope) in
           A_Package_Body_Declaration |
           A_Protected_Body_Declaration
      then
         Dcl_Scope := Corresponding_Declaration (Scope);
      end if;

      if Declaration_Kind (Dcl_Scope) in
           A_Protected_Type_Declaration |
           A_Single_Protected_Declaration
      then
         Get_Overloding_Index
          (Visible_Part_Items (
             (if Declaration_Kind (Dcl_Scope) =
                   A_Protected_Type_Declaration
              then
                 Type_Declaration_View (Dcl_Scope)
              else
                 Object_Declaration_View (Dcl_Scope))));
         if not Detected then
            Get_Overloding_Index
             (Private_Part_Items (
                (if Declaration_Kind (Dcl_Scope) =
                      A_Protected_Type_Declaration
                 then
                    Type_Declaration_View (Dcl_Scope)
                 else
                    Object_Declaration_View (Dcl_Scope))));
         end if;
      elsif Declaration_Kind (Dcl_Scope) in
              A_Package_Declaration |
              A_Generic_Package_Declaration
      then
         Get_Overloding_Index (Visible_Part_Declarative_Items (Dcl_Scope));

         if not Detected then
            Get_Overloding_Index (Private_Part_Declarative_Items (Dcl_Scope));
         end if;
      end if;

      if not Detected then

         if Declaration_Kind (Scope) = A_Protected_Body_Declaration then
            Get_Overloding_Index (Protected_Operation_Items (Scope));

         elsif Declaration_Kind (Scope) in
                 A_Package_Declaration |
                 A_Generic_Package_Declaration
         then
            Get_Overloding_Index (Visible_Part_Declarative_Items (Scope));

         elsif Declaration_Kind (Scope) in
                 A_Procedure_Body_Declaration |
                 A_Function_Body_Declaration  |
                 A_Package_Body_Declaration   |
                 A_Task_Body_Declaration
         then
            Get_Overloding_Index (Body_Declarative_Items (Scope));

         elsif Definition_Kind (Scope) = A_Protected_Definition then
            Get_Overloding_Index (Visible_Part_Items (Scope));

         elsif Statement_Kind (Scope) = A_Block_Statement then
            Get_Overloding_Index (Block_Declarative_Items (Scope));
         else
            pragma Assert (False);
         end if;

         if not Detected then
            if Declaration_Kind (Scope) in
                 A_Package_Declaration |
                 A_Generic_Package_Declaration
            then
               Get_Overloding_Index (Private_Part_Declarative_Items (Scope));
            elsif Definition_Kind (Scope) = A_Protected_Definition then
               Get_Overloding_Index (Private_Part_Items (Scope));
            end if;
         end if;
      end if;

      Free (Dcl_Name);

      if Res = 1 then
         return "";
      else
         return '#' & Image (Res);
      end if;
   end Overloading_Index;

   ------------------------------
   -- Overridden_Interface_Ops --
   ------------------------------

   function Overridden_Interface_Ops
     (Type_Entity : Entity_Id;
      Op_Entity   : Entity_Id)
      return   List_Of_Nodes
   is
      Result : List_Of_Nodes (1 .. 6000);
      --  6000 looks as infinity here
      Res_Last : Natural := 0;

      Next_El             :          Elmt_Id;
      Next_Overridden     :          Entity_Id;
   begin
      Next_El := First_Elmt (Direct_Primitive_Operations (Type_Entity));

      while Present (Next_El) loop
         Next_Overridden := Node (Next_El);

         if Present (Interface_Alias (Next_Overridden))
           and then
            Alias (Next_Overridden) = Op_Entity
         then
            Res_Last            := Res_Last + 1;
            Result (Res_Last)   := Interface_Alias (Next_Overridden);
         end if;

         Next_El := Next_Elmt (Next_El);
      end loop;

      return Result (1 .. Res_Last);

   end Overridden_Interface_Ops;

   ---------------------
   -- Primitive_Owner --
   ---------------------

   function Primitive_Owner (Op : Entity_Id) return Entity_Id is
      Res_Node : Entity_Id := Empty;
      Op_Def   : Node_Id;
      Par_Node : Node_Id;
   begin
      --  Two cases should be processed separately - explicit and implicit
      --  primitives

      if Comes_From_Source (Op) then
         Op_Def := Parent (Op);
         pragma Assert (Nkind (Op_Def) in
                        N_Procedure_Specification | N_Function_Specification);

         if Nkind (Op_Def) = N_Function_Specification
           and then
            Has_Controlling_Result (Op)
         then
            Res_Node := Sinfo.Result_Definition (Op_Def);

            if Nkind (Res_Node) = N_Access_Definition then
               Res_Node := Sinfo.Subtype_Mark (Res_Node);
            end if;

            Res_Node := Entity (Res_Node);
         end if;

         if No (Res_Node) then
            --  This means that we do not have a function with controlling
            --  result, so we have to go through the formal parameter list,
            --  and it can not be No_List or empty

            Par_Node := First (Parameter_Specifications (Op_Def));

            while Present (Par_Node) loop

               if Is_Controlling_Formal
                    (Defining_Identifier (Par_Node))
               then

                  if Nkind (Parameter_Type (Par_Node)) =
                     N_Access_Definition
                  then
                     Res_Node :=
                        Sinfo.Subtype_Mark (Parameter_Type (Par_Node));
                  else
                     Res_Node := Defining_Identifier (Par_Node);
                  end if;

                  Res_Node := Etype (Res_Node);

                  exit;
               end if;

               Par_Node := Next (Par_Node);
            end loop;

         end if;

         pragma Assert (Present (Res_Node));

         if Nkind (Original_Node (Parent (Res_Node))) =
              N_Subtype_Declaration
         then
            Res_Node := Etype (Res_Node);
         end if;

         if Ekind (Res_Node) = E_Incomplete_Type
           and then
            Present (Full_View (Res_Node))
         then
            Res_Node := Full_View (Res_Node);
         end if;

      else
         Res_Node := Parent (Op);

         pragma Assert (Nkind (Res_Node) in
                          N_Private_Extension_Declaration |
                          N_Private_Type_Declaration      |
                          N_Full_Type_Declaration);

         Res_Node := Defining_Identifier (Res_Node);
      end if;

      return Res_Node;
   end Primitive_Owner;

   ----------------------
   -- Raises_Exception --
   ----------------------

   function Raises_Exception (El : Asis.Element) return Boolean is
      Result          : Boolean := False;
      First_Handler   : Boolean := Element_Kind (El) = An_Exception_Handler;
      First_Body_Decl : Boolean :=
        Declaration_Kind (El) in
          A_Procedure_Body_Declaration .. A_Function_Body_Declaration;

      procedure Check_Construct
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Boolean);
      --  Checks if we have a raise statement or a construct that should be
      --  skipped in the analysis;
      procedure No_Op
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Boolean);

      procedure Check_For_Raise_Statement is new Traverse_Element
        (Pre_Operation     => Check_Construct,
         Post_Operation    => No_Op,
         State_Information => Boolean);

      Control : Traverse_Control := Continue;

      procedure Check_Construct
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Boolean)
      is
      begin
         case Element_Kind (Element) is
            when A_Declaration =>

               case Declaration_Kind (Element) is
                  when A_Procedure_Body_Declaration |
                       A_Function_Body_Declaration  =>

                     if First_Body_Decl then
                        First_Body_Decl := False;
                     else
                        Control := Abandon_Children;
                     end if;

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

            when A_Statement =>
               if Statement_Kind (Element) = A_Raise_Statement then
                  State   := True;
                  Control := Terminate_Immediately;
               end if;
            when A_Path =>
               null;
            when An_Exception_Handler =>
               if First_Handler then
                  First_Handler := False;
               else
                  Control := Abandon_Children;
               end if;

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

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

   begin
      Check_For_Raise_Statement (El, Control, Result);

      return Result;
   end Raises_Exception;

   ----------------
   -- Scope_Name --
   ----------------

   function Scope_Name (El : Asis.Element) return String is
   begin
      if not ASIS_UL.Debug.Debug_Flag_JJ
        or else Is_Nil (El)
      then
         return "";
      else
         declare
            Result : constant String := Add_Scope_Name (El);
         begin
            if Result = "" then
               return "";
            else
               return Result & ": ";
            end if;
         end;
      end if;

   end Scope_Name;

   -------------------------------
   -- Self_Ref_Discr_Constraint --
   -------------------------------

   function Self_Ref_Discr_Constraint
     (Constr : Asis.Element)
      return   Boolean
   is
      Result    : Boolean := False;
      Type_Name : Asis.Element;
   begin

      if Constraint_Kind (Constr) /= A_Discriminant_Constraint then
         return False;
      end if;

      Type_Name :=
        Enclosing_Element (Enclosing_Element (Enclosing_Element (Constr)));

      if Declaration_Kind (Type_Name) /= A_Component_Declaration then
         return False;
      end if;

      while Declaration_Kind (Type_Name) /= An_Ordinary_Type_Declaration loop
         Type_Name := Enclosing_Element (Type_Name);
      end loop;

      Type_Name := First_Name (Type_Name);

      declare
         D_Associations : constant Asis.Element_List :=
           Discriminant_Associations (Constr);
         D_Value : Asis.Element;
         Pref    : Asis.Element;
      begin
         for J in D_Associations'Range loop
            D_Value := Discriminant_Expression (D_Associations (J));

            if Is_Access_Attribute (D_Value) then
               Pref := Prefix (D_Value);

               if Expression_Kind (Pref) = An_Identifier then
                  Pref := Corresponding_Name_Declaration (Pref);

                  while Declaration_Kind (Pref) in
                          An_Incomplete_Type_Declaration       |
                          A_Tagged_Incomplete_Type_Declaration |
                          A_Private_Type_Declaration            |
                          A_Private_Extension_Declaration
                  loop
                     Pref := Corresponding_Type_Completion (Pref);
                  end loop;

                  if Declaration_Kind (Pref) =
                       An_Ordinary_Type_Declaration
                  then
                     Pref := First_Name (Pref);

                     if Is_Equal (Pref, Type_Name) then
                        Result := True;
                        exit;
                     end if;
                  end if;

               end if;
            end if;

         end loop;
      end;

      return Result;
   end Self_Ref_Discr_Constraint;

   -------------------------------------
   -- Storage_Order_Defined_By_Pragma --
   -------------------------------------

   function Storage_Order_Defined_By_Pragma
     (E    : Asis.Element)
      return Boolean
   is
      Type_Entity : Entity_Id;
      Next_Pragma : Node_Id;
      Pragma_Arg  : Node_Id;
      Result      : Boolean := False;
   begin
      Type_Entity := R_Node (E);
      Next_Pragma := Next (Type_Entity);
      Type_Entity := Defining_Identifier (Type_Entity);

      while Present (Next_Pragma) loop
         if Nkind (Next_Pragma) = N_Attribute_Definition_Clause
          and then
            Is_Rewrite_Substitution (Next_Pragma)
          and then
            Nkind (Original_Node (Next_Pragma)) = N_Pragma
          and then
            Chars (Next_Pragma) = Name_Scalar_Storage_Order
         then
            Pragma_Arg := Sinfo.Name (Next_Pragma);

            if Nkind (Pragma_Arg) = N_Identifier
              and then
               Entity (Pragma_Arg) = Type_Entity
            then
               Result := True;
               exit;
            end if;
         end if;

         Next_Pragma := Next (Next_Pragma);
      end loop;

      return Result;
   end Storage_Order_Defined_By_Pragma;

   -----------------
   -- Unwind_Type --
   -----------------

   function Unwind_Type
     (D               : Asis.Element;
      Stop_At_Private : Boolean := False)
      return            Asis.Element
   is
      Result : Asis.Element := D;
      T_Def  : Asis.Element;
   begin
      case Declaration_Kind (Result) is
         when A_Task_Type_Declaration              |
              A_Protected_Type_Declaration         |
              An_Incomplete_Type_Declaration       |
              A_Tagged_Incomplete_Type_Declaration |
              A_Formal_Type_Declaration            |
              A_Formal_Incomplete_Type_Declaration =>
            null;

         when An_Ordinary_Type_Declaration =>
            T_Def := Type_Declaration_View (Result);

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

         when A_Private_Type_Declaration      |
              A_Private_Extension_Declaration =>
            if not Stop_At_Private then
               Result := Unwind_Type (Corresponding_Type_Completion (Result));
            end if;

         when A_Subtype_Declaration =>
            Result := Unwind_Type (Corresponding_First_Subtype (Result));

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

      return Result;
   end Unwind_Type;

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