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

with Ada.Characters.Handling;    use Ada.Characters.Handling;
with Ada.Strings;                use Ada.Strings;
with Ada.Strings.Fixed;          use Ada.Strings.Fixed;
with Ada.Strings.Wide_Fixed;     use Ada.Strings.Wide_Fixed;

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

with Namet;
with Snames;
with Table;

with ASIS_UL.Misc;               use ASIS_UL.Misc;
with ASIS_UL.Output;             use ASIS_UL.Output;

with Gnatcheck.ASIS_Utilities;   use Gnatcheck.ASIS_Utilities;
with Gnatcheck.Traversal_Stack;  use Gnatcheck.Traversal_Stack;

package body Gnatcheck.Rules.Custom_1 is

   -------------------------------------
   -- General-purpose local functions --
   -------------------------------------

   -------------------------------------
   -- Rule parameter parsing routines --
   -------------------------------------

   procedure Parse_Par
     (First_Par_Id : out Natural;
      Last_Par_Id  : out Positive;
      First_Str_Id : out Natural;
      Last_Str_Id  : out Positive;
      Par_String   :     String);
   --  This function parses its Par_String parameter that is supposed to be a
   --  slice of the rule parameter separated by obtained by
   --  Gnatcheck.Rules.Rule_Table.Process_Rule_Option (see also the
   --  documentation of Process_Rule_Parameter for Rule_Template type in
   --  Gnatcheck.Rules). If Par_String  contains a '=' character, it sets
   --  First_Par_Id and Last_Par_Id to point to the part if Par_String that
   --  precedes the (leftmost) '=' character (cutting out the leading and
   --  trailing white spaces if any), and First_Str_Id and Last_Str_Id are
   --  set to point to the part if Par_String that follows the (leftmost) '='
   --  character (cutting out the leading and trailing white spaces if any).
   --  If Par_String does not contain a '=' string, First_Str_Id is set to
   --  0 (Last_Str_Id is undefined), and First_Par_Id and  Last_Par_Id point
   --  to the leftmost and rightmost non-blank characrters ofPar_String.
   --  If Par_String does not contain any non-blank character, First_Par_Id
   --  and First_Str_Id are set to 0, Last_Par_Id and Last_Str_Id are
   --  indefinite. If Par_String has '=' as it first (non-blank) character
   --  (most probably this means a bug in the parameter structure),
   --  First_Par_Id is set to 0, Last_Par_Id is undefinite, Last_Str_Id and
   --  Par_String are set to point to (non-blank) part of Par_String after '='/

   -----------------------------------------------
   -- Bodies of general-purpose local functions --
   -----------------------------------------------

   ---------------
   -- Parse_Par --
   ---------------

   procedure Parse_Par
     (First_Par_Id : out Natural;
      Last_Par_Id  : out Positive;
      First_Str_Id : out Natural;
      Last_Str_Id  : out Positive;
      Par_String   :     String)
   is
      Eq_Pos : Natural := 0;
      Tmp    : Positive;
   begin

      for J in Par_String'Range loop

         if Par_String (J) = '=' then
            Eq_Pos := J;
            exit;
         end if;

      end loop;

      if Eq_Pos = 0 then
         Tmp := Par_String'Last;
      else
         Tmp := Eq_Pos - 1;
      end if;

      First_Par_Id := 0;

      for J in Par_String'First .. Tmp loop

         if not Is_White_Space (Par_String (J)) then
            First_Par_Id := J;
            exit;
         end if;

      end loop;

      if First_Par_Id > 0 then

         for J in reverse First_Par_Id .. Tmp loop

            if not Is_White_Space (Par_String (J)) then
               Last_Par_Id := J;
               exit;
            end if;

         end loop;

      end if;

      First_Str_Id := 0;

      if Eq_Pos > 0 then

         for J in Eq_Pos + 1 .. Par_String'Last loop

            if not Is_White_Space (Par_String (J)) then
               First_Str_Id := J;
               exit;
            end if;

         end loop;

         if First_Str_Id > 0 then

            for J in reverse First_Str_Id .. Par_String'Last loop

               if not Is_White_Space (Par_String (J)) then
                  Last_Str_Id := J;
                  exit;
               end if;

            end loop;

         end if;

      end if;

   end Parse_Par;

   --------------------------------------------
   -- Bodies of rule implementation routines --
   --------------------------------------------

   ----------------------
   -- Anonymous_Arrays --
   ----------------------

   ----------------------------------
   -- Init_Rule (Anonymous_Arrays) --
   ----------------------------------

   procedure Init_Rule (Rule : in out Anonymous_Arrays_Rule_Type) is
   begin
      Rule.Name       := new String'("Anonymous_Arrays");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("anonymous array types");
      Rule.Diagnosis  := new String'("anonymous array type");
   end Init_Rule;

   ------------------------------------------
   -- Rule_Check_Pre_Op (Anonymous_Arrays) --
   ------------------------------------------

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

      if Type_Kind (Element) in
           An_Unconstrained_Array_Definition .. A_Constrained_Array_Definition
        and then
         Declaration_Kind (Get_Enclosing_Element) in
           A_Variable_Declaration .. A_Constant_Declaration
      then
         State.Detected  := True;
      end if;

   end Rule_Check_Pre_Op;

   -------------------------------------------
   -- Enumeration_Ranges_In_CASE_Statements --
   -------------------------------------------

   -------------------------------------------------------
   -- Init_Rule (Enumeration_Ranges_In_CASE_Statements) --
   -------------------------------------------------------

   procedure Init_Rule
     (Rule : in out Enumeration_Ranges_In_CASE_Statements_Rule_Type)
   is
   begin
      Rule.Name       := new String'("Enumeration_Ranges_In_CASE_Statements");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("enumeration ranges as choices in case "
                                   & "statements");
      Rule.Diagnosis  := new String'("enumeration range as a choice in a "
                                   & "case statement");
   end Init_Rule;

   ---------------------------------------------------------------
   -- Rule_Check_Pre_Op (Enumeration_Ranges_In_CASE_Statements) --
   ---------------------------------------------------------------

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

      if Definition_Kind (Element) = A_Discrete_Range
       and then
         Path_Kind (Get_Enclosing_Element) = A_Case_Path
      then
         Case_Var := Case_Expression (Get_Enclosing_Element (Steps_Up => 1));

         if Has_Enumeration_Type (Case_Var) then
            State.Detected := True;
         end if;

      end if;

   end Rule_Check_Pre_Op;

   --------------------------------
   -- Exceptions_As_Control_Flow --
   --------------------------------

   --------------------------------------------
   -- Init_Rule (Exceptions_As_Control_Flow) --
   --------------------------------------------

   procedure Init_Rule (Rule : in out Exceptions_As_Control_Flow_Rule_Type) is
   begin
      Rule.Name       := new String'("Exceptions_As_Control_Flow");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("exceptions for control flow");
      Rule.Diagnosis  := new String'("this exception will be handled in " &
                                     "the same body, line%1%");
   end Init_Rule;

   ----------------------------------------------------
   -- Rule_Check_Pre_Op (Exceptions_As_Control_Flow) --
   ----------------------------------------------------

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

      Raised_Exc : Asis.Element;
      Encl_Body  : Asis.Element;
      Next_Frame : Asis.Element := Nil_Element;
      --  Construct that can contain exception handlers

      Step_Up    : Elmt_Idx := 0;
   begin

      if Statement_Kind (Element) = A_Raise_Statement then
         Raised_Exc := Raised_Exception (Element);

         if not Is_Nil (Raised_Exc) then
            --  First, get the enclosing body:

            Encl_Body := Get_Enclosing_Element (Step_Up);

            while Element_Kind (Encl_Body) in A_Statement .. A_Path loop
               Step_Up   := Step_Up + 1;
               Encl_Body := Get_Enclosing_Element (Step_Up);
            end loop;

            if Declaration_Kind (Encl_Body) not in
              A_Procedure_Body_Declaration .. A_Function_Body_Declaration
            then
               return;
            end if;

            Raised_Exc := Get_Name_Definition (Raised_Exc);

            Step_Up := 0;

            Check_Frames : loop
               --  Computing the next frame

               while not Is_Frame (Next_Frame) loop
                  Next_Frame := Get_Enclosing_Element (Step_Up);
                  Step_Up    := Step_Up + 1;
               end loop;

               --  Processing the next frame

               declare
                  Handlers : constant Asis.Element_List :=
                    Get_Handlers (Next_Frame);

                  Handler     : Asis.Element := Nil_Element;
                  Handled_Exc : Asis.Element;
               begin

                  if Handlers'Length = 0 then
                     return;
                  end if;

                  Check_Handlers : for J in Handlers'Range loop

                     declare
                        Exc_Choices : constant Asis.Element_List :=
                          Exception_Choices (Handlers (J));
                     begin

                        for K in Exc_Choices'Range loop

                           if Definition_Kind (Exc_Choices (K)) =
                              An_Others_Choice
                           then
                              State.Detected := True;
                           else
                              Handled_Exc :=
                                Get_Name_Definition (Exc_Choices (K));

                              State.Detected :=
                                Is_Equal (Raised_Exc, Handled_Exc);
                           end if;

                           if State.Detected then
                              Handler := Handlers (J);
                              State.Diag_Params := Enter_String ("%1%" &
                                 Element_Span (Handler).First_Line'Img);

                              exit Check_Frames;
                           end if;

                        end loop;

                     end;

                  end loop Check_Handlers;

               end;

               exit Check_Frames when Is_Equal (Next_Frame, Encl_Body);

               --  Go to the next frame

               Next_Frame := Get_Enclosing_Element (Step_Up);

            end loop Check_Frames;

         end if;

      end if;

   end Rule_Check_Pre_Op;

   ---------------------------------------
   -- EXIT_Statements_With_No_Loop_Name --
   ---------------------------------------

   ---------------------------------------------------
   -- Init_Rule (EXIT_Statements_With_No_Loop_Name) --
   ---------------------------------------------------

   procedure Init_Rule
     (Rule : in out EXIT_Statements_With_No_Loop_Name_Rule_Type)
   is
   begin
      Rule.Name       := new String'("EXIT_Statements_With_No_Loop_Name");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("exit statements with no loop name");
      Rule.Diagnosis  := new String'("exit statement with no loop name");
   end Init_Rule;

   ---------------------------------------------------
   -- Init_Rule (EXIT_Statements_With_No_Loop_Name) --
   ---------------------------------------------------

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

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

   end Rule_Check_Pre_Op;

   -----------------------------------
   -- Explicit_Full_Discrete_Ranges --
   -----------------------------------

   ------------------------------------------------
   --  Init_Rule (Explicit_Full_Discrete_Ranges) --
   ------------------------------------------------

   procedure Init_Rule (Rule : in out Explicit_Full_Discrete_Ranges_Rule_Type)
   is
   begin
      Rule.Name       := new String'("Explicit_Full_Discrete_Ranges");
      Rule.Synonym    := new String'("Explicit_Discrete_Ranges");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("explicit discrete ranges");
      Rule.Diagnosis  :=
        new String'("#1#bad discrete range, consider replacement " &
                       "with subtype mark"                         &
                    "#2#bad discrete range, consider replacement " &
                       "with 'Range attribute");
   end Init_Rule;

   --------------------------------------------------------
   --  Rule_Check_Pre_Op (Explicit_Full_Discrete_Ranges) --
   --------------------------------------------------------

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

      if Discrete_Range_Kind (Element) =
           A_Discrete_Simple_Expression_Range
      then
         L := Lower_Bound (Element);

         if Attribute_Kind (L) = A_First_Attribute then
            R := Upper_Bound (Element);

            if Attribute_Kind (R) = A_Last_Attribute then
               --  The argument discrete range is to be detected only if
               --  L and R are or ends with the same identifier

               L := Prefix (L);
               R := Prefix (R);

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

               if Expression_Kind (R) = A_Selected_Component then
                  L := Selector (R);
               end if;

               if Expression_Kind (L) = An_Identifier
                 and then
                  Expression_Kind (R) = An_Identifier
                 and then
                  To_Lower (To_String (Name_Image (L))) =
                  To_Lower (To_String (Name_Image (R)))
               then
                  --  Now we have to check that L (and, therefore R) is
                  --  either a subtype mark of a discrete (sub)type or a
                  --  reference to an array data object

                  L := Corresponding_Name_Declaration (L);

                  case Declaration_Kind (L) is
                     when An_Ordinary_Type_Declaration |
                          A_Subtype_Declaration        =>
                        --  It must be a discrete (sub)type!
                        State.Detected  := True;
                        State.Diagnosis := 1;
                     when A_Variable_Declaration         |
                          A_Constant_Declaration         |
                          A_Component_Declaration        |
                          A_Parameter_Specification      |
                          A_Return_Object_Declaration    |
                          An_Object_Renaming_Declaration |
                          A_Formal_Object_Declaration    =>

                        --  It must be a declaration of an array object or an
                        --  access object that points to an array object!
                        State.Detected  := True;
                        State.Diagnosis := 2;
                     when others =>
                        null;
                  end case;

               end if;

            end if;

         end if;

      end if;

   end Rule_Check_Pre_Op;

   -----------------------
   -- Forbidden_Pragmas --
   -----------------------

   --------------------------------------------------------
   -- Data structures and local subprograms for the rule --
   --------------------------------------------------------

   type Check_Status is (Off, On, Selective);
   --  The values of this type Say if a given pragma should be detected. The
   --  Selective value is used only for An_Implementation_Defined_Pragma
   --  Element kind, it means that only some of the GNAT-specific pragmas
   --  should be detected.

   Pragma_Check_Switch :
     array (Asis.Pragma_Kinds'(An_All_Calls_Remote_Pragma) ..
            Asis.Pragma_Kinds'(An_Unknown_Pragma)) of Check_Status :=
              (others => Off);
   --  Specifies which pagmas should be detected.

   GNAT_Pragma_Check_Switch :
     array (Snames.Pragma_Id) of Boolean := (others => False);
   --  Specifices which GNAT-specific pragmas should be detected. Note, that
   --  the index range covers all the pragma IDs, both standard and
   --  GNAT-specific, but only those components that correspond to
   --  GNAT-specific pragmas are referenced

   function Get_Pragma_Kind (S : String) return Pragma_Kinds;
   --  Tries to get from its argument (that is treated as a pragma name and is
   --  supposed to be obtained from the rule parameter) the corresponding
   --  ASIS Pragma_Kinds value. If S does not have a structure of an
   --  identifier, returns Not_A_Pragma

   function Get_GNAT_Pragma_Id (S : String) return Snames.Pragma_Id;
   --  Supposing that S is a name of a GNAT pragma, computes its Pragma_Id.
   --  Returns Unknown_Pragma if the argument is not a name of a GNAT-specific
   --  pragma.

   -------------------------
   -- Get_GNAT_Pragma_Id --
   ------------------------

   function Get_GNAT_Pragma_Id (S : String) return Snames.Pragma_Id is
      use Namet;
      Result : Snames.Pragma_Id := Snames.Unknown_Pragma;
      Pragma_Name_Id : Namet.Name_Id;
   begin

      if Is_Identifier (S) then
         Name_Len                    := S'Length;
         Name_Buffer (1 .. Name_Len) := To_Lower (S);
         Pragma_Name_Id              := Name_Find;
         Result                      := Snames.Get_Pragma_Id (Pragma_Name_Id);
      end if;

      return Result;
   end Get_GNAT_Pragma_Id;

   -----------------------------------------
   -- Get_Pragma_Kind (Forbidden_Pragmas) --
   -----------------------------------------

   function Get_Pragma_Kind (S : String) return Pragma_Kinds is
      use  type Snames.Pragma_Id;
      Result : Pragma_Kinds := Not_A_Pragma;
   begin

      if Is_Identifier (S) then

         begin

            case To_Lower (S (S'First)) is
               when 'a' | 'e' | 'o' | 'u'  =>
                  Result := Pragma_Kinds'Value ("an_" & S & "_pragma");
               when others =>
                  Result := Pragma_Kinds'Value ("a_" & S & "_pragma");
            end case;

         exception
            when Constraint_Error =>
               Result := An_Unknown_Pragma;
         end;

      end if;

      if Result = An_Unknown_Pragma then
         --  We can have a GNAT-specific pragma here!
         if Get_GNAT_Pragma_Id (S) /= Snames.Unknown_Pragma then
            Result := An_Implementation_Defined_Pragma;
         end if;

      end if;

      return Result;
   end Get_Pragma_Kind;

   -----------------------------------
   -- Init_Rule (Forbidden_Pragmas) --
   -----------------------------------

   procedure Init_Rule (Rule : in out Forbidden_Pragmas_Rule_Type) is
   begin
      Rule.Name       := new String'("Forbidden_Pragmas");
      Rule.Synonym    := new String'("Pragma_Usage");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("usage of specified pragmas");
      Rule.Diagnosis  := new String'("use of pragma %1%");
   end Init_Rule;

   ------------------------------------------------
   -- Process_Rule_Parameter (Forbidden_Pragmas) --
   ------------------------------------------------

   procedure Process_Rule_Parameter
     (Rule    : in out Forbidden_Pragmas_Rule_Type;
      Param   :        String;
      Enable  :        Boolean)
   is
      Arg_Kind    : Pragma_Kinds;
      GNAT_Pragma : Snames.Pragma_Id;
   begin

      if To_Lower (Param) = "gnat" then

         if Enable then
            Pragma_Check_Switch (An_Implementation_Defined_Pragma) := On;
            Rule.Rule_State := Enabled;
         else
            Pragma_Check_Switch (An_Implementation_Defined_Pragma) := Off;
         end if;

         return;
      end if;

      if To_Lower (Param) = "all" then

         if Enable then
            Pragma_Check_Switch := (others => On);
            Rule.Rule_State := Enabled;
         else
            Pragma_Check_Switch      := (others => Off);
            GNAT_Pragma_Check_Switch := (others => False);
            Rule.Rule_State          := Disabled;
         end if;

         return;
      end if;

      Arg_Kind := Get_Pragma_Kind (Param);

      case Arg_Kind is

         when Not_A_Pragma =>
            Error ("(" & Rule.Name.all & ") wrong pragma name : " & Param);

         when An_Implementation_Defined_Pragma =>

            GNAT_Pragma := Get_GNAT_Pragma_Id (Param);

            if Enable then

               if Pragma_Check_Switch (Arg_Kind) = Off then
                  Pragma_Check_Switch (Arg_Kind) := Selective;
               end if;

               GNAT_Pragma_Check_Switch (GNAT_Pragma) := True;
               Rule.Rule_State                        := Enabled;

            else
               GNAT_Pragma_Check_Switch (GNAT_Pragma) := False;
            end if;

         when others =>

            --  Only specific pragma kinds and An_Unknown_Pragma are possible
            if Enable then
               Pragma_Check_Switch (Arg_Kind) := On;
               Rule.Rule_State := Enabled;
            else
               Pragma_Check_Switch (Arg_Kind) := Off;
            end if;

      end case;

   end Process_Rule_Parameter;

   -------------------------------------------
   -- Rule_Check_Pre_Op (Forbidden_Pragmas) --
   -------------------------------------------

   procedure Rule_Check_Pre_Op
     (Rule    : in out Forbidden_Pragmas_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      El_Kind : constant Pragma_Kinds := Pragma_Kind (Element);
      pragma Unreferenced (Control);
      pragma Unreferenced (Rule);
   begin

      if Element_Kind (Element) = A_Pragma then

         if Pragma_Check_Switch (El_Kind) = On then
            State.Detected := True;
         elsif Pragma_Check_Switch (El_Kind) = Selective then
            State.Detected :=
              GNAT_Pragma_Check_Switch (Get_GNAT_Pragma_Id
                (To_String (Pragma_Name_Image (Element))));
         end if;

         if State.Detected then
            State.Diag_Params :=
              Enter_String ("%1%" & To_String (Pragma_Name_Image (Element)));
         end if;

      end if;

   end Rule_Check_Pre_Op;

   -----------------------------
   -- Function_Style_Procedures --
   -----------------------------

   -------------------------------------------
   -- Init_Rule (Function_Style_Procedures) --
   -------------------------------------------

   procedure Init_Rule (Rule : in out Function_Style_Procedures_Rule_Type) is
   begin
      Rule.Name       := new String'("Function_Style_Procedures");
      Rule.Synonym    := new String'("Functionlike_Procedures");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("procedures looking like functions");
      Rule.Diagnosis  := new String'("procedure can be rewritten as function");
   end Init_Rule;

   ---------------------------------------------------
   -- Rule_Check_Pre_Op (Function_Style_Procedures) --
   ---------------------------------------------------

   procedure Rule_Check_Pre_Op
     (Rule    : in out Function_Style_Procedures_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule, Control);
      Consider_Replacement_With_Function : Boolean := False;
   begin

      case Declaration_Kind (Element) is

         when A_Procedure_Declaration =>
            Consider_Replacement_With_Function :=
              Definition_Kind (Get_Enclosing_Element) /=
                A_Protected_Definition;

         when A_Generic_Procedure_Declaration |
              A_Formal_Procedure_Declaration  =>
            Consider_Replacement_With_Function := True;

         when A_Procedure_Body_Declaration |
              A_Procedure_Body_Stub        =>
            Consider_Replacement_With_Function := Acts_As_Spec (Element);

         when others =>
            null;
      end case;

      if Consider_Replacement_With_Function then
         State.Detected := Can_Be_Replaced_With_Function (Element);
      end if;

   end Rule_Check_Pre_Op;

   -----------------------------
   -- Generics_In_Subprograms --
   -----------------------------

   -----------------------------------------
   -- Init_Rule (Generics_In_Subprograms) --
   -----------------------------------------

   procedure Init_Rule (Rule : in out Generics_In_Subprograms_Rule_Type) is
   begin
      Rule.Name       := new String'("Generics_In_Subprograms");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("definitions of generic units in " &
                                     " subprogram bodies");
      Rule.Diagnosis  := new String'("generic definition in subprogram body " &
                                     "starting at line %1%");
   end Init_Rule;

   -----------------------------------------
   -- Init_Rule (Generics_In_Subprograms) --
   -----------------------------------------

   procedure Rule_Check_Pre_Op
     (Rule    : in out Generics_In_Subprograms_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule, Control);
      Encl_Body : Asis.Element;
      Step_Up   : Elmt_Idx := 0;
   begin

      if Declaration_Kind (Element) in A_Generic_Declaration then
         Encl_Body := Get_Enclosing_Element;

         while not Is_Nil (Encl_Body) loop

            case Declaration_Kind (Encl_Body) is
               when A_Procedure_Body_Declaration |
                    A_Function_Body_Declaration  =>
                  State.Detected := True;
                  exit;
               when A_Generic_Package_Declaration =>
                  exit;
               when others =>
                  Step_Up   := Step_Up + 1;
                  Encl_Body := Get_Enclosing_Element (Step_Up);
            end case;
         end loop;

         if State.Detected then
            State.Diag_Params := Enter_String ("%1%" &
                                 Element_Span (Encl_Body).First_Line'Img);
         end if;

      end if;

   end Rule_Check_Pre_Op;

   ---------------------------------
   -- Implicit_IN_Mode_Parameters --
   ---------------------------------

   ---------------------------------------------
   -- Init_Rule (Implicit_IN_Mode_Parameters) --
   ---------------------------------------------

   procedure Init_Rule (Rule : in out Implicit_IN_Mode_Parameters_Rule_Type) is
   begin
      Rule.Name       := new String'("Implicit_IN_Mode_Parameters");
      Rule.Synonym    := new String'("Implicit_IN_Parameter_Mode");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("implicit IN mode in parameter " &
                                     "specifications");
      Rule.Diagnosis  := new String'("implicit IN mode in parameter " &
                                     "specification");
   end Init_Rule;

   -----------------------------------------------------
   -- Rule_Check_Pre_Op (Implicit_IN_Mode_Parameters) --
   -----------------------------------------------------

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

      if Declaration_Kind (Element) = A_Parameter_Specification
       and then
         Mode_Kind (Element) = A_Default_In_Mode
       and then
         Definition_Kind (Object_Declaration_View (Element)) /=
           An_Access_Definition
      then
         State.Detected := True;
      end if;

   end Rule_Check_Pre_Op;

   ------------------------------------------
   -- Implicit_SMALL_For_Fixed_Point_Types --
   ------------------------------------------

   ------------------------------------------------------
   -- Init_Rule (Implicit_SMALL_For_Fixed_Point_Types) --
   ------------------------------------------------------

   procedure Init_Rule
     (Rule : in out Implicit_SMALL_For_Fixed_Point_Types_Rule_Type)
   is
   begin
      Rule.Name       := new String'("Implicit_SMALL_For_Fixed_Point_Types");
      Rule.Synonym    := new String'("Missing_Small_For_Fixed_Point_Type");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("fixed point type declarations with no "
                                   & "'Small clause");
      Rule.Diagnosis  := new String'("fixed point type declaration with no "
                                   & "'Small clause");
   end Init_Rule;

   --------------------------------------------------------------
   -- Rule_Check_Pre_Op (Implicit_SMALL_For_Fixed_Point_Types) --
   --------------------------------------------------------------

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

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

         declare
            Rep_Clauses : constant Asis.Element_List :=
              Corresponding_Representation_Clauses (Get_Enclosing_Element);
         begin

            for J in Rep_Clauses'Range loop

               if Representation_Clause_Kind (Rep_Clauses (J)) =
                    An_Attribute_Definition_Clause
                 and then
                  Attribute_Kind
                    (Representation_Clause_Name (Rep_Clauses (J))) =
                      A_Small_Attribute
               then
                  State.Detected := False;
                  exit;
               end if;

            end loop;

         end;

      end if;

   end Rule_Check_Pre_Op;

   ---------------------------------------
   -- Improperly_Located_Instantiations --
   ---------------------------------------

   ---------------------------------------------------
   -- Init_Rule (Improperly_Located_Instantiations) --
   ---------------------------------------------------

   procedure Init_Rule
     (Rule : in out Improperly_Located_Instantiations_Rule_Type)
   is
   begin
      Rule.Name       := new String'("Improperly_Located_Instantiations");
      Rule.Synonym    := new String'("Unreasonable_Places_For_Instantiations");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("instantiations that can cause problems");
      Rule.Diagnosis  :=
        new String'("#1#instantiation in a subprogram body" &
                    "#2#instantiation in a library package spec" &
                    "#3#instantiation in a generic library package spec");
   end Init_Rule;

   -----------------------------------------------------------
   -- Rule_Check_Pre_Op (Improperly_Located_Instantiations) --
   -----------------------------------------------------------

   procedure Rule_Check_Pre_Op
     (Rule    : in out Improperly_Located_Instantiations_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule, Control);
      Encl_CU   : Asis.Compilation_Unit;
      Encl_Body : Asis.Element;
      Step_Up   : Elmt_Idx := 0;

   begin

      if Declaration_Kind (Element) in A_Generic_Instantiation then
         Encl_CU := Enclosing_Compilation_Unit (Element);

         case Unit_Kind (Encl_CU) is
            when A_Package =>
               State.Detected := True;
               State.Diagnosis := 2;

            when A_Generic_Package =>
               State.Detected := True;
               State.Diagnosis := 3;

            when A_Subprogram_Body        |
                 A_Procedure_Body_Subunit |
                 A_Function_Body_Subunit  =>
               State.Detected := True;
               State.Diagnosis := 1;

            when A_Package_Body           |
                 A_Protected_Body_Subunit =>
               Encl_Body := Get_Enclosing_Element;

               while not Is_Nil (Encl_Body) loop

                  if Declaration_Kind (Encl_Body) in
                    A_Procedure_Body_Declaration ..
                    A_Function_Body_Declaration
                  then
                     State.Detected := True;
                     State.Diagnosis := 1;
                     exit;

                  elsif Declaration_Kind (Encl_Body) = A_Task_Body_Declaration
                    or else
                        Declaration_Kind (Encl_Body) =
                          An_Entry_Body_Declaration
                  then
                     exit;
                  else
                     Step_Up := Step_Up + 1;
                     Encl_Body := Get_Enclosing_Element (Step_Up);
                  end if;

               end loop;

            when A_Subprogram_Declaration    |
                 A_Generic_Procedure         |
                 A_Generic_Function          |
                 A_Renaming                  |
                 A_Generic_Unit_Instance     |
                 A_Package_Body_Subunit      |
                 A_Task_Body_Subunit         |
                 A_Nonexistent_Declaration   |
                 A_Nonexistent_Body          |
                 A_Configuration_Compilation |
                 An_Unknown_Unit             |
                 Not_A_Unit                  =>

               null;
         end case;
      end if;

   end Rule_Check_Pre_Op;

   --------------------------
   -- Misnamed_Identifiers --
   --------------------------

   --------------------------------------------------------
   -- Data structures and local subprograms for the rule --
   --------------------------------------------------------

   procedure Free_All (Rule : in out Misnamed_Identifiers_Rule_Type);
   --  Cleans all the name suffixes to check

   function Has_Suffix
     (El     : Asis.Element;
      Suffix : Wide_String)
      return   Boolean;
   --  Checks if the string image of El ends with Suffix.

   -------------------------------------
   -- Free_All (Misnamed_Identifiers) --
   -------------------------------------

   procedure Free_All (Rule : in out Misnamed_Identifiers_Rule_Type) is
   begin
      Free (Rule.Type_Suffix);
      Free (Rule.Access_Suffix);
      Free (Rule.Constant_Suffix);
      Free (Rule.Renaming_Suffix);
   end Free_All;

   ---------------------------------------
   -- Has_Suffix (Misnamed_Identifiers) --
   ---------------------------------------

   function Has_Suffix
     (El     : Asis.Element;
      Suffix : Wide_String)
      return   Boolean
   is
      Result : Boolean := False;
   begin
      --  At the moment this function works with A_Defining_Identifier Elements
      --  only

      Result :=
        Suffix =
        Tail (Source => Defining_Name_Image (El), Count  => Suffix'Length);

      return Result;
   end Has_Suffix;

   --------------------------------------
   -- Init_Rule (Misnamed_Identifiers) --
   --------------------------------------

   procedure Init_Rule (Rule : in out Misnamed_Identifiers_Rule_Type) is
   begin
      Rule.Name       := new String'("Misnamed_Identifiers");
      Rule.Synonym    := new String'("Def_Name_Suffix");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("suffixes in defining names");
      Rule.Diagnosis  :=
        new String'("#1#wrong suffix in type name"        &
                    "#2#wrong suffix in access type name" &
                    "#3#wrong suffix in constant name"    &
                    "#4#wrong suffix in package renaming");

      Set_Rule_Defaults (Rule);
   end Init_Rule;

   ---------------------------------------------------
   -- Process_Rule_Parameter (Misnamed_Identifiers) --
   ---------------------------------------------------

   procedure Process_Rule_Parameter
     (Rule    : in out Misnamed_Identifiers_Rule_Type;
      Param   :        String;
      Enable  :        Boolean)
   is

      First_Str_Idx, Last_Str_Idx : Natural;
      --  Beginning and end of the 'string' part of the parameter, see the
      --  rule parameter description in the spec. First_Str_Idx is set to 0 if
      --  the parameter does not contain a '=' character.

      First_Par_Idx, Last_Par_Idx : Natural;
      --  If the parameter contains a '=' character, set to point to the
      --  beginning and the end of the part of the parameter that precedes '='.
      --  Otherwise First_Par_Idx points to the first, and Last_Par_Idx - to
      --  the last non-blank character in Param (First_Idx .. Last_Idx)

      Is_Legal_Suffix : Boolean := True;

   begin

      Parse_Par
        (First_Par_Idx, Last_Par_Idx, First_Str_Idx, Last_Str_Idx, Param);

      if First_Str_Idx = 0 then

         if Enable then
            if To_Lower (Param (First_Par_Idx .. Last_Par_Idx)) =
               "default"
            then
               Set_Rule_Defaults (Rule);
               Rule.Rule_State := Enabled;
            else
               Error
                ("(" & Rule.Name.all & ") wrong parameter : " &
                 Param & ", ignored");
            end if;
         else

            if To_Lower (Param (First_Par_Idx .. Last_Par_Idx)) =
               "all_suffixes"
            then
               Free_All (Rule);
               Rule.Rule_State := Disabled;

            elsif To_Lower (Param (First_Par_Idx .. Last_Par_Idx)) =
               "type_suffix"
            then
               Free (Rule.Type_Suffix);

            elsif To_Lower (Param (First_Par_Idx .. Last_Par_Idx)) =
               "access_suffix"
            then
               Free (Rule.Access_Suffix);
            elsif To_Lower (Param (First_Par_Idx .. Last_Par_Idx)) =
               "constant_suffix"
            then
               Free (Rule.Constant_Suffix);

            elsif To_Lower (Param (First_Par_Idx .. Last_Par_Idx)) =
               "renaming_suffix"
            then
               Free (Rule.Renaming_Suffix);
            else
               Error
                ("(" & Rule.Name.all & ") wrong parameter : " &
                 Param & ", ignored");
            end if;

         end if;

      else
         if Enable then

            Is_Legal_Suffix :=
              Is_Identifier_Suffix (Param (First_Str_Idx .. Last_Str_Idx));

            if Is_Legal_Suffix then

               if To_Lower (Param (First_Par_Idx .. Last_Par_Idx)) =
                  "type_suffix"
               then

                  Rule.Type_Suffix :=
                    new String'(Param (First_Str_Idx .. Last_Str_Idx));
                  Rule.Rule_State := Enabled;

               elsif To_Lower (Param (First_Par_Idx .. Last_Par_Idx)) =
                  "access_suffix"
               then

                  Rule.Access_Suffix :=
                    new String'(Param (First_Str_Idx .. Last_Str_Idx));
                  Rule.Rule_State := Enabled;

               elsif To_Lower (Param (First_Par_Idx .. Last_Par_Idx)) =
                  "constant_suffix"
               then

                  Rule.Constant_Suffix :=
                    new String'(Param (First_Str_Idx .. Last_Str_Idx));
                  Rule.Rule_State := Enabled;

               elsif To_Lower (Param (First_Par_Idx .. Last_Par_Idx)) =
                  "renaming_suffix"
               then

                  Rule.Renaming_Suffix :=
                    new String'(Param (First_Str_Idx .. Last_Str_Idx));
                  Rule.Rule_State := Enabled;

               else
                  Error
                   ("(" & Rule.Name.all & ") wrong parameter name : " &
                    Param & ", ignored");
               end if;

            else
               Error
                ("(" & Rule.Name.all & ") " &
                 Param (First_Str_Idx .. Last_Str_Idx) &
                 " is not a legal name suffix, ignored");
            end if;

         else
            Error
             ("(" & Rule.Name.all & ") wrong parameter : " &
              Param & ", ignored");
         end if;
      end if;

   end Process_Rule_Parameter;

   ----------------------------------------------
   -- Rule_Check_Pre_Op (Misnamed_Identifiers) --
   ----------------------------------------------

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

      if Defining_Name_Kind (Element) = A_Defining_Identifier then
         Tmp := Get_Enclosing_Element;

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

         case Declaration_Kind (Tmp) is
            when An_Ordinary_Type_Declaration ..
                 A_Protected_Type_Declaration =>

               case Declaration_Kind (Corresponding_Type_Declaration (Tmp)) is

                  when Not_A_Declaration                    |
                       An_Incomplete_Type_Declaration       |
                       A_Tagged_Incomplete_Type_Declaration =>

                     if Rule.Type_Suffix /= null
                       or else
                        Rule.Access_Suffix /= null
                     then
                        --  Here we have to make the difference between access
                        --  and non-access types
                        Tmp := Type_Declaration_View (Tmp);

                        if Type_Kind (Tmp) = An_Access_Type_Definition then

                           if Rule.Access_Suffix /= null
                             and then
                               not Has_Suffix
                                     (Element,
                                      To_Wide_String (Rule.Access_Suffix.all))
                           then
                              State.Detected  := True;
                              State.Diagnosis := 2;
                           elsif Rule.Access_Suffix = null
                             and then
                                 Rule.Type_Suffix /= null
                             and then
                                 not Has_Suffix
                                       (Element,
                                       To_Wide_String (Rule.Type_Suffix.all))
                           then
                              --  If the suffix for access types is not set,
                              --  but the suffix for type defining name is set,
                              --  treat the name as an ordinary type name.
                              State.Detected  := True;
                              State.Diagnosis := 1;

                           end if;

                        else

                           if Rule.Type_Suffix /= null
                             and then
                              not Has_Suffix
                                    (Element,
                                     To_Wide_String (Rule.Type_Suffix.all))
                           then
                              State.Detected  := True;
                              State.Diagnosis := 1;
                           end if;

                        end if;

                     end if;

                  when others =>
                     --  The only real possibility is
                     --  A_Private_Type_Declaration or
                     --  A_Private_Extension_Declaration. In both cases we
                     --  do not check the defining identifier of the
                     --  corresponding type declaration
                     null;

               end case;

            when A_Private_Type_Declaration ..
                 A_Private_Extension_Declaration =>

               if Rule.Type_Suffix /= null
                 and then
                  not Has_Suffix
                       (Element, To_Wide_String (Rule.Type_Suffix.all))
               then
                  State.Detected  := True;
                  State.Diagnosis := 1;
               end if;

            when An_Incomplete_Type_Declaration ..
                 A_Tagged_Incomplete_Type_Declaration =>

               if Is_Nil (Corresponding_Type_Declaration (Tmp))
                 and then
                  Rule.Type_Suffix /= null
                 and then
                  not Has_Suffix
                       (Element, To_Wide_String (Rule.Type_Suffix.all))
               then
                  State.Detected  := True;
                  State.Diagnosis := 1;
               end if;

            when A_Constant_Declaration =>

               if Rule.Constant_Suffix /= null
                 and then
                  Is_Nil (Corresponding_Constant_Declaration (Element))
                 and then
                  not Has_Suffix
                       (Element, To_Wide_String (Rule.Constant_Suffix.all))
               then
                  State.Detected  := True;
                  State.Diagnosis := 3;
               end if;

            when A_Deferred_Constant_Declaration =>

               if Rule.Constant_Suffix /= null
                 and then
                  not Has_Suffix
                       (Element, To_Wide_String (Rule.Constant_Suffix.all))
               then
                  State.Detected  := True;
                  State.Diagnosis := 3;
               end if;

            when A_Package_Renaming_Declaration =>

               if Rule.Renaming_Suffix /= null
                 and then
                  not Has_Suffix
                       (Element, To_Wide_String (Rule.Renaming_Suffix.all))
               then
                  State.Detected  := True;
                  State.Diagnosis := 4;
               end if;

            when others =>
               null;
         end case;

      end if;

   end Rule_Check_Pre_Op;

   ----------------------------------------------
   -- Set_Rule_Defaults (Misnamed_Identifiers) --
   ----------------------------------------------

   procedure Set_Rule_Defaults
     (Rule : in out Misnamed_Identifiers_Rule_Type)
   is
   begin
      Free_All (Rule);

      Rule.Type_Suffix     := new String'("_T");
      Rule.Access_Suffix   := new String'("_A");
      Rule.Constant_Suffix := new String'("_C");
      Rule.Renaming_Suffix := new String'("_R");
   end Set_Rule_Defaults;

   ---------------------------------
   -- Non_Short_Circuit_Operators --
   ---------------------------------

   ---------------------------------------------
   -- Init_Rule (Non_Short_Circuit_Operators) --
   ---------------------------------------------

   procedure Init_Rule (Rule : in out Non_Short_Circuit_Operators_Rule_Type) is
   begin
      Rule.Name       := new String'("Non_Short_Circuit_Operators");
      Rule.Synonym    := new String'("Use_Of_Non_Short_Circuit");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("use of predefined AND and OR for " &
                                     "boolean types");
      Rule.Diagnosis  :=
        new String'("#1#use of predefined AND for boolean type" &
                    "#2#use of predefined OR for boolean type");
   end Init_Rule;

   -----------------------------------------------------
   -- Rule_Check_Pre_Op (Non_Short_Circuit_Operators) --
   -----------------------------------------------------

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

      if Operator_Kind (Element) in An_And_Operator .. An_Or_Operator then

         Call := Get_Enclosing_Element;

         if Expression_Kind (Call) = A_Selected_Component then
            Call := Get_Enclosing_Element (Steps_Up => 1);
         end if;

         if Expression_Kind (Call) = A_Function_Call
           and then
            Is_Predefined_Operator (Element)
           and then
            Is_Boolean_Logical_Op (Element)
         then
            State.Detected := True;

            if Operator_Kind (Element) = An_And_Operator then
               State.Diagnosis := 1;
            else
               State.Diagnosis := 2;
            end if;

         end if;

      end if;

   end Rule_Check_Pre_Op;

   ----------------------------
   -- Non_Visible_Exceptions --
   ----------------------------

   ----------------------------------------
   -- Init_Rule (Non_Visible_Exceptions) --
   ----------------------------------------

   procedure Init_Rule (Rule : in out Non_Visible_Exceptions_Rule_Type) is
   begin
      Rule.Name       := new String'("Non_Visible_Exceptions");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("potential propogations of " &
                                     "non-visible exceptions");
      Rule.Diagnosis  :=
        new String'("#1#no handler for this exception in enclosing body" &
                    "#2#no handler for this exception in enclosing block" &
                    "#3#propagates the local exception " &
                    "declared at line %1% outside its visibility");
   end Init_Rule;

   ------------------------------------------------
   -- Rule_Check_Pre_Op (Non_Visible_Exceptions) --
   ------------------------------------------------

   procedure Rule_Check_Pre_Op
     (Rule    : in out Non_Visible_Exceptions_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule, Control);
      Handler     : Asis.Element;
      Handled_Exc : Asis.Element;
      Raised_Exc  : Asis.Element;
      Frame       : Asis.Element;
      Step_Up     : Elmt_Idx := 0;
   begin
      --  First part of the rule - declarations of local non-handled
      --  exceptions:

      if Defining_Name_Kind (Element) = A_Defining_Identifier
        and then
         Declaration_Kind (Get_Enclosing_Element) = An_Exception_Declaration
        and then
         (Declaration_Kind (Get_Enclosing_Element (Steps_Up => 1)) in
            A_Procedure_Body_Declaration .. A_Function_Body_Declaration
         or else
          Declaration_Kind (Get_Enclosing_Element (Steps_Up => 1)) =
             A_Task_Body_Declaration
         or else
          Statement_Kind (Get_Enclosing_Element (Steps_Up => 1)) =
             A_Block_Statement)
      then
         State.Detected := not
           Is_Handled
             (Exc => Element,
              By  => Get_Handlers (Get_Enclosing_Element (Steps_Up => 1)));

         if Statement_Kind (Get_Enclosing_Element (Steps_Up => 1)) =
              A_Block_Statement
         then
            State.Diagnosis := 2;
         else
            State.Diagnosis := 1;
         end if;

      end if;

      --  Second part of the rule - potential propagation of a local exception
      --  outside its visibility

      if Statement_Kind (Element) = A_Raise_Statement then

         Handler := Get_Enclosing_Element (Step_Up);

         while Element_Kind (Handler) in A_Statement .. A_Path loop
            Step_Up := Step_Up + 1;
            Handler := Get_Enclosing_Element (Step_Up);
         end loop;

         Frame := Get_Enclosing_Element (Steps_Up => Step_Up + 1);

         if Element_Kind (Handler) = An_Exception_Handler
           and then
            (Declaration_Kind (Frame) in
             A_Procedure_Body_Declaration .. A_Function_Body_Declaration
            or else
             Declaration_Kind (Frame) = A_Task_Body_Declaration
            or else
             Statement_Kind (Frame) = A_Block_Statement)
         then

            --  Two different cases, depending if the raise statement contains
            --  an exception name

            Raised_Exc := Raised_Exception (Element);

            if Is_Nil (Raised_Exc) then

               declare
                  Handled_Excs : constant Asis.Element_List :=
                    Exception_Choices (Handler);
               begin
                  for J in Handled_Excs'Range loop

                     if Definition_Kind (Handled_Excs (J)) =
                        An_Others_Choice
                     then
                        exit;
                     end if;

                     Handled_Exc :=
                       Enclosing_Element
                         (Get_Name_Definition (Handled_Excs (J)));

                     if Is_Equal
                          (Enclosing_Element (Handled_Exc), Frame)
                     then
                        State.Detected  := True;
                        State.Diagnosis := 3;
                        State.Diag_Params := Enter_String
                          ("%1%" & Element_Span (Handled_Exc).First_Line'Img);
                        exit;
                     end if;

                  end loop;

               end;

            else
               Raised_Exc :=
                 Enclosing_Element (Get_Name_Definition (Raised_Exc));

               if Is_Equal
                    (Enclosing_Element (Raised_Exc), Frame)
               then
                  State.Detected  := True;
                  State.Diagnosis := 3;
                  State.Diag_Params := Enter_String
                    ("%1%" & Element_Span (Raised_Exc).First_Line'Img);
               end if;
            end if;

         end if;

      end if;

   end Rule_Check_Pre_Op;

   ----------------------
   -- Numeric_Literals --
   ----------------------

   ----------------------------------
   -- Init_Rule (Numeric_Literals) --
   ----------------------------------

   procedure Init_Rule (Rule : in out Numeric_Literals_Rule_Type) is
   begin
      Rule.Name       := new String'("Numeric_Literals");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("numeric literals");
      Rule.Diagnosis  := new String'("numeric literal outside a "
                                   & "constant declaration");
   end Init_Rule;

   -----------------------------------------------
   -- Process_Rule_Parameter (Numeric_Literals) --
   -----------------------------------------------

   procedure Process_Rule_Parameter
     (Rule    : in out Numeric_Literals_Rule_Type;
      Param   :        String;
      Enable  :        Boolean)
   is
   begin

      if Enable then
         Rule.Rule_State := Enabled;

         if To_Lower (Param) = "all" then
            Rule.Up_To := -1;
         else

            begin
               Rule.Up_To := Natural'Value (Param);
            exception
               when Constraint_Error =>
                  Error ("(" & Rule.Name.all & ") wrong parameter: " & Param);
            end;

         end if;

      else
         Error ("(" & Rule.Name.all & ") no parameter alloved for -R");
      end if;

   end Process_Rule_Parameter;

   ------------------------------------------
   -- Rule_Check_Pre_Op (Numeric_Literals) --
   ------------------------------------------

   procedure Rule_Check_Pre_Op
     (Rule    : in out Numeric_Literals_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Control);
      Arg_Kind : constant Expression_Kinds := Expression_Kind (Element);
      Integer_Literal_Value : Natural;
   begin

      if Arg_Kind in An_Integer_Literal .. A_Real_Literal then

         if Arg_Kind = An_Integer_Literal then
            Integer_Literal_Value :=
              Natural'Value (To_String (Value_Image (Element)));
         end if;

         declare
            Encl_El : Asis.Element := Get_Enclosing_Element;
            Step_Up : Elmt_Idx     := 0;
         begin
            if Arg_Kind = An_Integer_Literal
              and then
               Integer_Literal_Value <= Rule.Up_To
            then

               if Expression_Kind (Encl_El) = An_Indexed_Component then
                  State.Detected := True;
               end if;

            else
               while Element_Kind (Encl_El) = An_Expression
                   or else
                     Element_Kind (Encl_El) = An_Association
               loop
                  Step_Up := Step_Up + 1;
                  Encl_El := Get_Enclosing_Element (Step_Up);
               end loop;

               if not (Declaration_Kind (Encl_El) = A_Constant_Declaration
                     or else
                      Declaration_Kind (Encl_El) in
                        An_Integer_Number_Declaration ..
                        A_Real_Number_Declaration)
               then
                  State.Detected := True;
               end if;

            end if;
         end;

      end if;

   end Rule_Check_Pre_Op;

   --------------------------
   -- OTHERS_In_Aggregates --
   --------------------------

   --------------------------------------
   -- Init_Rule (OTHERS_In_Aggregates) --
   --------------------------------------

   procedure Init_Rule (Rule : in out OTHERS_In_Aggregates_Rule_Type) is
   begin
      Rule.Name       := new String'("OTHERS_In_Aggregates");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("OTHERS choices in aggregates");
      Rule.Diagnosis  := new String'("OTHERS choice in aggregate");
   end Init_Rule;

   ----------------------------------------------
   -- Rule_Check_Pre_Op (OTHERS_In_Aggregates) --
   ----------------------------------------------

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

      if Definition_Kind (Element) = An_Others_Choice then

         Aggregate := Get_Enclosing_Element (Steps_Up => 1);

         case Expression_Kind (Aggregate) is

            when An_Extension_Aggregate =>
               State.Detected := True;
            when A_Record_Aggregate           |
                 A_Positional_Array_Aggregate |
                 A_Named_Array_Aggregate      =>

               declare
                  Associations : constant Asis.Element_List :=
                    Get_Associations (Aggregate);
               begin

                  if Associations'Length >= 3 then
                     State.Detected := True;
                  elsif Associations'Length = 2 then

                     declare
                        Choices : constant Asis.Element_List :=
                          Get_Choices (Associations (Associations'First));
                     begin

                        if Choices'Length >= 2 then
                           State.Detected := True;
                        elsif Choices'Length = 1 then

                           if Definition_Kind (Choices (Choices'First)) =
                             A_Discrete_Range
                           then
                              State.Detected := True;
                           end if;

                        end if;

                     end;

                  end if;

               end;

            when others =>
               null;
         end case;

      end if;

   end Rule_Check_Pre_Op;

   -------------------------------
   -- OTHERS_In_CASE_Statements --
   -------------------------------

   -------------------------------------------
   -- Init_Rule (OTHERS_In_CASE_Statements) --
   -------------------------------------------

   procedure Init_Rule (Rule : in out OTHERS_In_CASE_Statements_Rule_Type) is
   begin
      Rule.Name       := new String'("OTHERS_In_CASE_Statements");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("OTHERS choices in case statements");
      Rule.Diagnosis  := new String'("OTHERS choice in case statement");
   end Init_Rule;

   ---------------------------------------------------
   -- Rule_Check_Pre_Op (OTHERS_In_CASE_Statements) --
   ---------------------------------------------------

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

      if Definition_Kind (Element) = An_Others_Choice
       and then
         Path_Kind (Get_Enclosing_Element) = A_Case_Path
      then
         State.Detected := True;
      end if;

   end Rule_Check_Pre_Op;

   ----------------------------------
   -- OTHERS_In_Exception_Handlers --
   ----------------------------------

   ----------------------------------------------
   -- Init_Rule (OTHERS_In_Exception_Handlers) --
   ----------------------------------------------

   procedure Init_Rule
     (Rule : in out OTHERS_In_Exception_Handlers_Rule_Type)
   is
   begin
      Rule.Name       := new String'("OTHERS_In_Exception_Handlers");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("OTHERS choices in exception handlers");
      Rule.Diagnosis  := new String'("OTHERS choice in exception handler");
   end Init_Rule;

   ------------------------------------------------------
   -- Rule_Check_Pre_Op (OTHERS_In_Exception_Handlers) --
   ------------------------------------------------------

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

      if Definition_Kind (Element) = An_Others_Choice
       and then
         Element_Kind (Get_Enclosing_Element) = An_Exception_Handler
      then
         State.Detected := True;
      end if;

   end Rule_Check_Pre_Op;

   --------------------------------------
   -- Overly_Nested_Control_Structures --
   --------------------------------------

   --------------------------------------------------
   -- Init_Rule (Overly_Nested_Control_Structures) --
   --------------------------------------------------

   procedure Init_Rule
     (Rule : in out Overly_Nested_Control_Structures_Rule_Type)
   is
   begin
      Rule.Name       := new String'("Overly_Nested_Control_Structures");
      Rule.Synonym   := new String'("Control_Structure_Nesting");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("deep nesting level of " &
                                     "control structures");
      Rule.Diagnosis  := new String'("nesting level of control structures " &
                                     "too deep");

      Rule.Max_Nesting_Level := 4;
   end Init_Rule;

   ---------------------------------------------------------------
   -- Process_Rule_Parameter (Overly_Nested_Control_Structures) --
   ---------------------------------------------------------------

   procedure Process_Rule_Parameter
     (Rule    : in out Overly_Nested_Control_Structures_Rule_Type;
      Param   :        String;
      Enable  :        Boolean)
   is
   begin

      if Enable then
         Rule.Rule_State := Enabled;

         begin
            Rule.Max_Nesting_Level := Positive'Value (Param);
         exception
            when Constraint_Error =>
               Error ("(" & Rule.Name.all & ") wrong parameter: " & Param);
         end;

      else
         Error ("(" & Rule.Name.all & ") no parameter alloved for -R");
      end if;

   end Process_Rule_Parameter;

   ----------------------------------------------------------
   -- Rule_Check_Pre_Op (Overly_Nested_Control_Structures) --
   ----------------------------------------------------------

   procedure Rule_Check_Pre_Op
     (Rule    : in out Overly_Nested_Control_Structures_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Control);
      Nesting_Level : Natural  := 0;
      Step_Up       : Elmt_Idx := 0;
      Encl_El       : Asis.Element;
   begin

      if Is_Control_Structure (Element) then
         Encl_El := Get_Enclosing_Element (Step_Up);

         while Element_Kind (Encl_El) in A_Statement .. A_Path loop

            if Is_Control_Structure (Encl_El) then
               Nesting_Level := Nesting_Level + 1;

               if Nesting_Level > Rule.Max_Nesting_Level then
                  State.Detected := True;
                  exit;
               end if;

            end if;

            Step_Up := Step_Up + 1;
            Encl_El := Get_Enclosing_Element (Step_Up);

         end loop;

      end if;

   end Rule_Check_Pre_Op;

   -----------------------------
   -- Parameters_Out_Of_Order --
   -----------------------------

   -----------------------------------------
   -- Init_Rule (Parameters_Out_Of_Order) --
   -----------------------------------------

   procedure Init_Rule (Rule : in out Parameters_Out_Of_Order_Rule_Type) is
   begin
      Rule.Name       := new String'("Parameters_Out_Of_Order");
      Rule.Synonym    := new String'("Parameter_Mode_Ordering");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("formal parameters ordering");
      Rule.Diagnosis  := new String'(
        "#1#parameter %1% of mode %2% precedes parameter %3% of mode %4%"  &
        "#2#parameter %1% with default initialization precedes "&
        "parameter %2% without it");
   end Init_Rule;

   -------------------------------------------------
   -- Rule_Check_Pre_Op (Parameters_Out_Of_Order) --
   -------------------------------------------------

   procedure Rule_Check_Pre_Op
     (Rule    : in out Parameters_Out_Of_Order_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule, Control);
      Arg_Kind      : constant Declaration_Kinds := Declaration_Kind (Element);
      Check_Profile : Boolean := False;
   begin

      case Arg_Kind is

         when A_Procedure_Declaration         |
              A_Function_Declaration          |
              A_Null_Procedure_Declaration    |
              An_Entry_Declaration            |
              A_Generic_Procedure_Declaration |
              A_Generic_Function_Declaration  |
              A_Formal_Procedure_Declaration  |
              A_Formal_Function_Declaration   =>

            Check_Profile := True;

         when A_Procedure_Body_Declaration |
              A_Function_Body_Declaration  |
              A_Procedure_Body_Stub        |
              A_Function_Body_Stub         =>

            Check_Profile := Acts_As_Spec (Element);

         when others =>
            null;
      end case;

      if Check_Profile then

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

            Prev_Mode : Mode_Kinds;
            Succ_Mode : Mode_Kinds;
            Prev_Name : Asis.Element;
            Succ_Name : Asis.Element;

            Prev_Par_Has_Default_Expr : Boolean;
         begin

            if Params'Length > 1 then
               Prev_Mode := Mode_Kind (Params (Params'First));
               Prev_Par_Has_Default_Expr :=
                 not Is_Nil
                   (Initialization_Expression (Params (Params'First)));

               for J in Params'First + 1 .. Params'Last loop

                  --  First, check if the mode ordering is right, that is
                  --  IN -> IN OUT -> OUT
                  --  This check does not make sense for functions:

                  if not (Arg_Kind = A_Function_Declaration
                       or else
                          Arg_Kind = A_Generic_Function_Declaration
                       or else
                          Arg_Kind = A_Formal_Function_Declaration
                       or else
                          Arg_Kind = A_Function_Body_Stub)
                  then

                     Succ_Mode := Mode_Kind (Params (J));

                     case Prev_Mode is
                        when An_In_Out_Mode =>
                           --  IN OUT -> IN is a violation:

                           if Succ_Mode in A_Default_In_Mode .. An_In_Mode then
                              Prev_Name := First_Name (Params (J - 1));
                              Succ_Name := First_Name (Params (J));

                              State.Detected    := True;
                              State.Diagnosis   := 1;
                              State.Diag_Params := Enter_String (
                                "%1%"                                       &
                                To_String (Defining_Name_Image (Prev_Name)) &
                                "%2%" & "IN OUT"                            &
                                "%3%"                                       &
                                To_String (Defining_Name_Image (Succ_Name)) &
                                "%4%" & "IN");

                              exit;
                           end if;

                        when An_Out_Mode =>

                           if Succ_Mode in A_Default_In_Mode .. An_In_Mode then
                              --  OUT -> IN is a violation:

                              Prev_Name := First_Name (Params (J - 1));
                              Succ_Name := First_Name (Params (J));

                              State.Detected    := True;
                              State.Diagnosis   := 1;
                              State.Diag_Params := Enter_String (
                                "%1%"                                       &
                                To_String (Defining_Name_Image (Prev_Name)) &
                                "%2%" & "OUT"                               &
                                "%3%"                                       &
                                To_String (Defining_Name_Image (Succ_Name)) &
                                "%4%" & "IN");

                              exit;
                           elsif Succ_Mode = An_In_Out_Mode then
                              --  OUT -> IN OUT is a violation:

                              Prev_Name := First_Name (Params (J - 1));
                              Succ_Name := First_Name (Params (J));

                              State.Detected    := True;
                              State.Diagnosis   := 1;
                              State.Diag_Params := Enter_String (
                                "%1%"                                       &
                                To_String (Defining_Name_Image (Prev_Name)) &
                                "%2%" & "OUT"                               &
                                "%3%"                                       &
                                To_String (Defining_Name_Image (Succ_Name)) &
                                "%4%" & "IN OUT");

                              exit;
                           end if;

                        when A_Default_In_Mode .. An_In_Mode =>
                           --  Any mode can follow IN mode
                           null;
                        when others =>
                           pragma Assert (False);
                           null;
                     end case;

                  end if;

                  --  Now check that IN paramters with default initialization
                  --  go last in the group of IN parameters:

                  if Succ_Mode in A_Default_In_Mode .. An_In_Mode
                    and then
                     Prev_Mode in A_Default_In_Mode .. An_In_Mode
                  then

                     if Prev_Par_Has_Default_Expr then
                        if Is_Nil (Initialization_Expression (Params (J))) then
                           Prev_Name := First_Name (Params (J - 1));
                           Succ_Name := First_Name (Params (J));

                           State.Detected    := True;
                           State.Diagnosis   := 2;
                           State.Diag_Params := Enter_String (
                             "%1%"                                       &
                             To_String (Defining_Name_Image (Prev_Name)) &
                             "%2%"                                       &
                             To_String (Defining_Name_Image (Succ_Name)));

                           exit;
                        end if;
                     else
                        Prev_Par_Has_Default_Expr :=
                          not Is_Nil (Initialization_Expression (Params (J)));

                     end if;

                  end if;

                  Prev_Mode := Succ_Mode;

               end loop;

            end if;

         end;

      end if;

   end Rule_Check_Pre_Op;

   ---------------------------------------------------------
   -- Positional_Actuals_For_Defaulted_Generic_Parameters --
   ---------------------------------------------------------

   ---------------------------------------------------------------------
   -- Init_Rule (Positional_Actuals_For_Defaulted_Generic_Parameters) --
   ---------------------------------------------------------------------

   procedure Init_Rule (Rule : in out
     Positional_Actuals_For_Defaulted_Generic_Parameters_Rule_Type)
   is
   begin
      Rule.Name       :=
        new String'("Positional_Actuals_For_Defaulted_Generic_Parameters");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("positional generic actuals for " &
                                     "defaulted generic parameters");
      Rule.Diagnosis  := new String'("use named notation when passing " &
        "actual to defaulted generic parameter");
   end Init_Rule;

   ----------------------------------------------------------------------------
   -- Rule_Check_Pre_Op(Positional_Actuals_For_Defaulted_Generic_Parameters) --
   ----------------------------------------------------------------------------

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

      if Association_Kind (Element) = A_Generic_Association
        and then
         Is_Nil (Formal_Parameter (Element))
      then

         --  Compute the corresponding generic declaration.
         Gen_Decl := Generic_Unit_Name (Get_Enclosing_Element);
         Gen_Decl := Normalize_Reference (Gen_Decl);
         Gen_Decl := Corresponding_Name_Declaration (Gen_Decl);

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

         declare
            Formal_Params : constant Asis.Element_List :=
              Generic_Formal_Part (Gen_Decl);
            Actuals : constant Asis.Element_List :=
              Generic_Actual_Part (Get_Enclosing_Element);

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

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

               Move_Act := Move_Act + 1;
            end loop;

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

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

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

            end loop;

            case Declaration_Kind (Formal_Params (Form_Idx)) is
               when A_Formal_Object_Declaration =>
                  State.Detected :=
                    not Is_Nil (Initialization_Expression
                      (Formal_Params (Form_Idx)));

               when A_Formal_Procedure_Declaration |
                    A_Formal_Function_Declaration =>
                  State.Detected :=
                    Default_Kind (Formal_Params (Form_Idx)) /= A_Nil_Default;

               when others =>
                  null;
            end case;

         end;

      end if;

   end Rule_Check_Pre_Op;

   -------------------------------------------------
   -- Positional_Actuals_For_Defaulted_Parameters --
   -------------------------------------------------

   -------------------------------------------------------------
   -- Init_Rule (Positional_Actuals_For_Defaulted_Parameters) --
   -------------------------------------------------------------

   procedure Init_Rule
     (Rule : in out Positional_Actuals_For_Defaulted_Parameters_Rule_Type)
   is
   begin
      Rule.Name       :=
        new String'("Positional_Actuals_For_Defaulted_Parameters");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("positional actuals for " &
                                     "defaulted parameters");
      Rule.Diagnosis  := new String'("use named notation when passing " &
        "actual to defaulted parameter");
   end Init_Rule;

   ---------------------------------------------------------------------
   -- Rule_Check_Pre_Op (Positional_Actuals_For_Defaulted_Parameters) --
   ---------------------------------------------------------------------

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

      if Association_Kind (Element) = A_Parameter_Association
        and then
         Is_Nil (Formal_Parameter (Element))
        and then
         not Is_Call_To_Operator_Function (Get_Enclosing_Element)
        and then
         not Is_Call_To_Attribute_Subprogram (Get_Enclosing_Element)
      then

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

      end if;

   end Rule_Check_Pre_Op;

   ---------------------------
   -- Positional_Components --
   ---------------------------

   ---------------------------------------
   -- Init_Rule (Positional_Components) --
   ---------------------------------------

   procedure Init_Rule
     (Rule : in out Positional_Components_Rule_Type)
   is
   begin
      Rule.Name       := new String'("Positional_Components");
      Rule.Synonym    := new String'("Positional_Component_Associations");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("positional components associations " &
                                     "in aggregates");
      Rule.Diagnosis  := new String'("aggregate with a positional component " &
                                     "association");
   end Init_Rule;

   -----------------------------------------------
   -- Rule_Check_Pre_Op (Positional_Components) --
   -----------------------------------------------

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

      case Expression_Kind (Element) is
         when A_Record_Aggregate      |
              An_Extension_Aggregate  =>
            State.Detected := Has_Positional_Association (Element);
         when  A_Positional_Array_Aggregate =>
            State.Detected := True;
         when others =>
            null;
      end case;

   end Rule_Check_Pre_Op;

   -----------------------------------
   -- Positional_Generic_Parameters --
   -----------------------------------

   -----------------------------------------------
   -- Init_Rule (Positional_Generic_Parameters) --
   -----------------------------------------------

   procedure Init_Rule
     (Rule : in out Positional_Generic_Parameters_Rule_Type)
   is
   begin
      Rule.Name       := new String'("Positional_Generic_Parameters");
      Rule.Synonym    := new String'("Positional_Generic_Associations");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("positional generic associations");
      Rule.Diagnosis  := new String'("positional generic association");
   end Init_Rule;

   -------------------------------------------------------
   -- Rule_Check_Pre_Op (Positional_Generic_Parameters) --
   -------------------------------------------------------

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

      if Association_Kind (Element) = A_Generic_Association
        and then
         Is_Nil (Formal_Parameter (Element))
      then
         State.Detected := True;
      end if;

   end Rule_Check_Pre_Op;

   ---------------------------
   -- Positional_Parameters --
   ---------------------------

   ---------------------------------------
   -- Init_Rule (Positional_Parameters) --
   ---------------------------------------

   procedure Init_Rule
     (Rule : in out Positional_Parameters_Rule_Type)
   is
   begin
      Rule.Name       := new String'("Positional_Parameters");
      Rule.Synonym    := new String'("Positional_Parameter_Associations");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("positional associations in " &
                                     "subprogram and entry calls");
      Rule.Diagnosis  := new String'("positional parameter association");
   end Init_Rule;

   -----------------------------------------------
   -- Rule_Check_Pre_Op (Positional_Parameters) --
   -----------------------------------------------

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

      if Association_Kind (Element) = A_Parameter_Association
        and then
         Is_Nil (Formal_Parameter (Element))
      then
         --  Now - check for exceptions:

         if not
           (Is_Call_To_Operator_Function (Get_Enclosing_Element)
           or else
            Has_One_Parameter (Get_Enclosing_Element)
           or else
            (Is_Prefix_Notation (Get_Enclosing_Element)
            and then
             Is_Prefix_Notation_Exception (Element)))
         then
            State.Detected := True;
         end if;

      end if;

   end Rule_Check_Pre_Op;

   -----------------------------------
   -- Predefined_Numeric_Types_Rule --
   -----------------------------------

   -----------------------------------------------
   -- Init_Rule (Predefined_Numeric_Types_Rule) --
   -----------------------------------------------

   procedure Init_Rule (Rule : in out Predefined_Numeric_Types_Rule_Type) is
   begin
      Rule.Name       := new String'("Predefined_Numeric_Types");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("explicit references to predefined " &
                                     "numeric subtypes");
      Rule.Diagnosis  := new String'("explicit reference to predefined "&
                                     "numeric subtype");
   end Init_Rule;

   -------------------------------------------------------
   -- Rule_Check_Pre_Op (Predefined_Numeric_Types_Rule) --
   -------------------------------------------------------

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

      if Expression_Kind (Element) = An_Identifier
        and then
         Is_Ref_To_Standard_Num_Subtype (Element)
      then
         State.Detected := True;
      end if;

   end Rule_Check_Pre_Op;

   ---------------------------------
   -- Raising_External_Exceptions --
   ---------------------------------

   ---------------------------------------------
   -- Init_Rule (Raising_External_Exceptions) --
   ---------------------------------------------

   procedure Init_Rule (Rule : in out Raising_External_Exceptions_Rule_Type) is
   begin
      Rule.Name       := new String'("Raising_External_Exceptions");
      Rule.Synonym    := new String'("Visible_Exceptions");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("visibility of exceptions raised by " &
                                     "routines declared in library package");
      Rule.Diagnosis  := new String'("raised exception is not declared in " &
                                     "visible part of enclosing library " &
                                     "package");
   end Init_Rule;

   -----------------------------------------------------
   -- Rule_Check_Pre_Op (Raising_External_Exceptions) --
   -----------------------------------------------------

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

      Raised_Exc : Asis.Element;
      Encl_CU    : Asis.Compilation_Unit :=
        Enclosing_Compilation_Unit (Element);
   begin

      if Statement_Kind (Element) = A_Raise_Statement
        and then
         (Unit_Kind (Encl_CU) = A_Package
         or else
          Unit_Kind (Encl_CU) = A_Generic_Package
         or else
          Unit_Kind (Encl_CU) = A_Package_Body)
      then
         Raised_Exc := Raised_Exception (Element);

         if not Is_Nil (Raised_Exc) then
            Raised_Exc := Normalize_Reference (Raised_Exc);
            Raised_Exc := Corresponding_Name_Definition (Raised_Exc);

            --  Note, that we do not unwind renamings, that is, if Raised_Exc
            --  is a renaming of a Standard exception that takes place in
            --  another package, we consider this as a rule violation.

            if not Is_From_Standard (Raised_Exc) then

               if Unit_Kind (Encl_CU) = A_Package_Body then
                  Encl_CU := Corresponding_Declaration (Encl_CU);

                  if not Is_Equal (Enclosing_Compilation_Unit (Raised_Exc),
                                   Encl_CU)
                  then
                     State.Detected := True;
                  else
                     State.Detected := not Is_Public (Raised_Exc);
                  end if;

               end if;

            end if;

         end if;

      end if;

   end Rule_Check_Pre_Op;

   -----------------------------------
   -- Raising_Predefined_Exceptions --
   -----------------------------------

   ---------------------------------------
   -- Init_Rule (Raising_Predefined_Exceptions) --
   ---------------------------------------

   procedure Init_Rule (Rule : in out Raising_Predefined_Exceptions_Rule_Type)
   is
   begin
      Rule.Name       := new String'("Raising_Predefined_Exceptions");
      Rule.Synonym    := new String'("Predefined_Exceptions");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("explicit raise of predefined " &
                                     "exceptions");
      Rule.Diagnosis  := new String'("explicit raise of a predefined "&
                                     "exception");
   end Init_Rule;

   -------------------------------------------------------
   -- Rule_Check_Pre_Op (Raising_Predefined_Exceptions) --
   -------------------------------------------------------

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

      if Statement_Kind (Element) = A_Raise_Statement then
         Raised_Exc := Raised_Exception (Element);

         if not Is_Nil (Raised_Exc) then

            Raised_Exc := Normalize_Reference (Raised_Exc);
            Raised_Exc := Corresponding_Name_Declaration (Raised_Exc);

            if Declaration_Kind (Raised_Exc) =
               An_Exception_Renaming_Declaration
            then
               Raised_Exc := Corresponding_Base_Entity (Raised_Exc);
               Raised_Exc := Normalize_Reference (Raised_Exc);
               Raised_Exc := Corresponding_Name_Declaration (Raised_Exc);
            end if;

            State.Detected := Is_From_Standard (Raised_Exc);

         end if;

      end if;

   end Rule_Check_Pre_Op;

   -------------------------------
   -- Unassigned_OUT_Parameters --
   -------------------------------

   --------------------------------------------------------
   -- Data structures and local subprograms for the rule --
   --------------------------------------------------------

   type Formal_Parameter_Record is record
      Par_Def_Name : Asis.Element;
      --  Defining name of the parameter
      Assigned : Boolean := False;
      --  Flag indicating if this parameter has got a value.
   end record;

   package OUT_Parameters_Table is new Table.Table
     (Table_Component_Type => Formal_Parameter_Record,
      Table_Index_Type     => Natural,
      Table_Low_Bound      =>  1,
      Table_Initial        => 20,
      Table_Increment      => 50,
      Table_Name           => "OUT parameters");

   procedure Set_OUT_Parameters (El : Asis.Element);
   --  Supposing that El is a procedure body declaration, sets in
   --  OUT_Parameters_Table the list of OUT parameters of this procedure

   function Get_Bad_Parameter_List return String_Loc;
   --  Forms from the content of OUT_Parameters_Table the list of the bad
   --  parameter names to be placed in the diagnosis and returns the
   --  corresponding pointer in the string table.

   Check_Handler : Boolean;
   --  We need this global flag to decide if we have to traverse exceptions
   --  handlers.

   First_Body : Boolean;
   --  We need this flag to make the difference between the procedure body
   --  declaration from which the traversal starts (we have to analyse it), and
   --  all the other declarations, that should be skipped during the traversal

   procedure Check_Reference
     (Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Natural);
   --  Checks if the argument is a reference to OUT parameter that sets its
   --  value. If such a reference is detected, updates parameter records in
   --  OUT_Parameters_Table. Decreses State each time when detects that one
   --  more OUT parameter gets a value. terminate the traversal when all the
   --  parameters have got values (State gets the value 0)

   procedure No_Opeation
     (Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Natural);
   --  Does nothing.

   procedure Check_References is new Asis.Iterator.Traverse_Element
     (Pre_Operation     => Check_Reference,
      Post_Operation    => No_Opeation,
      State_Information => Natural);

   -------------------------------------------------
   -- Check_Reference (Unassigned_OUT_Parameters) --
   -------------------------------------------------

   procedure Check_Reference
     (Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Natural)
   is
      Tmp_El        : Asis.Element;
      Old_Enclosing : Asis.Element;
      Par_Idx       : Natural;
   begin

      --  If we are here, State cannot be 0, so we have to do the job,,,

      case Flat_Element_Kind (Element) is

         when Flat_Declaration_Kinds =>

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

         when An_Exception_Handler =>

            if Declaration_Kind (Enclosing_Element (Element)) =
                 A_Procedure_Body_Declaration
              and then
                 Check_Handler
            then
               --  If we are here, the only possibility is that we are checking
               --  an exception handler from some procedure body.
               null;
            else
               --  If we are here, we are in some "inner" exception handler
               --  (note, that we skip all the declaration except the procedure
               --  body declaration for which the praversing os started). We
               --  just skip it^

               Control := Abandon_Children;
            end if;

         when An_Identifier =>
            Tmp_El := Get_Corresponding_Definition (Element);

            if not Is_Nil (Tmp_El) then
               Par_Idx := 0;

               for J in 1 .. OUT_Parameters_Table.Last loop

                  if Is_Equal
                       (Tmp_El, OUT_Parameters_Table.Table (J).Par_Def_Name)
                  then
                     Par_Idx := J;
                     exit;
                  end if;

               end loop;

               if Par_Idx > 0
                 and then
                  not OUT_Parameters_Table.Table (Par_Idx).Assigned
               then
                  --  And now we have to check if Element is in a position that
                  --  can result in assigning a value to the corresponding OUT
                  --  parameter

                  Old_Enclosing := Element;
                  Tmp_El        := Enclosing_Element (Old_Enclosing);

                  while Element_Kind (Tmp_El) = An_Expression loop

                     if (Expression_Kind (Tmp_El) = An_Indexed_Component
                       and then
                        not Is_Equal (Old_Enclosing, Prefix (Tmp_El)))

                      or else

                        (Expression_Kind (Tmp_El) = An_Explicit_Dereference
                       and then
                         Is_Equal (Old_Enclosing, Prefix (Tmp_El)))

                     then
                        --  Th efirst condition means that we have an index in
                        --  an indexed component. The second condition means
                        --  that we have a prefix of explicit dereference. In
                        --  both cases the object in question cannot get
                        --  a value
                        exit;
                     end if;

                     Old_Enclosing := Tmp_El;
                     Tmp_El        := Enclosing_Element (Old_Enclosing);
                  end loop;

                  if Statement_Kind (Tmp_El) = An_Assignment_Statement
                    and then
                      Is_Equal
                        (Old_Enclosing, Assignment_Variable_Name (Tmp_El))
                  then
                     OUT_Parameters_Table.Table (Par_Idx).Assigned := True;
                     State := State - 1;

                  elsif Association_Kind (Tmp_El) =
                        A_Parameter_Association
                  then
                     --  Here we have to check if it is an actual for OUT
                     --  or IN OUT parameter

                     --  ??? See pre-operation for
                     --  Positional_Actuals_For_Defaulted_Parameters rule -
                     --  there is definitely some duplication here!

                     Old_Enclosing := Enclosing_Element (Tmp_El);

                     if not (Expression_Kind (Old_Enclosing) =
                             A_Function_Call
                           or else
                             Is_Call_To_Attribute_Subprogram (Old_Enclosing))
                     then
                        Old_Enclosing := Get_Parameter_Declaration (Tmp_El);

                        if Mode_Kind (Old_Enclosing) in
                           An_Out_Mode .. An_In_Out_Mode
                        then
                           OUT_Parameters_Table.Table (Par_Idx).Assigned :=
                             True;
                           State := State - 1;
                        end if;

                     end if;

                  end if;

               end if;

            end if;

         when others =>
            null;
      end case;

      if State = 0 then
         Control := Terminate_Immediately;
      end if;

   end Check_Reference;

   --------------------------------------------------------
   -- Get_Bad_Parameter_List (Unassigned_OUT_Parameters) --
   --------------------------------------------------------

   function Get_Bad_Parameter_List return String_Loc is
      Str, Tmp_Str : String_Access;
      Result       : String_Loc;
   begin

      for J in 1 .. OUT_Parameters_Table.Last loop

         if not OUT_Parameters_Table.Table (J).Assigned then

            if Tmp_Str = null then
               --  first parameter to report
               Str :=
                 new String'("%1%" & To_String
                   (Defining_Name_Image
                      (OUT_Parameters_Table.Table (J).Par_Def_Name)));
            else
               Free (Str);

               Str :=
                 new String'(Tmp_Str.all & ", " & To_String
                   (Defining_Name_Image
                      (OUT_Parameters_Table.Table (J).Par_Def_Name)));
            end if;

            Free (Tmp_Str);
            Tmp_Str := new String'(Str.all);
         end if;

      end loop;

      Result := Enter_String (Str.all & "%1%");

      Free (Str);
      Free (Tmp_Str);

      return (Result);

   end Get_Bad_Parameter_List;

   -------------------------------------------
   -- Init_Rule (Unassigned_OUT_Parameters) --
   -------------------------------------------

   procedure Init_Rule (Rule : in out Unassigned_OUT_Parameters_Rule_Type) is
   begin
      Rule.Name       := new String'("Unassigned_OUT_Parameters");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("OUT parameters do not get values "     &
                                     "in procedure bodies");
      Rule.Diagnosis  := new String'("#1#procedure body does not define "    &
                                        "values for OUT parameters: %1%"     &
                                     "#2#exception handler does not define " &
                                        "values for OUT parameters: %1%");
   end Init_Rule;

   ---------------------------------------------
   -- No_Opeation (Unassigned_OUT_Parameters) --
   ---------------------------------------------

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

   ---------------------------------------------------
   -- Rule_Check_Pre_Op (Unassigned_OUT_Parameters) --
   ---------------------------------------------------

   procedure Rule_Check_Pre_Op
     (Rule    : in out Unassigned_OUT_Parameters_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule, Control);
      Get_Params_From   : Asis.Element;
      Unassigned_Params : Natural;
      --  Unassigned_Params indicates the number of OUT parameters for that we
      --  do not know that they have got values
      Check_Ref_Control : Traverse_Control := Continue;
   begin

      if Declaration_Kind (Element) = A_Procedure_Body_Declaration
        or else
         (Element_Kind (Element) = An_Exception_Handler
          and then
            Declaration_Kind (Get_Enclosing_Element) =
            A_Procedure_Body_Declaration)
      then

         if Element_Kind (Element) = An_Exception_Handler then
            Get_Params_From := Get_Enclosing_Element;
            First_Body      := False;
            Check_Handler   := True;
         else
            Get_Params_From := Element;
            First_Body      := True;
            Check_Handler   := False;
         end if;

         OUT_Parameters_Table.Init;
         Set_OUT_Parameters (Get_Params_From);
         Unassigned_Params := OUT_Parameters_Table.Last;

         Check_References (Element, Check_Ref_Control, Unassigned_Params);

         if Unassigned_Params > 0 then
            State.Detected := True;

            if Declaration_Kind (Element) = A_Procedure_Body_Declaration then
               State.Diagnosis := 1;
            else
               State.Diagnosis := 2;
            end if;

            State.Diag_Params := Get_Bad_Parameter_List;
         end if;

      end if;

   end Rule_Check_Pre_Op;

   ----------------------------------------------------
   -- Set_OUT_Parameters (Unassigned_OUT_Parameters) --
   ----------------------------------------------------

   procedure Set_OUT_Parameters (El : Asis.Element) is
      Par_Specs : constant Asis.Element_List := Parameter_Profile (El);
   begin

      for J in Par_Specs'Range loop

         if Mode_Kind (Par_Specs (J)) = An_Out_Mode then

            declare
               Nms : constant Asis.Element_List := Names (Par_Specs (J));
            begin

               for K in Nms'Range loop
                  OUT_Parameters_Table.Append
                    ((Par_Def_Name => Nms (K),
                      Assigned     => False));
               end loop;

            end;

         end if;

      end loop;

   end Set_OUT_Parameters;

   -----------------------------------------
   -- Uncommented_BEGIN_In_Package_Bodies --
   -----------------------------------------

   -----------------------------------------------------
   -- Init_Rule (Uncommented_BEGIN_In_Package_Bodies) --
   -----------------------------------------------------

   procedure Init_Rule
     (Rule : in out Uncommented_BEGIN_In_Package_Bodies_Rule_Type) is
   begin
      Rule.Name       := new String'("Uncommented_BEGIN_In_Package_Bodies");
      Rule.Synonym    := new String'("Non_Marked_BEGIN_In_Package_Body");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("BEGIN keywords in package bodies " &
                                    "non-marked with " &
                                     "comment with package name");
      Rule.Diagnosis  := new String'("#1#mark BEGIN with pakage name (%1%)" &
                                     "#2#place BEGIN in package body " &
                                      "on separate line");
   end Init_Rule;

   -------------------------------------------------------------
   -- Rule_Check_Pre_Op (Uncommented_BEGIN_In_Package_Bodies) --
   -------------------------------------------------------------

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

      if Declaration_Kind (Element) = A_Package_Body_Declaration
       and then
         Has_Statements_And_Decls (Element)
      then

         declare
            Dcls : constant Asis.Element_List :=
              Body_Declarative_Items (Element, Include_Pragmas => True);
            Last_Dcl : constant Positive := Dcls'Last;

            Stmts : constant Asis.Element_List :=
              Body_Statements (Element, Include_Pragmas => True);
            First_Stmt : constant Positive := Stmts'First;

            LList : constant Line_List := Lines
              (Element    => Element,
               First_Line => Element_Span (Dcls (Last_Dcl)).Last_Line,
               Last_Line  => Element_Span (Stmts (First_Stmt)).First_Line);

            Begin_Line  : Line_Number_Positive;
            Begin_Start : Character_Position;
            Begin_Found : Boolean := False;
         begin

            --  Firts, check a most reasonable case - if we have BEGIN on a
            --  separate line between the last declaration and the first
            --  statement

            for J in LList'First + 1 .. LList'Last - 1 loop
               --  In this range, the only word the non-comment image of a
               --  line can contain is 'BEGIN'

               if To_Lower
                    (Trim (To_String
                       (Non_Comment_Image (LList (J))), Both)) =
                  "begin"
               then
                  Begin_Found := True;

                  declare
                     Img : constant Program_Text :=
                       Non_Comment_Image (LList (J));
                  begin
                     Begin_Start := 1;

                     for J in Img'Range loop
                        exit when  Img (J) = 'b' or else Img (J) = 'B';

                        Begin_Start := Begin_Start + 1;
                     end loop;

                  end;

                  Begin_Line := J;

                  exit;

               end if;

            end loop;

            if Begin_Found then

               declare
                  Img : constant String :=
                    Trim
                      (To_String (Comment_Image (LList (Begin_Line))), Both);

                  Firts_Idx : Natural := Img'First;
                  Last_Idx  : Natural := Img'Last;
               begin

                  if Img'Length = 0 then
                     State.Detected := True;
                  else
                     Firts_Idx := Img'First + 2;

                     while Is_White_Space (Img (Firts_Idx))
                      and then
                           Firts_Idx <= Last_Idx
                     loop
                        Firts_Idx := Firts_Idx + 1;
                     end loop;

                     for J in Firts_Idx + 1 .. Last_Idx loop

                        if Is_White_Space (Img (J)) then
                           Last_Idx := J - 1;
                           exit;
                        end if;

                     end loop;

                     State.Detected :=
                       To_Lower (Img (Firts_Idx .. Last_Idx)) /=
                       To_Lower
                         (To_String
                           (Defining_Name_Image (First_Name (Element))));
                     State.Line   := Begin_Line;
                     State.Column := Begin_Start;
                  end if;

               end;

               if State.Detected then
                  State.Diagnosis := 1;
               end if;

            else
               --  Pathological case - BEGIN in the same line as either the
               --  last declaration  or the first statement
               State.Detected  := True;
               State.Diagnosis := 2;
               State.Line      := Element_Span (Stmts (First_Stmt)).First_Line;
               State.Column    := 1;

            end if;

            if State.Detected and then State.Diagnosis = 1 then
               State.Diag_Params :=
                 Enter_String
                   ("%1%" &
                    To_String (Defining_Name_Image (First_Name (Element))));
            end if;

         end;

      end if;

   end Rule_Check_Pre_Op;

   ------------------------------
   -- Unnamed_Blocks_And_Loops --
   ------------------------------

   ------------------------------------------
   -- Init_Rule (Unnamed_Blocks_And_Loops) --
   ------------------------------------------

   procedure Init_Rule (Rule : in out Unnamed_Blocks_And_Loops_Rule_Type) is
   begin
      Rule.Name       := new String'("Unnamed_Blocks_And_Loops");
      Rule.Synonym    := new String'("Non_Named_Blocks_And_Loops");
      Rule.Rule_State := Disabled;
      Rule.Help_Info  := new String'("compound statements naming");
      Rule.Diagnosis  :=
        new String'("#1#non-named block statement"      &
                    "#2#non-named nested loop satement" &
                    "#3#non-named nesting loop satement");
   end Init_Rule;

   --------------------------------------------------
   -- Rule_Check_Pre_Op (Unnamed_Blocks_And_Loops) --
   --------------------------------------------------

   procedure Rule_Check_Pre_Op
     (Rule    : in out Unnamed_Blocks_And_Loops_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Rule, Control);
      Enclosing_El : Asis.Element;
      Step_Up      : Elmt_Idx := 0;
   begin

      case Statement_Kind (Element) is
         when A_Block_Statement =>

            if Is_Nil (Statement_Identifier (Element)) then
               State.Detected  := True;
               State.Diagnosis := 1;
            end if;

         when A_Loop_Statement       |
              A_While_Loop_Statement |
              A_For_Loop_Statement   =>

            if Is_Nil (Statement_Identifier (Element)) then
               --  First, check if the loop is nested. In case if a loop
               --  statement is enclosed in another loop and itself contains a
               --  loop statement, we generate the second diagnostic variant

               Enclosing_El := Get_Enclosing_Element (Step_Up);

               while Element_Kind (Enclosing_El) in A_Statement .. A_Path loop

                  if Statement_Kind (Enclosing_El) in
                       A_Loop_Statement .. A_For_Loop_Statement
                  then
                     State.Detected  := True;
                     State.Diagnosis := 2;
                     exit;
                  end if;

                  Step_Up := Step_Up + 1;
                  Enclosing_El := Get_Enclosing_Element (Step_Up);

               end loop;

               if not State.Detected then
                  --  Non nested loop, but it may contain other loops
                  State.Detected := Contains_Loop (Element);

                  if State.Detected then
                     State.Diagnosis := 3;
                  end if;

               end if;

            end if;

         when others =>
            null;
      end case;

   end Rule_Check_Pre_Op;

end Gnatcheck.Rules.Custom_1;
