------------------------------------------------------------------------------
--                                                                          --
--                          GNATCHECK COMPONENTS                            --
--                                                                          --
--              G N A T C H E C K . R U L E S . D E F A U L T               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2004-2007, AdaCore                     --
--                                                                          --
-- GNATCHECK  is  free  software;  you can redistribute it and/or modify it --
-- under terms of the  GNU  General Public License as published by the Free --
-- Software Foundation;  either version 2, or ( at your option)  any  later --
-- version.  GNATCHECK  is  distributed in the hope that it will be useful, --
-- but  WITHOUT  ANY  WARRANTY;   without  even  the  implied  warranty  of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
-- Public License for more details.  You should have received a copy of the --
-- GNU  General Public License distributed with GNAT; see file  COPYING. If --
-- not,  write to the  Free Software Foundation,  51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA.                                       --
--                                                                          --
-- GNATCHECK is maintained by AdaCore (http://www.adacore.com).             --
--                                                                          --
------------------------------------------------------------------------------

with System;                     use System;

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.Expressions;           use Asis.Expressions;
with Asis.Extensions;            use Asis.Extensions;
with Asis.Extensions.Flat_Kinds; use Asis.Extensions.Flat_Kinds;
with Asis.Statements;            use Asis.Statements;

with ASIS_UL.Strings;            use ASIS_UL.Strings;

with Gnatcheck.ASIS_Utilities;   use Gnatcheck.ASIS_Utilities;
with Gnatcheck.Global_State;     use Gnatcheck.Global_State;
with Gnatcheck.Global_State.CG;
with Gnatcheck.Name_Dictionary;
with Gnatcheck.Rules.Rule_Table; use Gnatcheck.Rules.Rule_Table;
with Gnatcheck.Traversal_Stack;  use Gnatcheck.Traversal_Stack;

package body Gnatcheck.Rules.Default is

   use type Gnatcheck.Global_State.Call_Lists.Cursor;

   --------------------------------
   -- Abstract_Type_Declarations --
   --------------------------------

   procedure Init_Rule (Rule : in out Abstract_Type_Declarations_Rule_Type) is
   begin
      Rule.Name       := new String'("Abstract_Type_Declarations");
      Rule.Synonym    := new String'("Abstr_Types");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("abstract types");
      Rule.Diagnosis  := new String'("declaration of abstract type");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Abstract_Type_Declarations_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      El_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (Element);
      pragma Unreferenced (Control);
      pragma Unreferenced (Rule);
   begin

      case El_Kind is
         when A_Tagged_Record_Type_Definition         |
              A_Derived_Record_Extension_Definition   |
              A_Private_Type_Declaration              |
              A_Private_Extension_Declaration         |
              A_Formal_Tagged_Private_Type_Definition |
              A_Formal_Derived_Type_Definition        =>

            if Trait_Kind (Element) in An_Abstract_Trait ..
               An_Abstract_Limited_Private_Trait
            then
               State.Detected := True;
            end if;

         when others =>
            null;
      end case;

   end Rule_Check_Pre_Op;

   ------------------------
   -- Anonymous_Subtypes --
   ------------------------

   procedure Init_Rule (Rule : in out Anonymous_Subtypes_Rule_Type) is
   begin
      Rule.Name       := new String'("Anonymous_Subtypes");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("anonymous subtypes");
      Rule.Diagnosis  := new String'("anonymous subtype");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Anonymous_Subtypes_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule, Control);
      El_Kind   : constant Flat_Element_Kinds := Flat_Element_Kind (Element);
      Encl_Kind :          Flat_Element_Kinds;
   begin

      case El_Kind is
         when A_Subtype_Indication =>

            Encl_Kind := Flat_Element_Kind (Get_Enclosing_Element);

            if Encl_Kind /= A_Subtype_Declaration
              and then
               not Is_Nil (Subtype_Constraint (Element))
            then
               State.Detected := True;
            end if;

         when A_Discrete_Subtype_Indication_As_Subtype_Definition |
              A_Discrete_Subtype_Indication                       =>

            --  The enclosing context for sure can not be a subtype
            --  declaration, so if we have a constraint - we should detect
            --  this situation

            if not Is_Nil (Subtype_Constraint (Element)) then
               State.Detected := True;
            end if;

         when A_Discrete_Range_Attribute_Reference_As_Subtype_Definition |
              A_Discrete_Simple_Expression_Range_As_Subtype_Definition   |
              A_Discrete_Range_Attribute_Reference                       |
              A_Discrete_Simple_Expression_Range                         =>

            --  Definitely the use of an anonymous subtype
            State.Detected := True;
         when others =>
            null;
      end case;

   end Rule_Check_Pre_Op;

   ------------
   -- Blocks --
   ------------

   procedure Init_Rule (Rule : in out Blocks_Rule_Type) is
   begin
      Rule.Name       := new String'("Blocks");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("block statements");
      Rule.Diagnosis  := new String'("block statement");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Blocks_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Control);
      pragma Unreferenced (Rule);
   begin

      if Statement_Kind (Element) = A_Block_Statement then
         State.Detected := True;
      end if;

   end Rule_Check_Pre_Op;

   ----------------------------------
   -- Boolean_Relational_Operators --
   ----------------------------------

   procedure Init_Rule (Rule : in out Boolean_Relational_Operators_Rule_Type)
   is
   begin
      Rule.Name       := new String'("Boolean_Relational_Operators");
      Rule.Synonym    := new String'("Bool_Relation_Ops");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("comparisons of Boolean values");
      Rule.Diagnosis  := new String'("comparison of Boolean values");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Boolean_Relational_Operators_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);

      Call_Element : Asis.Element;
   begin

      if Operator_Kind (Element) in
            An_Equal_Operator .. A_Greater_Than_Or_Equal_Operator

      then
         Call_Element := Get_Call_Element;

         if Expression_Kind (Call_Element) = A_Function_Call
           and then
            Is_Predefined (Element)
           and then
            Is_Standard_Boolean
              (Actual_Parameter (Function_Call_Parameters (Call_Element) (1)))
         then
            State.Detected := True;
         end if;

      end if;

   end Rule_Check_Pre_Op;

   ------------------------
   -- Ceiling_Violations --
   ------------------------

   procedure Init_Rule (Rule : in out Ceiling_Violations_Rule_Type)
   is
   begin
      Rule.Name       := new String'("Ceiling_Violations");
      Rule.Synonym    := new String'("Ceiling_Priority_Consistency");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("priority inversion for protected " &
                                     "operations");
      Rule.Diagnosis  := new String'("protected operation is called by " &
                                     "higher priority caller;");
   end Init_Rule;

   procedure Collect_Global_Info_Pre_Op
     (Rule    : in out Ceiling_Violations_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      Enclosing_Entity_Node : GS_Node_Id;

      Priority_Expr : Asis.Element := Nil_Element;

      Priority            : Any_Priority;
      Is_Dynamic_Priority : Boolean := False;

      pragma Unreferenced (Control, State, Rule);

   begin

      if Pragma_Kind (Element) = A_Priority_Pragma
        or else
         Pragma_Kind (Element) = An_Interrupt_Priority_Pragma
      then

         if Declaration_Kind (Get_Enclosing_Element) in
            A_Procedure_Body_Declaration .. A_Function_Body_Declaration
         then

            if Is_Nil (Get_Enclosing_Element (Steps_Up => 1))
              and then
               Can_Be_Main_Program (Enclosing_Compilation_Unit (Element))
            then
               --  This pragma defines the priority of an environment task
               Enclosing_Entity_Node := Environment_Task_Node;
            else
               --  This pragma has no effect
               return;
            end if;

         elsif Definition_Kind (Get_Enclosing_Element) in
               A_Task_Definition .. A_Protected_Definition
         then
            Enclosing_Entity_Node :=
              Corresponding_Node (Get_Enclosing_Element);

         else
            null;
            pragma Assert (False);
         end if;

         declare
            Pragma_Args : constant Asis.Association_List :=
              Pragma_Argument_Associations (Element);
         begin

            if not Is_Nil (Pragma_Args) then
               Priority_Expr := Actual_Parameter (Pragma_Args (1));

               if Is_Static (Priority_Expr) then
                  Priority :=
                    Any_Priority'Wide_Value
                      (Static_Expression_Value_Image (Priority_Expr));
               else
                  --  Priority is set by a dynamic expression, so
                  Is_Dynamic_Priority := True;
               end if;

            else
               --  Pragma Interrupt_Priority with no arguments
               Priority := Interrupt_Priority'Last;
            end if;
         end;

         if Is_Dynamic_Priority then
            Set_Dynamic_Priority (Enclosing_Entity_Node);
         else
            Set_Priority (Enclosing_Entity_Node, Priority);
         end if;

      end if;

   end Collect_Global_Info_Pre_Op;

   procedure Analyze_Global_Structure
     (Rule : Ceiling_Violations_Rule_Type)
   is
      pragma Unreferenced (Rule);
   begin
      Gnatcheck.Global_State.CG.Set_Priorities;
   end Analyze_Global_Structure;

   procedure Check_Global_Structure_Node
     (Rule     :     Ceiling_Violations_Rule_Type;
      N        :     Gnatcheck.Global_State.GS_Node_Id;
      Detected : out Boolean)
   is
      pragma Unreferenced (Rule);
      Next_N : GS_Node_Id;
   begin
      Detected := False;

      if GS_Node_Kind (N) in A_Protected_Procedure .. A_Protected_Entry then

         Reset_Itrerator (For_Node => N, Call_Set => Callers);
         Next_N := Next_Node;

         while Present (Next_N) loop

            pragma Assert (Priority_Defined (Next_N));

            if Has_Dynamic_Priority (Next_N)
              or else
               Node_Priority (Next_N) >
                 Node_Priority (N)
            then
               Detected := True;
               exit;
            end if;

            Next_N := Next_Node;
         end loop;

      end if;

   end Check_Global_Structure_Node;

   -------------------------------
   -- Complex_Concurr_Structure --
   -------------------------------

--   procedure Init_Rule (Rule : in out Complex_Concurr_Structure_Rule_Type) is
--   begin
--      Rule.Name       := new String'("Complex_Concurr_Structure");
--      Rule.Rule_State := Disabled;
--      Rule.Help_Info  := new String'("complex concurrent structures");
--      Rule.Diagnosis  :=
--        new String'("declaration of complex concurrent structure");
--   end Init_Rule;

--   procedure Rule_Check_Pre_Op
--     (Rule    : in out Complex_Concurr_Structure_Rule_Type;
--      Element :        Asis.Element;
--      Control : in out Traverse_Control;
--      State   : in out Rule_Traversal_State)
--   is
--      pragma Unreferenced (Rule);
--      pragma Unreferenced (Control);
--   begin
--   end Rule_Check_Pre_Op;

   ----------------------------------
   -- Controlled_Type_Declarations --
   ----------------------------------

   procedure Init_Rule (Rule : in out Controlled_Type_Declarations_Rule_Type)
   is
   begin
      Rule.Name       := new String'("Controlled_Type_Declarations");
      Rule.Synonym    := new String'("Contr_Types");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("controlled types");
      Rule.Diagnosis  := new String'("declaration of controlled type");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Controlled_Type_Declarations_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      Type_Name : Asis.Element;
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      case Declaration_Kind (Element) is
         when An_Ordinary_Type_Declaration    |
              A_Private_Type_Declaration      |
              A_Private_Extension_Declaration =>
            Type_Name := Names (Element) (1);

            if Is_Controlled (Type_Name) then
               State.Detected := True;
            end if;

         when others =>
            null;
      end case;

   end Rule_Check_Pre_Op;

   ----------------------------
   -- Declarations_In_Blocks --
   ----------------------------

   procedure Init_Rule (Rule : in out Declarations_In_Blocks_Rule_Type) is
   begin
      Rule.Name       := new String'("Declarations_In_Blocks");
      Rule.Synonym    := new String'("Decl_Blocks");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("block statements with local " &
                                      "declarations");
      Rule.Diagnosis  := new String'("block statement with local " &
                                      "declarations");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Declarations_In_Blocks_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      if Statement_Kind (Element) = A_Block_Statement then

         declare
            Dcls : constant Asis.Element_List :=
                     Block_Declarative_Items (Element);
         begin

            for J in Dcls'Range loop
               if Element_Kind (Dcls (J)) = A_Declaration then
                  State.Detected := True;
                  exit;
               end if;
            end loop;

         end;

      end if;

   end Rule_Check_Pre_Op;

   ------------------------
   -- Default_Parameters --
   ------------------------

   procedure Init_Rule (Rule : in out Default_Parameters_Rule_Type) is
   begin
      Rule.Name       := new String'("Default_Parameters");
      Rule.Synonym    := new String'("Default_Par");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("declarations of default " &
                                      "subprogram parameters");
      Rule.Diagnosis  := new String'("default value for subprogram " &
                                     "parameter");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Default_Parameters_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin
      if Declaration_Kind (Element) = A_Parameter_Specification
        and then
         not Is_Nil (Initialization_Expression (Element))
      then
         State.Detected := True;
      end if;
   end Rule_Check_Pre_Op;

   ---------------------------
   -- Discriminated_Records --
   ---------------------------

   procedure Init_Rule (Rule : in out Discriminated_Records_Rule_Type) is
   begin
      Rule.Name       := new String'("Discriminated_Records");
      Rule.Synonym    := new String'("Discr_Rec");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("discriminanted records");
      Rule.Diagnosis  := new String'("declaration of discriminanted record");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Discriminated_Records_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      Encl_Type_Decl : Asis.Element;
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      if Definition_Kind (Element) = A_Known_Discriminant_Part then
         Encl_Type_Decl := Enclosing_Element (Element);

         if Declaration_Kind (Encl_Type_Decl) =
            An_Ordinary_Type_Declaration
         then
            Encl_Type_Decl := Type_Declaration_View (Encl_Type_Decl);

            if Type_Kind (Encl_Type_Decl) =
               A_Derived_Record_Extension_Definition
              or else
               Type_Kind (Encl_Type_Decl) in A_Record_Type_Definition ..
                  A_Tagged_Record_Type_Definition
            then
               State.Detected := True;
            end if;

         end if;

      end if;

   end Rule_Check_Pre_Op;

   ----------------------------
   -- Expanded_Loop_Exit_Names --
   ----------------------------

   procedure Init_Rule (Rule : in out Expanded_Loop_Exit_Names_Rule_Type) is
   begin
      Rule.Name       := new String'("Expanded_Loop_Exit_Names");
      Rule.Synonym    := new String'("Simple_Loop_Exit_Names");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("expanded loop names in exit statements");
      Rule.Diagnosis  := new String'("expanded loop name in exit statement");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Expanded_Loop_Exit_Names_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      if Statement_Kind (Element) = An_Exit_Statement
        and then
         Expression_Kind (Exit_Loop_Name (Element)) = A_Selected_Component
      then
         State.Detected  := True;
      end if;

   end Rule_Check_Pre_Op;

   ---------------------------
   -- Float_Equality_Checks --
   ---------------------------

   procedure Init_Rule (Rule : in out Float_Equality_Checks_Rule_Type) is
   begin
      Rule.Name       := new String'("Float_Equality_Checks");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("equality for float values");
      Rule.Diagnosis  := new String'("use of equality operation " &
                                     "for float values");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Float_Equality_Checks_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);

      Call_Element : Asis.Element;
   begin

      if Operator_Kind (Element) in
           An_Equal_Operator .. A_Not_Equal_Operator
      then
         Call_Element := Get_Call_Element;

         if Expression_Kind (Call_Element) = A_Function_Call
           and then
            Is_Predefined (Element)
           and then
            Is_Float
              (Actual_Parameter (Function_Call_Parameters (Call_Element) (1)))
         then
            State.Detected := True;
         end if;

      end if;

   end Rule_Check_Pre_Op;

   ---------------------
   -- GOTO_Statements --
   ---------------------

   procedure Init_Rule (Rule : in out GOTO_Statements_Rule_Type) is
   begin
      Rule.Name       := new String'("GOTO_Statements");
      Rule.Synonym    := new String'("Goto");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("goto statements");
      Rule.Diagnosis  := new String'("goto statement");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out GOTO_Statements_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      if Statement_Kind (Element) = A_Goto_Statement then
         State.Detected := True;
      end if;

   end Rule_Check_Pre_Op;

   ----------------------
   -- Improper_Returns --
   ----------------------

   procedure Init_Rule (Rule : in out Improper_Returns_Rule_Type) is
   begin
      Rule.Name       := new String'("Improper_Returns");
      Rule.Synonym    := new String'("Proper_Returns");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("improper use of return statements");
      Rule.Diagnosis  :=
        new String'("#1#return statement in a procedure body" &
                    "#2#more then one return statement in a function body");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Improper_Returns_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      Enclosing_Body_Idx : Elmt_Idx;
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      if Statement_Kind (Element) = A_Return_Statement then
         Enclosing_Body_Idx := Enclosing_Subprogram_Body;

         pragma Assert (Present (Enclosing_Body_Idx));

         case Declaration_Kind (Get_Element (Enclosing_Body_Idx)) is
            when A_Procedure_Body_Declaration =>
               State.Detected  := True;
               State.Diagnosis := 1;

            when A_Function_Body_Declaration =>

               if Has_Return (Enclosing_Body_Idx) then
                  State.Detected  := True;
                  State.Diagnosis := 2;
               else
                  Set_Has_Return (Enclosing_Body_Idx);
               end if;

            when others =>
               null;
         end case;

      end if;

   end Rule_Check_Pre_Op;

   -----------------------------------------
   -- Improperly_Called_Protected_Entries --
   -----------------------------------------

   procedure Init_Rule
     (Rule : in out Improperly_Called_Protected_Entries_Rule_Type)
   is
   begin
      Rule.Name       := new String'("Improperly_Called_Protected_Entries");
      Rule.Synonym    := new String'("Max_Calls_To_Protected_Entry");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("max number of calls to protected entry");
      Rule.Diagnosis  := new String'("more then one call to this entry");
   end Init_Rule;

   procedure Check_Global_Structure_Node
     (Rule     :     Improperly_Called_Protected_Entries_Rule_Type;
      N        :     Gnatcheck.Global_State.GS_Node_Id;
      Detected : out Boolean)
   is
      pragma Unreferenced (Rule);

      Next_N       : GS_Node_Id;
      Num_Of_Calls : Natural := 0;
   begin
      Detected := False;

      if GS_Node_Kind (N) = A_Protected_Entry then

         Reset_Itrerator (For_Node => N, Call_Set => Calls);
         Next_N := Next_Node;

         while Present (Next_N) loop

            if GS_Node_Kind (Next_N) = A_Task_Object then
               Num_Of_Calls := Num_Of_Calls + 1;

               if Num_Of_Calls > 1 then
                  Detected := True;
                  exit;
               end if;

            end if;

            Next_N := Next_Node;
         end loop;

      end if;

   end Check_Global_Structure_Node;

   -----------------------
   -- Limited_Renamings --
   -----------------------

   procedure Init_Rule (Rule : in out Limited_Renamings_Rule_Type) is
   begin
      Rule.Name       := new String'("Limited_Renamings");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("restrictions on renaming declarations");
      Rule.Diagnosis  :=
        new String'("#1#this form of renaming is not allowed" &
                    "#2#222222222222222222");
   end Init_Rule;

   --  This rule combines a part of the SPARK limitations imposed on renamings.
   --  It is formulated for renaming declarations only, not for the use of
   --  renamed entities. The following situations should be detected:

   --  Renamed entities: only subprograms declared immediately within package
   --  specs and only child packages can be renamed. All other cases of
   --  subprogram and package renamings should be detected.

   --  Limitations on new and old names: the name after RENAMES should have
   --  the form package_name.entity_name, the new name should be exactly the
   --  same as entity_name, entity_name should not itself be detected by a
   --  renaming declaration. Moreover, in case of a subprogram renaming, the
   --  new and the old profiles should be the same (the same parameter and
   --  subtype names should be used). All the renamings that do not follow
   --  these rules should be detected.

   --  Placement of renamings. According to the definition of SPARK, the
   --  following restrictions are imposed on the placement of renaming
   --  declarations:
   --
   --  for subprogram renamings (that are not operator renamings):
   --  - if the package where the subprogram is declared is a local package,
   --    renaming is allowed immediately after the declaration of this
   --    package;
   --  - if the package where the subprogram is declared is a library-level
   --    package, renaming is allowed at the start of the body of a library
   --    package (or library subprogram) that "withes" this package;
   --
   --  for operator renamings: the same is allowed as for subprogram renamings
   --  plus renamings are allowed at the start of the visible or private part
   --  of the library package that "withes" the package where the operator is
   --  declared;
   --
   --  for package renamings: the renaming of a (child!) package is allowed
   --  only immediately within a library package or library subprogram that
   --  "withes" this package;
   --
   --  All the other cases of renaming declaration placement should be
   --  detected.
   --
   --  Note that the rules about allowed remaning placement are taken from the
   --  definition of the SPARK subset. This definition uses the following
   --  wording: "at the start of the body", "at the start of the visible
   --  (private) part", and it the same time the SPARK book contains examples
   --  where an (allowed) renaming follows an object declaration. So we do
   --  not check that renamiings precede all the non-renaming declarations.

   --  All the things stated above are checked and detected in the order given.
   --  If some feature is detected for a renaming declaration, all the other
   --  things are not checked for this renaming declaration

   --  Current implementation limitation: an the moment this rule is not
   --  completely checked for renaming of predefined operators.

   procedure Rule_Check_Pre_Op
     (Rule    : in out Limited_Renamings_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
   pragma Unreferenced (Rule, Control);
   begin

      --  Syntax of renaming declarations: all forms of  renaming declarations
      --  except package and subprogram renaming declarations should be
      --  detected.

      case Declaration_Kind (Element) is
         when An_Object_Renaming_Declaration           |
              An_Exception_Renaming_Declaration        |
              A_Generic_Package_Renaming_Declaration   |
              A_Generic_Procedure_Renaming_Declaration =>

            State.Detected  := True;
            State.Diagnosis := 1;
            return;

         when A_Package_Renaming_Declaration   |
              A_Procedure_Renaming_Declaration |
              A_Function_Renaming_Declaration  =>

            --  We have to analyse this renaming in more details
            null;

         when others =>
            --  Not a renaming declaration, so - nothing to do!
            return;
      end case;

      --  Renamed entities: only subprograms declared immediately within
      --  package specs and only child packages can be renamed. All other cases
      --  of subprogram and package renamings should be detected.

      --  ... to be continued...
   end Rule_Check_Pre_Op;

   -------------------------------
   -- Library_Level_Subprograms --
   -------------------------------

   procedure Init_Rule (Rule : in out Library_Level_Subprograms_Rule_Type) is
   begin
      Rule.Name       := new String'("Library_Level_Subprograms");
      Rule.Synonym    := new String'("LL_Subpr");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("library level subprograms");
      Rule.Diagnosis  := new String'("declaration of library level " &
                                     "subprogram");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Library_Level_Subprograms_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      El_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (Element);
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      case El_Kind is
         when A_Procedure_Declaration      |
              A_Function_Declaration       |
              A_Procedure_Instantiation    |
              A_Function_Instantiation     |
              A_Procedure_Body_Declaration |
              A_Function_Body_Declaration  =>

            if Is_Nil (Enclosing_Element (Element))
              and then
               (El_Kind not in A_Procedure_Body_Declaration ..
                               A_Function_Body_Declaration
                 or else
                Is_Nil (Corresponding_Declaration (Element)))
              and then
               Unit_Class (Enclosing_Compilation_Unit (Element)) /=
               A_Separate_Body
            then
               --  If both spec and body are provided for library-level
               --  subprogram, we do not detect the rule violation for the
               --  body
               State.Detected := True;
            end if;

         when others =>
            null;
      end case;

   end Rule_Check_Pre_Op;

   --------------------
   -- Local_Packages --
   --------------------

   procedure Init_Rule (Rule : in out Local_Packages_Rule_Type) is
   begin
      Rule.Name       := new String'("Local_Packages");
      Rule.Synonym    := new String'("Local_Pckg");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("local packages");
      Rule.Diagnosis  := new String'("declaration of local package");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Local_Packages_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      Decl_Kind : constant Declaration_Kinds := Declaration_Kind (Element);
      CU_Kind   : constant Unit_Kinds        := Unit_Kind (
        Enclosing_Compilation_Unit (Element));
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      if Decl_Kind = A_Package_Declaration
       and then
         (CU_Kind = A_Package or else CU_Kind = A_Generic_Package)
       and then
         not Is_Nil (Enclosing_Element (Element))
      then
         State.Detected := True;
      end if;

   end Rule_Check_Pre_Op;

   -----------------------------------------------
   -- Multiple_Entries_In_Protected_Definitions --
   -----------------------------------------------

   procedure Init_Rule
     (Rule : in out Multiple_Entries_In_Protected_Definitions_Rule_Type)
   is
   begin
      Rule.Name := new String'("Multiple_Entries_In_Protected_Definitions");
      Rule.Synonym    := new String'("One_Entry_In_PO");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("protected definitions with more then " &
                                     "one entry");
      Rule.Diagnosis  := new String'("more then one entry in protected " &
                                     "definition");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Multiple_Entries_In_Protected_Definitions_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
      Enclosing_Def : Asis.Element;
   begin

      --  If we would check this rule not for an entry declaration, but for the
      --  whole protected definition, this would be more effective

      if Declaration_Kind (Element) = An_Entry_Declaration then
         Enclosing_Def := Get_Enclosing_Element;

         if Definition_Kind (Enclosing_Def) = A_Protected_Definition then

            declare
               Visible_Entries : constant Asis.Element_List :=
                 Visible_Part_Items (Enclosing_Def);
               Visible_Entries_Num : Natural := 0;
               First_Visible_Entry : Natural := 0;

               Private_Entries : constant Asis.Element_List :=
                 Private_Part_Items (Enclosing_Def);
               Private_Entries_Num : Natural := 0;
               First_Private_Entry : Natural := 0;
            begin

               for J in Visible_Entries'Range loop

                  if Declaration_Kind (Visible_Entries (J)) =
                     An_Entry_Declaration
                  then
                     Visible_Entries_Num := Visible_Entries_Num + 1;

                     if First_Visible_Entry = 0 then
                        First_Visible_Entry := First_Visible_Entry + 1;
                     end if;
                  end if;

               end loop;

               if First_Visible_Entry /= 0
                 and then
                  Is_Equal (Element, Visible_Entries (First_Visible_Entry))
               then
                  --  This is the first declared entry, in no case we can
                  --  generate a diagnosis for it
                  return;
               end if;

               if Visible_Entries_Num > 0 then
                  State.Detected := True;
                  --  No need to analyze private entries, if any
                  return;
               else

                  for J in Private_Entries'Range loop

                     if Declaration_Kind (Private_Entries (J)) =
                        An_Entry_Declaration
                     then
                        Private_Entries_Num := Private_Entries_Num + 1;

                        if First_Private_Entry = 0 then
                           First_Private_Entry := First_Private_Entry + 1;
                        end if;
                     end if;

                  end loop;

                  if not Is_Equal (Element,
                         Private_Entries (First_Private_Entry))
                  then
                     State.Detected := True;
                  end if;

               end if;

            end;

         end if;

      end if;

   end Rule_Check_Pre_Op;

   ------------------
   -- Name_Clashes --
   ------------------

   procedure Init_Rule (Rule : in out Name_Clashes_Rule_Type) is
   begin
      Rule.Name       := new String'("Name_Clashes");
      Rule.Synonym    := new String'("Restrict_Name_Space");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("restrictions on name space");
      Rule.Diagnosis  := new String'("use of forbidden identifier");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Name_Clashes_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      if (Defining_Name_Kind (Element) = A_Defining_Identifier
         or else
          Defining_Name_Kind (Element) = A_Defining_Enumeration_Literal)
        and then
         Gnatcheck.Name_Dictionary.Name_In_Dictionary
           (Defining_Name_Image (Element))
      then
         State.Detected  := True;
      end if;

   end Rule_Check_Pre_Op;

   procedure Process_Rule_Parameter
     (Rule    : in out Name_Clashes_Rule_Type;
      Param   :        String;
      Enable  :        Boolean)
   is
      Success : Boolean := False;
   begin

      if Enable then
         Gnatcheck.Name_Dictionary.Scan_Dictionary_File (Param, Success);
      end if;

      if Success then
         Set_Rule_State (Get_Rule (Rule.Name.all), Enabled);
      end if;

   end Process_Rule_Parameter;

   ------------------------------
   -- Non_Qualified_Aggregates --
   ------------------------------

   procedure Init_Rule (Rule : in out Non_Qualified_Aggregates_Rule_Type) is
   begin
      Rule.Name       := new String'("Non_Qualified_Aggregates");
      Rule.Synonym    := new String'("Qualified_Aggr");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("non-qualified aggregates");
      Rule.Diagnosis  := new String'("aggregate is not a part of a " &
                                     "qualified expression");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Non_Qualified_Aggregates_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      if Expression_Kind (Element) in
         A_Record_Aggregate .. A_Named_Array_Aggregate
       and then
         Expression_Kind (Get_Enclosing_Element) /= A_Qualified_Expression
      then
         State.Detected  := True;
      end if;

   end Rule_Check_Pre_Op;

   --------------------------
   -- Non_SPARK_Attributes --
   --------------------------

   procedure Init_Rule (Rule : in out Non_SPARK_Attributes_Rule_Type) is
   begin
      Rule.Name       := new String'("Non_SPARK_Attributes");
      Rule.Synonym    := new String'("SPARK_Attributes");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("attributes that are not from the " &
                                     "SPARK subset");
      Rule.Diagnosis  := new String'("attribute is not from the SPARK subset");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Non_SPARK_Attributes_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      if Expression_Kind (Element) = An_Attribute_Reference then

         case Attribute_Kind (Element) is
            when An_Adjacent_Attribute          |
                 An_Aft_Attribute               |
                 A_Base_Attribute               |
                 A_Ceiling_Attribute            |
                 A_Component_Size_Attribute     |
                 A_Compose_Attribute            |
                 A_Copy_Sign_Attribute          |
                 A_Delta_Attribute              |
                 A_Denorm_Attribute             |
                 A_Digits_Attribute             |
                 An_Exponent_Attribute          |
                 A_First_Attribute              |
                 A_Floor_Attribute              |
                 A_Fore_Attribute               |
                 A_Fraction_Attribute           |
                 A_Last_Attribute               |
                 A_Leading_Part_Attribute       |
                 A_Length_Attribute             |
                 A_Machine_Attribute            |
                 A_Machine_Emax_Attribute       |
                 A_Machine_Emin_Attribute       |
                 A_Machine_Mantissa_Attribute   |
                 A_Machine_Overflows_Attribute  |
                 A_Machine_Radix_Attribute      |
                 A_Machine_Rounds_Attribute     |
                 A_Max_Attribute                |
                 A_Min_Attribute                |
                 A_Model_Attribute              |
                 A_Model_Emin_Attribute         |
                 A_Model_Epsilon_Attribute      |
                 A_Model_Mantissa_Attribute     |
                 A_Model_Small_Attribute        |
                 A_Modulus_Attribute            |
                 A_Pos_Attribute                |
                 A_Pred_Attribute               |
                 A_Range_Attribute              |
                 A_Remainder_Attribute          |
                 A_Rounding_Attribute           |
                 A_Safe_First_Attribute         |
                 A_Safe_Last_Attribute          |
                 A_Scaling_Attribute            |
                 A_Signed_Zeros_Attribute       |
                 A_Size_Attribute               |
                 A_Small_Attribute              |
                 A_Succ_Attribute               |
                 A_Truncation_Attribute         |
                 An_Unbiased_Rounding_Attribute |
                 A_Val_Attribute                |
                 A_Valid_Attribute              =>

               --  Spark subset, this is allowed
               null;
            when others =>
               State.Detected := True;
         end case;

      end if;

   end Rule_Check_Pre_Op;

   ------------------------------
   -- Non_Tagged_Derived_Types --
   ------------------------------

   procedure Init_Rule (Rule : in out Non_Tagged_Derived_Types_Rule_Type) is
   begin
      Rule.Name       := new String'("Non_Tagged_Derived_Types");
      Rule.Synonym    := new String'("Derived_Types");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("derived types that are not " &
                                      "type extensions");
      Rule.Diagnosis  := new String'("derived type that is not a type " &
                                     "extension");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Non_Tagged_Derived_Types_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      if Type_Kind (Element) = A_Derived_Type_Definition then
         State.Detected := True;
      end if;

   end Rule_Check_Pre_Op;

   ----------------------
   -- Outer_Loop_Exits --
   ----------------------

   procedure Init_Rule (Rule : in out Outer_Loop_Exits_Rule_Type) is
   begin
      Rule.Name       := new String'("Outer_Loop_Exits");
      Rule.Synonym    := new String'("Global_Loop_Exit");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("exiting more then one loop at once");
      Rule.Diagnosis  := new String'("exit out of the nesting loop");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Outer_Loop_Exits_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
      Loop_Name      : Asis.Element;
      Enclosing_Loop : Asis.Element;
      Steps_Up       : Elmt_Idx := 0;
   begin

      if Statement_Kind (Element) = An_Exit_Statement then
         Loop_Name := Exit_Loop_Name (Element);

         if not Is_Nil (Loop_Name) then

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

            loop
               Enclosing_Loop := Get_Enclosing_Element (Steps_Up);

               exit when Statement_Kind (Enclosing_Loop) in
                  A_Loop_Statement .. A_For_Loop_Statement;

               Steps_Up := Steps_Up + 1;
            end loop;

            if not Is_Equal
                 (Corresponding_Name_Definition (Loop_Name),
                  Statement_Identifier (Enclosing_Loop))
            then
               State.Detected := True;
            end if;

         end if;

      end if;

   end Rule_Check_Pre_Op;

   --------------------------
   -- Overloaded_Operators --
   --------------------------

   procedure Init_Rule (Rule : in out Overloaded_Operators_Rule_Type) is
   begin
      Rule.Name       := new String'("Overloaded_Operators");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("operator overloading");
      Rule.Diagnosis  := new String'("overloading of an operator symbol");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Overloaded_Operators_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);

      Enclosing_Decl : Asis.Element;
   begin

      if Defining_Name_Kind (Element) = A_Defining_Operator_Symbol then
         Enclosing_Decl := Get_Enclosing_Element;

         if Defining_Name_Kind (Enclosing_Decl) = A_Defining_Expanded_Name then
            Enclosing_Decl := Get_Enclosing_Element (Steps_Up => 1);
         end if;

         case Declaration_Kind (Enclosing_Decl) is
            when A_Function_Body_Declaration =>

               if Is_Nil (Corresponding_Declaration (Enclosing_Decl)) then
                  State.Detected := True;
               end if;

            when A_Function_Renaming_Declaration =>

               if not Is_Renaming_As_Body (Enclosing_Decl) then
                  State.Detected := True;
               end if;

            when others =>
               State.Detected := True;
         end case;

      end if;

   end Rule_Check_Pre_Op;

   ---------------
   -- Recursion --
   ---------------

   procedure Check_Global_Structure_Node
     (Rule     :     Recursion_Rule_Type;
      N        :     Gnatcheck.Global_State.GS_Node_Id;
      Detected : out Boolean)
   is
      pragma Unreferenced (Rule);
   begin
      Detected := Gnatcheck.Global_State.Is_Recursive_Node (N);
   end Check_Global_Structure_Node;

   procedure Init_Rule (Rule : in out Recursion_Rule_Type) is
   begin
      Rule.Name       := new String'("Recursion");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("recursion (call graph cycles)");
      Rule.Diagnosis  := new String'("recursive subprogram");
   end Init_Rule;

   ---------------------------
   -- Side_Effect_Functions --
   ---------------------------

   procedure Collect_Global_Info_Pre_Op
     (Rule    : in out Side_Effect_Functions_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule, Control);

      Current_SE_Status : Side_Effect_Statuses;
      --  Side effect that the enclosing scope that is known at the moment of
      --  the call

      Added_Side_Effect           : Side_Effect_Statuses;
      Local_SE_Level              : Scope_Levels;
--      Side_Effect_SLOC            : String_Loc;
      Calls_To_Unknown_SE_Routine : Boolean;
   begin

      if Is_Global_Scope (Current_Scope)
         --  no side effect can be in a global scope!
        or else
         Side_Effect_Defined (Current_Scope)
        or else not In_Executable_Code (State)
      then
         return;
      end if;

      if Can_Cause_Side_Effect (Element) then

         Current_SE_Status := Side_Effect_Status (Current_Scope);

         Define_Side_Effect
           (Element              => Element,
            New_SE_Status        => Added_Side_Effect,
            Is_Unresolved_Call   => Calls_To_Unknown_SE_Routine,
            Change_Data_At_Level => Local_SE_Level);

         if Added_Side_Effect > Current_SE_Status
           and then
            not (Added_Side_Effect = Local_Side_Effect and then
                 Local_SE_Level >= Scope_Level (Current_Scope))
         then
            Set_Side_Effect_Status
              (Current_Scope,
               Added_Side_Effect,
               Build_GNAT_Location (Element));

            if Added_Side_Effect = Global_Side_Effect then
               Set_Side_Effect_Defined (Current_Scope);
            elsif Added_Side_Effect = Local_Side_Effect then
               Set_Local_Side_Effect_Level
                 (Current_Scope, Local_SE_Level);
            end if;

         elsif Added_Side_Effect = Current_SE_Status
             and then
               Added_Side_Effect = Local_Side_Effect
             and then
               Local_Side_Effect_Level (Current_Scope) > Local_SE_Level
         then
            Set_Side_Effect_Status
              (Current_Scope,
               Added_Side_Effect,
               Build_GNAT_Location (Element));

            Set_Local_Side_Effect_Level
              (Current_Scope, Local_SE_Level);
         end if;

         if not Side_Effect_Defined (Current_Scope)
           and then
            Calls_To_Unknown_SE_Routine
         then
            Set_Call_To_Unknown_SE (Current_Scope);
         end if;

      end if;

   end Collect_Global_Info_Pre_Op;

   procedure Collect_Global_Info_Post_Op
     (Rule    : in out Side_Effect_Functions_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule, Control, State);
      Next_Call              : Call_Lists.Cursor;
      Call_Unknown_CE_Entity : Boolean := False;
   begin

      if Is_Scope (Element)
        and then
--         Declaration_Kind (Element) not in
--            A_Package_Declaration .. A_Package_Body_Declaration
--        and then
         not Side_Effect_Defined (Current_Scope)
      then
         --  Iterate through all the direct calls (at the moment we know all
         --  of them) and look if we can make any final conclusion concerning
         --  the side effect of the current scope.

         Next_Call :=
           Call_Lists.First (GS_Nodes.Table (Current_Scope).Calls_Chain);

         while Next_Call /= Call_Lists.No_Element loop

            Correct_Side_Effect_Status
              (For_Node  => Current_Scope,
               From_Node => Call_Lists.Element (Next_Call));

            if Side_Effect_Status (Current_Scope) = Global_Side_Effect then
               --  Nothing else to check, so
               exit;
            elsif not Side_Effect_Defined (Call_Lists.Element (Next_Call)) then
               Call_Unknown_CE_Entity := True;
            end if;

            Next_Call := Call_Lists.Next (Next_Call);
         end loop;

         if not Call_Unknown_CE_Entity
           or else
            Side_Effect_Status (Current_Scope) = Global_Side_Effect
         then
            Set_Side_Effect_Defined (Current_Scope);
         elsif Call_Unknown_CE_Entity then
            Set_Call_To_Unknown_SE (Current_Scope);
         end if;

      end if;

   end Collect_Global_Info_Post_Op;

   procedure Analyze_Global_Structure
     (Rule : Side_Effect_Functions_Rule_Type)
   is
      pragma Unreferenced (Rule);
   begin
      Gnatcheck.Global_State.CG.Set_Side_Effect;
   end Analyze_Global_Structure;

   procedure Check_Global_Structure_Node
     (Rule     :     Side_Effect_Functions_Rule_Type;
      N        :     Gnatcheck.Global_State.GS_Node_Id;
      Detected : out Boolean)
   is
      pragma Unreferenced (Rule);
   begin

      Detected :=
         Is_Local_Scope (N)
        and then
         GS_Node_Kind (N) = A_Function
        and then
         not (Side_Effect_Defined (N)
             and then
              Side_Effect_Status (N) = No_Side_Effect);

   end Check_Global_Structure_Node;

   procedure Init_Rule (Rule : in out Side_Effect_Functions_Rule_Type) is
   begin
      Rule.Name       := new String'("Side_Effect_Functions");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("side effect functions");
      Rule.Diagnosis  := new String'("function has side effect");
   end Init_Rule;

   -----------
   -- Slices --
   -----------

   procedure Init_Rule (Rule : in out Slices_Rule_Type) is
   begin
      Rule.Name       := new String'("Slices");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("slices");
      Rule.Diagnosis  := new String'("slice");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Slices_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      if Expression_Kind (Element) = A_Slice then
         State.Detected := True;
      end if;

   end Rule_Check_Pre_Op;

   ---------------------------------
   -- Unconstrained_Array_Returns --
   ---------------------------------

   procedure Init_Rule (Rule : in out Unconstrained_Array_Returns_Rule_Type) is
   begin
      Rule.Name       := new String'("Unconstrained_Array_Returns");
      Rule.Synonym    := new String'("Unconstr_Array_Return");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("functions returning unconstrained " &
                                      "arrays");
      Rule.Diagnosis  := new String'("function returns unconstrained array");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Unconstrained_Array_Returns_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      Arg_Element  : Asis.Element := Element;
      Return_Type  : Asis.Element;

      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      if Declaration_Kind (Element) = A_Function_Declaration
        or else
         ((Declaration_Kind (Element) = A_Function_Body_Declaration
          or else
           Declaration_Kind (Element) = A_Function_Body_Stub)
         and then
           Acts_As_Spec (Element))
        or else
         Declaration_Kind (Element) = A_Function_Instantiation
      then
         if Declaration_Kind (Element) = A_Function_Instantiation then
            Arg_Element := Corresponding_Declaration (Arg_Element);
         end if;

         Return_Type := Result_Profile (Arg_Element);
         Return_Type :=
           Corresponding_Name_Declaration (Normalize_Reference (Return_Type));

         if Is_Unconstrained_Array (Return_Type) then
            State.Detected := True;
         end if;

      end if;

   end Rule_Check_Pre_Op;

   ----------------------
   -- Universal_Ranges --
   ----------------------

   procedure Init_Rule (Rule : in out Universal_Ranges_Rule_Type) is
   begin
      Rule.Name       := new String'("Universal_Ranges");
      Rule.Synonym    := new String'("Universl_Ranges");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("ranges with universal integer bounds");
      Rule.Diagnosis  := new String'("range with universal integer bounds");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Universal_Ranges_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      Encl_Element : Asis.Element;
      Left_Bound   : Asis.Element;
      Right_Bound  : Asis.Element;
      Type_Def_El  : Asis.Element;

      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      if Discrete_Range_Kind (Element) =
           A_Discrete_Simple_Expression_Range
      then
         Encl_Element := Get_Enclosing_Element;

         if Constraint_Kind (Encl_Element) = An_Index_Constraint
           or else
            Definition_Kind (Encl_Element) = A_Discrete_Subtype_Definition
           or else
            Declaration_Kind (Encl_Element) = A_Loop_Parameter_Specification
         then
            Left_Bound := Lower_Bound (Element);

            Type_Def_El :=
              Type_Declaration_View (Corresponding_Expression_Type
                (Left_Bound));

            if Root_Type_Kind (Type_Def_El) =
               A_Universal_Integer_Definition
            then

               Right_Bound := Upper_Bound (Element);

               Type_Def_El :=
                 Type_Declaration_View (Corresponding_Expression_Type
                   (Right_Bound));

               if Root_Type_Kind (Type_Def_El) =
                  A_Universal_Integer_Definition
               then
                  State.Detected := True;
               end if;

            end if;

         end if;

      end if;

   end Rule_Check_Pre_Op;

   ------------------------
   -- Unused_Subprograms --
   ------------------------

   procedure Analyze_Global_Structure (Rule : Unused_Subprograms_Rule_Type) is
      pragma Unreferenced (Rule);
   begin
      Gnatcheck.Global_State.CG.Set_Used_Entities;
   end Analyze_Global_Structure;

   procedure Check_Global_Structure_Node
     (Rule     :     Unused_Subprograms_Rule_Type;
      N        :     Gnatcheck.Global_State.GS_Node_Id;
      Detected : out Boolean)
   is
      pragma Unreferenced (Rule);
   begin
      Detected :=
         Is_Subprogram (N)
        and then
         GS_Node_Renaming_Kind (N) /= Pass_Actual_Subprogram
        and then
         not Gnatcheck.Global_State.CG.Is_Called (N);
   end Check_Global_Structure_Node;

   procedure Init_Rule (Rule : in out Unused_Subprograms_Rule_Type) is
   begin
      Rule.Name       := new String'("Unused_Subprograms");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("unused subprograms");
      Rule.Diagnosis  := new String'("unused subprogram");
   end Init_Rule;

   -------------------------
   -- USE_PACKAGE_Clauses --
   -------------------------

   procedure Init_Rule (Rule : in out USE_PACKAGE_Clauses_Rule_Type) is
   begin
      Rule.Name       := new String'("USE_PACKAGE_Clauses");
      Rule.Synonym    := new String'("Use_Pckg_Clauses");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("use clause for packages");
      Rule.Diagnosis  := new String'("use clause for package");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out USE_PACKAGE_Clauses_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      if Clause_Kind (Element) = A_Use_Package_Clause then
         State.Detected := True;
      end if;

   end Rule_Check_Pre_Op;

   ----------------------------------------------
   -- Volatile_Objects_Without_Address_Clauses --
   ----------------------------------------------

   procedure Init_Rule
     (Rule : in out Volatile_Objects_Without_Address_Clauses_Rule_Type)
   is
   begin
      Rule.Name := new String'("Volatile_Objects_Without_Address_Clauses");
      Rule.Synonym    := new String'("Volatile_Requires_Addr_Clause");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("volatile objects with no " &
                                     "address clause");
      Rule.Diagnosis  := new String'("volatile object with no address clause");
   end Init_Rule;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Volatile_Objects_Without_Address_Clauses_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      Enclosing_Decl : Asis.Element;
      pragma Unreferenced (Rule);
      pragma Unreferenced (Control);
   begin

      if Defining_Name_Kind (Element) = A_Defining_Identifier then

         Enclosing_Decl := Get_Enclosing_Element;

         if Declaration_Kind (Enclosing_Decl) = A_Variable_Declaration
           and then
            Is_Volatile (Element)
           and then
            not Has_Address_Clause (Element)
         then
            State.Detected  := True;
         end if;

      end if;

   end Rule_Check_Pre_Op;

end Gnatcheck.Rules.Default;
