-----------------------------------------------------------------------------
--                                                                          --
--                          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-2011, 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).             --
--                                                                          --
------------------------------------------------------------------------------

pragma Ada_2005;

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

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 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 of 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 of Par_String that follows the (leftmost) '='
   --  character (cutting out the leading and trailing white spaces if any).
   --  If Par_String does not contain a '=' character, 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 of Par_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 '='.

   -------------------------------------
   -- Rule-specific local subprograms --
   -------------------------------------

   function Is_Access_Suffix (S : String) return Boolean;
   --  For Misnamed_Identifiers rule.
   --  S is supposed to be the 'string' part from the +R parameter option, and
   --  it is known that Is_Identifier_Suffix (S) = False. The function checks
   --  if S has the structure Suffix1 (Suffix2), where
   --  Is_Identifier_Suffix (Suffix1) AND Is_Identifier_Suffix (Suffix2) = True

   function Is_Access_To_Access (Def : Asis.Element) return Boolean;
   function Is_Access_To_Class (Def : Asis.Element) return Boolean;
   --  For Identifier_Prefixes and Misnamed_Identifiers rules.
   --  Def is supposed to be of An_Access_Type_Definition kind. Checks if it
   --  defines an access to access type/access to class-wide type.

   -----------------------------------------------
   -- 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    : Natural;
   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-specific local subprograms --
   -----------------------------------------------

   -------------------------
   -- Is_Access_To_Access --
   -------------------------

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

      if Access_Type_Kind (Def) in
        A_Pool_Specific_Access_To_Variable .. An_Access_To_Constant
      then
         Tmp := Asis.Definitions.Access_To_Object_Definition (Def);
         Tmp := Asis.Definitions.Subtype_Mark (Tmp);

         if Expression_Kind (Tmp) = An_Identifier
           or else
            Expression_Kind (Tmp) = A_Selected_Component
         then
            Result := Denotes_Access_Subtype (Tmp);
         end if;

      end if;

      return Result;
   end Is_Access_To_Access;

   ------------------------
   -- Is_Access_To_Class --
   ------------------------

   function Is_Access_To_Class (Def : Asis.Element) return Boolean is
      Tmp      :          Asis.Element;
      Arg_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (Def);
      Result   :          Boolean            := False;
   begin
      if Arg_Kind = A_Pool_Specific_Access_To_Variable        or else
         Arg_Kind = An_Access_To_Variable                     or else
         Arg_Kind = An_Access_To_Constant                     or else
         Arg_Kind = A_Formal_Pool_Specific_Access_To_Variable or else
         Arg_Kind = A_Formal_Access_To_Variable               or else
         Arg_Kind = A_Formal_Access_To_Constant
      then
         Tmp := Asis.Definitions.Access_To_Object_Definition (Def);
         Tmp := Asis.Definitions.Subtype_Mark (Tmp);

         if Attribute_Kind (Tmp) = A_Class_Attribute then
            Result := True;
         else

            if Expression_Kind (Tmp) = An_Identifier
              or else
               Expression_Kind (Tmp) = A_Selected_Component
            then
               Result := Denotes_Class_Wide_Subtype (Tmp);
            end if;

         end if;
      end if;

      return Result;
   end Is_Access_To_Class;

   ----------------------
   -- Is_Access_Suffix --
   ----------------------

   function Is_Access_Suffix (S : String) return Boolean is
      Parameter           : constant String  := Trim (S, Both);
      First_Idx           : constant Natural := Parameter'First;
      Last_Idx            : constant Natural := Parameter'Last - 1;
      Bracket_Idx         :          Natural;
      Result              :          Boolean := False;
   begin
      if Parameter (Last_Idx + 1) = ')' then

         Bracket_Idx := Index (Parameter, "(");

         if Bracket_Idx > 0 then

            if Is_Identifier_Suffix (To_Wide_String
                 (Trim (Parameter (First_Idx .. Bracket_Idx - 1), Right)))
            then
               Result :=
                 Is_Identifier_Suffix (To_Wide_String
                   (Trim (Parameter (Bracket_Idx + 1 .. Last_Idx), Left)));
            end if;

         end if;

      end if;

      return Result;
   end Is_Access_Suffix;

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

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

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

   procedure Init_Rule (Rule : in out Anonymous_Arrays_Rule_Type) is
   begin
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Anonymous_Arrays");
      Rule.Rule_Status := Fully_Implemented;
      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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Enumeration_Ranges_In_CASE_Statements");
      Rule.Rule_Status := Fully_Implemented;
      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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Exceptions_As_Control_Flow");
      Rule.Rule_Status := Fully_Implemented;
      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;
            Next_Frame := Get_Enclosing_Element (Step_Up);

            Check_Frames : loop
               --  Computing the next frame

               while not Is_Frame (Next_Frame) loop
                  Step_Up    := Step_Up + 1;
                  Next_Frame := Get_Enclosing_Element (Step_Up);
               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

               Step_Up    := Step_Up + 1;
               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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("EXIT_Statements_With_No_Loop_Name");
      Rule.Rule_Status := Fully_Implemented;
      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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Explicit_Full_Discrete_Ranges");
      Rule.Synonym     := new String'("Explicit_Discrete_Ranges");
      Rule.Rule_Status := Fully_Implemented;
      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_Attributes --
   --------------------------

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

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

   Attribute_Check_Switch :
     array (Asis.Attribute_Kinds'(An_Access_Attribute) ..
             Asis.Attribute_Kinds'(An_Unknown_Attribute)) of Check_Status :=
               (others => Off);
   --  Specifies which pagmas should be detected.

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

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

   procedure Get_GNAT_Attribute_Id
     (S       :     String;
      Id      : out Snames.Attribute_Id;
      Success : out Boolean);
   --  Supposing that S is a name of a GNAT attribute, computes its
   --  Attribute_Id. Sets Success OFF if the argument is not a name of a
   --  GNAT-specific attribute, otherwise Success is set ON.

   --------------------------------------------------
   -- Get_GNAT_Attribute_Id (Forbidden_Attributes) --
   --------------------------------------------------

   procedure Get_GNAT_Attribute_Id
     (S       :     String;
      Id      : out Snames.Attribute_Id;
      Success : out Boolean)
   is
      use Namet;
      Attribute_Name_Id : Namet.Name_Id;
   begin

      if Is_Identifier (To_Wide_String (S)) then
         Name_Len                    := S'Length;
         Name_Buffer (1 .. Name_Len) := To_Lower (S);
         Attribute_Name_Id           := Name_Find;

         if Attribute_Name_Id in
              Snames.First_Attribute_Name .. Snames.Last_Attribute_Name
         then
            Id      := Snames.Get_Attribute_Id (Attribute_Name_Id);
            Success := True;
         else
            Success := False;
         end if;

      end if;

   end Get_GNAT_Attribute_Id;

   -----------------------------------------------
   -- Get_Attribute_Kind (Forbidden_Attributes) --
   -----------------------------------------------

   function Get_Attribute_Kind (S : String) return Attribute_Kinds is
      use  type Snames.Attribute_Id;
      Result  : Attribute_Kinds := Not_An_Attribute;
      Attr_Id : Snames.Attribute_Id;
      pragma Warnings (Off, Attr_Id);
      --  We need Attr_Id only as a placeholder in the call to
      --  Get_GNAT_Attribute_Id
      Success : Boolean;
   begin

      if Is_Identifier (To_Wide_String (S)) then

         begin

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

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

      end if;

      if Result = An_Unknown_Attribute then
         --  We can have a GNAT-specific pragma here!
         Get_GNAT_Attribute_Id (S, Attr_Id, Success);

         if Success then
            Result := An_Implementation_Defined_Attribute;
         end if;

      end if;

      return Result;
   end Get_Attribute_Kind;

   --------------------------------------
   -- Init_Rule (Forbidden_Attributes) --
   --------------------------------------

   procedure Init_Rule (Rule : in out Forbidden_Attributes_Rule_Type) is
   begin
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Forbidden_Attributes");
      Rule.Rule_Status := Fully_Implemented;
      Rule.Help_Info   := new String'("usage of specified attributes");
      Rule.Diagnosis   := new String'("use of attribute %1%");
   end Init_Rule;

   ---------------------------------------
   -- Print_Rule (Forbidden_Attributes) --
   ---------------------------------------

   procedure Print_Rule
     (Rule         : Forbidden_Attributes_Rule_Type;
      Indent_Level : Natural := 0)
   is
      All_On        : Boolean := True;
      First_Param   : Boolean := True;
      Rule_Name_Pad : constant String (1 .. Rule_Name (Rule)'Length + 2) :=
        (others => ' ');
   begin
      Print_Rule (Rule_Template (Rule), Indent_Level);

      --  Special case: all attributes are ON
      for J in Asis.Attribute_Kinds'(An_Access_Attribute) ..
               Asis.Attribute_Kinds'(An_Implementation_Defined_Attribute)
      loop
         if Attribute_Check_Switch (J) /= On then
            All_On := False;
            exit;
         end if;
      end loop;

      if All_On then
         Report_No_EOL (": ALL");
         return;
      end if;

      --  Standard Ada attributes
      for J in Asis.Attribute_Kinds'(An_Access_Attribute) ..
               Asis.Attribute_Kinds'(A_Wide_Wide_Width_Attribute)
      loop

         if Attribute_Check_Switch (J) = On then

            if First_Param then
               Report_No_EOL (": " & Ada_Attribute_Designator (J));
               First_Param := False;
            else
               Report (",");
               Report_No_EOL
                 (Rule_Name_Pad &
                  Ada_Attribute_Designator (J),
                  Indent_Level);
            end if;

         end if;

      end loop;

      case Attribute_Check_Switch (An_Implementation_Defined_Attribute) is
         when Off =>
            null;
         when On =>
            if First_Param then
               Report_No_EOL (": GNAT");
            else
               Report (",");
               Report_No_EOL (Rule_Name_Pad & "GNAT", Indent_Level);
            end if;
         when Selective =>
            for J in GNAT_Attribute_Check_Switch'Range loop

               if GNAT_Attribute_Check_Switch (J) then
                  if First_Param then
                     Report_No_EOL (": " & GNAT_Attribute_Designator (J));
                     First_Param := False;
                  else
                     Report (",");
                     Report_No_EOL
                       (Rule_Name_Pad &
                        GNAT_Attribute_Designator (J),
                        Indent_Level);
                  end if;
               end if;

            end loop;

      end case;

   end Print_Rule;

   -----------------------------------------------
   -- Print_Rule_To_File (Forbidden_Attributes) --
   -----------------------------------------------

   overriding procedure Print_Rule_To_File
     (Rule         : Forbidden_Attributes_Rule_Type;
      Rule_File    : File_Type;
      Indent_Level : Natural := 0)
   is
      All_On        : Boolean := True;
      First_Param   : Boolean := True;
      Rule_Name_Pad : constant String (1 .. Rule_Name (Rule)'Length + 2) :=
        (others => ' ');
   begin
      Print_Rule_To_File (Rule_Template (Rule), Rule_File, Indent_Level);

      --  Special case: all attributes are ON
      for J in Asis.Attribute_Kinds'(An_Access_Attribute) ..
               Asis.Attribute_Kinds'(An_Implementation_Defined_Attribute)
      loop
         if Attribute_Check_Switch (J) /= On then
            All_On := False;
            exit;
         end if;
      end loop;

      if All_On then
         Report_No_EOL (": ALL");
         return;
      end if;

      --  Standard Ada attributes
      for J in Asis.Attribute_Kinds'(An_Access_Attribute) ..
               Asis.Attribute_Kinds'(A_Wide_Wide_Width_Attribute)
      loop

         if Attribute_Check_Switch (J) = On then

            if First_Param then
               Put (Rule_File, ": " & Ada_Attribute_Designator (J));
               First_Param := False;
            else
               Put_Line (Rule_File, ",");

               for J in 1 .. Indent_Level loop
                  Put (Rule_File, Get_Indent_String);
               end loop;

               Put (Rule_File, Rule_Name_Pad & Ada_Attribute_Designator (J));
            end if;

         end if;

      end loop;

      case Attribute_Check_Switch (An_Implementation_Defined_Attribute) is
         when Off =>
            null;
         when On =>
            if First_Param then
               Put (Rule_File, ": GNAT");
            else
               Put_Line (Rule_File, ",");

               for J in 1 .. Indent_Level loop
                  Put (Rule_File, Get_Indent_String);
               end loop;

               Put (Rule_File, Rule_Name_Pad & "GNAT");
            end if;
         when Selective =>
            for J in GNAT_Attribute_Check_Switch'Range loop

               if GNAT_Attribute_Check_Switch (J) then
                  if First_Param then
                     Put (Rule_File, ": " & GNAT_Attribute_Designator (J));
                     First_Param := False;
                  else
                     Put_Line (Rule_File, ",");

                     for J in 1 .. Indent_Level loop
                        Put (Rule_File, Get_Indent_String);
                     end loop;

                     Put (Rule_File,
                          Rule_Name_Pad & GNAT_Attribute_Designator (J));
                  end if;
               end if;

            end loop;

      end case;

   end Print_Rule_To_File;

   ---------------------------------------------------
   -- Process_Rule_Parameter (Forbidden_Attributes) --
   ---------------------------------------------------

   procedure Process_Rule_Parameter
     (Rule    : in out Forbidden_Attributes_Rule_Type;
      Param   :        String;
      Enable  :        Boolean)
   is
      Arg_Kind       : Attribute_Kinds;
      GNAT_Attribute : Snames.Attribute_Id;
      Success        : Boolean;
   begin

      if Param = "" then
         if Enable then
            Rule.Rule_State := Enabled;
         else
            Rule.Rule_State := Disabled;
         end if;

         return;
      end if;

      if To_Lower (Param) = "gnat" then

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

         return;
      end if;

      if To_Lower (Param) = "all" then

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

         return;
      end if;

      Arg_Kind := Get_Attribute_Kind (Param);

      case Arg_Kind is

         when Not_An_Attribute =>
            Error ("(" & Rule.Name.all & ") wrong attribute designator : " &
                   Param);

         when An_Implementation_Defined_Attribute =>

            Get_GNAT_Attribute_Id (Param, GNAT_Attribute, Success);

            if Enable then

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

               if Success then
                  GNAT_Attribute_Check_Switch (GNAT_Attribute) := True;
               end if;

               Rule.Rule_State := Enabled;

            else
               GNAT_Attribute_Check_Switch (GNAT_Attribute) := False;
            end if;

         when others =>

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

      end case;

   end Process_Rule_Parameter;

   ----------------------------------------------
   -- Rule_Check_Pre_Op (Forbidden_Attributes) --
   ----------------------------------------------

   procedure Rule_Check_Pre_Op
     (Rule    : in out Forbidden_Attributes_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      El_Kind : constant Attribute_Kinds := Attribute_Kind (Element);
      pragma Unreferenced (Control);
      pragma Unreferenced (Rule);
   begin

      if Expression_Kind (Element) = An_Attribute_Reference then

         if Attribute_Check_Switch (El_Kind) = On then
            State.Detected := True;

         elsif Attribute_Check_Switch (El_Kind) = Selective then

            declare
               Attr_Designator : constant String :=
                 To_String
                  (Name_Image (Attribute_Designator_Identifier (Element)));

               Attr_Id : Snames.Attribute_Id;
               Success : Boolean;
            begin
               Get_GNAT_Attribute_Id (Attr_Designator, Attr_Id, Success);

               State.Detected :=
                 GNAT_Attribute_Check_Switch (Attr_Id);
            end;

         end if;

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

      end if;

   end Rule_Check_Pre_Op;

   ------------------------------------------
   -- XML_Rule_Help (Forbidden_Attributes) --
   ------------------------------------------

   procedure XML_Rule_Help
     (Rule  : Forbidden_Attributes_Rule_Type;
      Level : Natural)
   is
   begin
      Info (Level * Ident_String                               &
            "<check  switch=""+R"                              &
            Rule.Name.all                                      &
            ":ALL"""                                           &
            " label="""                                        &
            "detect all attributes except explicitly disabled""/>");

      Info (Level * Ident_String                                &
            "<check  switch=""+R"                               &
            Rule.Name.all                                       &
            ":GNAT"""                                           &
            " label="""                                         &
            "detect all GNAT attributes except explicitly disabled""/>");

      Info (Level * Ident_String                                   &
            "<field switch=""+R"                                   &
            Rule.Name.all                                          &
            """ label="""                                          &
            "detect specified attributes (use ',' as separator)""" &
            " separator="":"""                                     &
            "/>");

      Info (Level * Ident_String                                          &
            "<field switch=""-R"                                          &
            Rule.Name.all                                                 &
            """ label="""                                                 &
            "do not detect specified attributes (use ',' as separator)""" &
            " separator="":"""                                            &
            "/>");
   end XML_Rule_Help;

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

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

   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 (Forbidden_Pragmas) --
   --------------------------------------------

   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 (To_Wide_String (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 (To_Wide_String (S)) then

         begin

            case To_Lower (S (S'First)) is
               when 'a' | 'e' | 'i' | '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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Forbidden_Pragmas");
      Rule.Synonym     := new String'("Pragma_Usage");
      Rule.Rule_Status := Fully_Implemented;
      Rule.Help_Info   := new String'("usage of specified pragmas");
      Rule.Diagnosis   := new String'("use of pragma %1%");
   end Init_Rule;

   ------------------------------------
   -- Print_Rule (Forbidden_Pragmas) --
   ------------------------------------

   procedure Print_Rule
     (Rule         : Forbidden_Pragmas_Rule_Type;
      Indent_Level : Natural := 0)
   is
      All_On        : Boolean := True;
      First_Param   : Boolean := True;
      Rule_Name_Pad : constant String (1 .. Rule_Name (Rule)'Length + 2) :=
        (others => ' ');
   begin
      Print_Rule (Rule_Template (Rule), Indent_Level);

      --  Special case: all pragmas are ON
      for J in Asis.Pragma_Kinds'(An_All_Calls_Remote_Pragma) ..
               Asis.Pragma_Kinds'(An_Implementation_Defined_Pragma)
      loop
         if Pragma_Check_Switch (J) /= On then
            All_On := False;
            exit;
         end if;
      end loop;

      if All_On then
         Report_No_EOL (": ALL");
         return;
      end if;

      --  Standard Ada pragmas
      for J in Asis.Pragma_Kinds'(An_All_Calls_Remote_Pragma) ..
               Asis.Pragma_Kinds'(An_Unsuppress_Pragma)
      loop

         if Pragma_Check_Switch (J) = On then

            if First_Param then
               Report_No_EOL (": " & Ada_Pragma_Identifier (J));
               First_Param := False;
            else
               Report (",");
               Report_No_EOL
                 (Rule_Name_Pad &
                  Ada_Pragma_Identifier (J),
                  Indent_Level);
            end if;

         end if;

      end loop;

      case Pragma_Check_Switch (An_Implementation_Defined_Pragma) is
         when Off =>
            null;
         when On =>
            if First_Param then
               Report_No_EOL (": GNAT");
            else
               Report (",");
               Report_No_EOL (Rule_Name_Pad & "GNAT", Indent_Level);
            end if;
         when Selective =>
            for J in GNAT_Pragma_Check_Switch'Range loop

               if GNAT_Pragma_Check_Switch (J) then
                  if First_Param then
                     Report_No_EOL (": " & GNAT_Pragma_Identifier (J));
                     First_Param := False;
                  else
                     Report (",");
                     Report_No_EOL
                       (Rule_Name_Pad &
                        GNAT_Pragma_Identifier (J),
                        Indent_Level);
                  end if;
               end if;

            end loop;

      end case;

   end Print_Rule;

   --------------------------------------------
   -- Print_Rule_To_File (Forbidden_Pragmas) --
   --------------------------------------------

   overriding procedure Print_Rule_To_File
     (Rule         : Forbidden_Pragmas_Rule_Type;
      Rule_File    : File_Type;
      Indent_Level : Natural := 0)
   is
      All_On        : Boolean := True;
      First_Param   : Boolean := True;
      Rule_Name_Pad : constant String (1 .. Rule_Name (Rule)'Length + 2) :=
        (others => ' ');
   begin
      Print_Rule_To_File (Rule_Template (Rule), Rule_File, Indent_Level);

      --  Special case: all pragmas are ON
      for J in Asis.Pragma_Kinds'(An_All_Calls_Remote_Pragma) ..
               Asis.Pragma_Kinds'(An_Implementation_Defined_Pragma)
      loop
         if Pragma_Check_Switch (J) /= On then
            All_On := False;
            exit;
         end if;
      end loop;

      if All_On then
         Put (Rule_File, ": ALL");
         return;
      end if;

      --  Standard Ada pragmas
      for J in Asis.Pragma_Kinds'(An_All_Calls_Remote_Pragma) ..
               Asis.Pragma_Kinds'(An_Unsuppress_Pragma)
      loop

         if Pragma_Check_Switch (J) = On then

            if First_Param then
               Put (Rule_File, ": " & Ada_Pragma_Identifier (J));
               First_Param := False;
            else
               Put_Line (Rule_File, ",");

               for J in 1 .. Indent_Level loop
                  Put (Rule_File, Get_Indent_String);
               end loop;

               Put (Rule_File, Rule_Name_Pad & Ada_Pragma_Identifier (J));
            end if;

         end if;

      end loop;

      case Pragma_Check_Switch (An_Implementation_Defined_Pragma) is
         when Off =>
            null;
         when On =>
            if First_Param then
               Put (Rule_File, ": GNAT");
            else
               Put (Rule_File, ",");

               for J in 1 .. Indent_Level loop
                  Put (Rule_File, Get_Indent_String);
               end loop;

               Put (Rule_File, Rule_Name_Pad & "GNAT");
            end if;
         when Selective =>
            for J in GNAT_Pragma_Check_Switch'Range loop

               if GNAT_Pragma_Check_Switch (J) then
                  if First_Param then
                     Put (Rule_File, ": " & GNAT_Pragma_Identifier (J));
                     First_Param := False;
                  else
                     Put_Line (Rule_File, ",");

                     for J in 1 .. Indent_Level loop
                        Put (Rule_File, Get_Indent_String);
                     end loop;

                     Put (Rule_File,
                          Rule_Name_Pad & GNAT_Pragma_Identifier (J));
                  end if;
               end if;

            end loop;

      end case;

   end Print_Rule_To_File;

   ------------------------------------------------
   -- 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 Param = "" then
         if Enable then
            Rule.Rule_State := Enabled;
         else
            Rule.Rule_State := Disabled;
         end if;

         return;
      end if;

      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;

   ---------------------------------------
   -- XML_Rule_Help (Forbidden_Pragmas) --
   ---------------------------------------

   procedure XML_Rule_Help
     (Rule  : Forbidden_Pragmas_Rule_Type;
      Level : Natural)
   is
   begin
      Info (Level * Ident_String                               &
            "<check  switch=""+R"                              &
            Rule.Name.all                                      &
            ":ALL"""                                           &
            " label="""                                        &
            "detect all pragmas except explicitly disabled""/>");

      Info (Level * Ident_String                                &
            "<check  switch=""+R"                               &
            Rule.Name.all                                       &
            ":GNAT"""                                           &
            " label="""                                         &
            "detect all GNAT pragmas except explicitly disabled""/>");

      Info (Level * Ident_String                                &
            "<field switch=""+R"                                &
            Rule.Name.all                                       &
            """ label="""                                       &
            "detect specified pragmas (use ',' as separator)""" &
            " separator="":"""                                  &
            "/>");

      Info (Level * Ident_String                                       &
            "<field switch=""-R"                                       &
            Rule.Name.all                                              &
            """ label="""                                              &
            "do not detect specified pragmas (use ',' as separator)""" &
            " separator="":"""                                         &
            "/>");
   end XML_Rule_Help;

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

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

   procedure Init_Rule (Rule : in out Function_Style_Procedures_Rule_Type) is
   begin
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Function_Style_Procedures");
      Rule.Synonym     := new String'("Functionlike_Procedures");
      Rule.Rule_Status := Fully_Implemented;
      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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Generics_In_Subprograms");
      Rule.Rule_Status := Fully_Implemented;
      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;

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

   -------------------------
   -- Identifier_Prefixes --
   -------------------------

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

   type Identifier_Prefixes_Parameter_Kinds is
     (Not_A_Parameter,
      All_Prefixes_Par,
      Type_Par,
      Concurrent_Par,
      Access_Par,
      Class_Access_Par,
      Subprogram_Access_Par,
      Derived_Par,
      Constant_Par,
      Enum_Par,
      Exclusive_Par);

   function Get_Identifier_Prefixes_Parameter_Kind
     (S    : String)
      return Identifier_Prefixes_Parameter_Kinds;
   --  If S denotes one of the rule parameters, returns the corresponding
   --  arameter kind, otherwise Not_A_Parameter is returned

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

   function At_Least_One_Prefix_Set
     (R    : Identifier_Prefixes_Rule_Type)
      return Boolean;
   --  Checks if at least one prefix is specified

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

   function Get_Full_Parent_Name (Def : Asis.Element) return Program_Text;
   --  Provided that Def is a derived type definition, private extension
   --  definition or the definition of a formal derived type, gives the full
   --  expanded Ada name of its ansector type (not including the very top
   --  Standard package). See ASIS_UL.Utilities.Full_Expanded_Name_Image
   --  query.

   function Is_Derived_Type_Par (S : String) return Boolean;
   --  Checks if S has the format 'full_expaned_type_name:prefix' where
   --  full_expaned_type_name has the syntax of full expanded type name, and
   --  prefix is a valid identifier prefix. It can be any number of spaces
   --  around ':'

   function Derived_Pref (C : Derived_Prefixes.Cursor) return String;
   --  Returns the parameter of "+RDerived=" option stored inder C in the
   --  format "full_expanded_name_of_parent_type:prefix"

   function Eq (Left, Right : String_Access) return Boolean;
   function "<" (Left, Right : String_Access) return Boolean;

   package All_Defined_Prefixes is new Ada.Containers.Ordered_Sets
     (Element_Type => String_Access,
      "="          => Eq);
   use All_Defined_Prefixes;

   All_Prefixes : All_Defined_Prefixes.Set;

   function Has_Specific_Prefix (E : Asis.Element) return Boolean;
   --  Checks if E has one of the prefixes specified for specific kinds of
   --  entities. (Assumes that E is either of A_Defining_Identifier or
   --  A_Defining_Enumeration_Literal kind). All the prefixes defined for the
   --  names of specific entities are supposed to be stored in the All_Prefixes
   --  set container. When this function is called for the first time, it fills
   --  in this container with the prefixes defined by rule parameters

   --------------------------------
   -- "="  (Identifier_Prefixes) --
   --------------------------------

   function "=" (Left, Right : Derived_Pref_Record) return Boolean is
   begin
      if Left.Parent_Name = null or else Right.Parent_Name = null then
         return True;
      else
         return Left.Parent_Name.all = Right.Parent_Name.all;
      end if;
   end "=";

   -------------------------------
   -- "<" (Identifier_Prefixes) --
   -------------------------------

   function "<" (Left, Right : Derived_Pref_Record) return Boolean is
   begin
      if Left.Parent_Name = null or else Right.Parent_Name = null then
         return True;
      else
         return Left.Parent_Name.all < Right.Parent_Name.all;
      end if;
   end "<";

   function "<" (Left, Right : String_Access) return Boolean is
   begin
      if Left = null or else Right = null then
         return True;
      else
         return Left.all < Right.all;
      end if;
   end "<";

   ---------------------------------------------------
   -- At_Least_One_Prefix_Set (Identifier_Prefixes) --
   ---------------------------------------------------

   function At_Least_One_Prefix_Set
     (R    : Identifier_Prefixes_Rule_Type)
      return Boolean
   is
   begin
      return
        R.Type_Prefix              /= null or else
        R.Concurrent_Prefix        /= null or else
        R.Access_Prefix            /= null or else
        R.Class_Access_Prefix      /= null or else
        R.Subprogram_Access_Prefix /= null or else
        R.Constant_Prefix          /= null or else
        R.Enum_Prefix              /= null or else
        not Is_Empty (R.Derived_Prefix);
   end At_Least_One_Prefix_Set;

   -------------------------------
   -- Eq  (Identifier_Prefixes) --
   -------------------------------

   function Eq (Left, Right : String_Access) return Boolean is
   begin
      if Left = null or else Right = null then
         return True;
      else
         return Left.all = Right.all;
      end if;
   end Eq;

   ----------------------------------------
   -- Derived_Pref (Identifier_Prefixes) --
   ----------------------------------------

   function Derived_Pref (C : Derived_Prefixes.Cursor) return String is
      Def_Pref_Rec : constant Derived_Pref_Record :=
        Derived_Prefixes.Element (C);
   begin
      return Def_Pref_Rec.Parent_Name.all & ':' & Def_Pref_Rec.Prefix.all;
   end Derived_Pref;

   ---------------------------------------------
   -- Free_All_Prefixes (Identifier_Prefixes) --
   ---------------------------------------------

   procedure Free_All_Prefixes (Rule : in out Identifier_Prefixes_Rule_Type) is
   begin
      Free (Rule.Type_Prefix);
      Free (Rule.Concurrent_Prefix);
      Free (Rule.Access_Prefix);
      Free (Rule.Class_Access_Prefix);
      Free (Rule.Subprogram_Access_Prefix);
      Free (Rule.Constant_Prefix);
      Free (Rule.Enum_Prefix);

      --  Some memory leak here - we do not free memory for strings.
      Derived_Prefixes.Clear (Rule.Derived_Prefix);
   end Free_All_Prefixes;

   --------------------------
   -- Get_Full_Parent_Name --
   --------------------------

   function Get_Full_Parent_Name (Def : Asis.Element) return Program_Text is
      Parent_Name : Asis.Element := Def;
   begin
      case Flat_Element_Kind (Def) is
         when A_Derived_Type_Definition |
              A_Derived_Record_Extension_Definition =>
            Parent_Name := Parent_Subtype_Indication (Parent_Name);
         when A_Private_Extension_Definition =>
            Parent_Name := Ancestor_Subtype_Indication (Parent_Name);
         when others => null;
      end case;

      Parent_Name := Asis.Definitions.Subtype_Mark (Parent_Name);
      Parent_Name := Normalize_Reference (Parent_Name);
      Parent_Name := Corresponding_Name_Declaration (Parent_Name);
      Parent_Name := Corresponding_First_Subtype (Parent_Name);
      Parent_Name := First_Name (Parent_Name);

      return Full_Expanded_Name_Image (Parent_Name);

   end Get_Full_Parent_Name;

   ------------------------------------------------------------------
   -- Get_Identifier_Prefixes_Parameter_Kind (Identifier_Prefixes) --
   ------------------------------------------------------------------

   function Get_Identifier_Prefixes_Parameter_Kind
     (S    : String)
      return Identifier_Prefixes_Parameter_Kinds
   is
   begin
      return Identifier_Prefixes_Parameter_Kinds'Value (S & "_Par");
   exception
      when Constraint_Error =>
         return Not_A_Parameter;
   end Get_Identifier_Prefixes_Parameter_Kind;

   --------------------------------------
   -- Has_Prefix (Identifier_Prefixes) --
   --------------------------------------

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

      Result :=
        Prefix =
        Head (Source => Defining_Name_Image (El), Count  => Prefix'Length);

      return Result;
   end Has_Prefix;

   -----------------------------------------------
   -- Has_Specific_Prefix (Identifier_Prefixes) --
   -----------------------------------------------

   function Has_Specific_Prefix (E : Asis.Element) return Boolean is
      Name_Img  : constant Program_Text := Defining_Name_Image (E);
      C_All     : All_Defined_Prefixes.Cursor;
      C_Derived : Derived_Prefixes.Cursor;
      Result    : Boolean;
   begin
      if All_Defined_Prefixes.Is_Empty (All_Prefixes) then

         if Identifier_Prefixes_Rule.Type_Prefix /= null then
            All_Defined_Prefixes.Insert
              (Container => All_Prefixes,
               New_Item  =>
                 new String'(Identifier_Prefixes_Rule.Type_Prefix.all),
               Position  => C_All,
               Inserted  => Result);
         end if;

         if Identifier_Prefixes_Rule.Concurrent_Prefix /= null then
            All_Defined_Prefixes.Insert
              (Container => All_Prefixes,
               New_Item  =>
                 new String'(Identifier_Prefixes_Rule.Concurrent_Prefix.all),
               Position  => C_All,
               Inserted  => Result);
         end if;

         if Identifier_Prefixes_Rule.Access_Prefix /= null then
            All_Defined_Prefixes.Insert
              (Container => All_Prefixes,
               New_Item  =>
                 new String'(Identifier_Prefixes_Rule.Access_Prefix.all),
               Position  => C_All,
               Inserted  => Result);
         end if;

         if Identifier_Prefixes_Rule.Class_Access_Prefix /= null then
            All_Defined_Prefixes.Insert
              (Container => All_Prefixes,
               New_Item  =>
                 new String'(Identifier_Prefixes_Rule.Class_Access_Prefix.all),
               Position  => C_All,
               Inserted  => Result);
         end if;

         if Identifier_Prefixes_Rule.Subprogram_Access_Prefix /= null then
            All_Defined_Prefixes.Insert
              (Container => All_Prefixes,
               New_Item  =>
                 new String'
                   (Identifier_Prefixes_Rule.Subprogram_Access_Prefix.all),
               Position  => C_All,
               Inserted  => Result);
         end if;

         if Identifier_Prefixes_Rule.Constant_Prefix /= null then
            All_Defined_Prefixes.Insert
              (Container => All_Prefixes,
               New_Item  =>
                 new String'(Identifier_Prefixes_Rule.Constant_Prefix.all),
               Position  => C_All,
               Inserted  => Result);
         end if;

         if Identifier_Prefixes_Rule.Enum_Prefix /= null then
            All_Defined_Prefixes.Insert
              (Container => All_Prefixes,
               New_Item  =>
                 new String'(Identifier_Prefixes_Rule.Enum_Prefix.all),
               Position  => C_All,
               Inserted  => Result);
         end if;

         if not Derived_Prefixes.Is_Empty
           (Identifier_Prefixes_Rule.Derived_Prefix)
         then
            C_Derived :=
              Derived_Prefixes.First (Identifier_Prefixes_Rule.Derived_Prefix);

            while C_Derived /= Derived_Prefixes.No_Element loop
               All_Defined_Prefixes.Insert
                 (Container => All_Prefixes,
                  New_Item  => new String'(Derived_Prefixes.Element
                                 (C_Derived).Prefix.all),
                  Position  => C_All,
                  Inserted  => Result);

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

      end if;

      Result := False;

      C_All := All_Defined_Prefixes.First (All_Prefixes);

      while C_All /= All_Defined_Prefixes.No_Element loop
         if To_Wide_String (All_Defined_Prefixes.Element (C_All).all) =
            Head (Name_Img, All_Defined_Prefixes.Element (C_All)'Length)
         then
            Result := True;
            exit;
         end if;

         C_All := Next (C_All);
      end loop;

      return Result;
   end Has_Specific_Prefix;

   -------------------------------------
   -- Init_Rule (Identifier_Prefixes) --
   -------------------------------------

   overriding procedure Init_Rule
     (Rule : in out Identifier_Prefixes_Rule_Type)
   is
   begin
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Identifier_Prefixes");
      Rule.Rule_Status := Non_Documented;
      Rule.Help_Info   := new String'("prefixes in defining names");
      Rule.Exclusive   := True;
      Rule.Diagnosis   :=
        new String'("#1#wrong prefix in type name"                         &
                    "#2#wrong prefix in task type name"                    &
                    "#3#wrong prefix in protected type name"               &
                    "#4#wrong prefix in access type name"                  &
                    "#5#wrong prefix in access-to-class type name"         &
                    "#6#wrong prefix in access-to-subprogram type name"    &
                    "#7#wrong prefix in name of the type derived from %1%" &
                    "#8#wrong prefix in constant name"                     &
                    "#9#wrong prefix in enumeration literal"               &
                    "#10#wrong use of specific prefix");
   end Init_Rule;

   -----------------------------------------------
   -- Is_Derived_Type_Par (Identifier_Prefixes) --
   -----------------------------------------------

   function Is_Derived_Type_Par (S : String) return Boolean is
      Result    : Boolean;
      First_Idx : constant Natural := S'First;
      Last_Idx  : constant Natural := S'Last;
      Colon_Idx : constant Natural := Index (S, ":");
   begin
      Result :=
        Is_Ada_Name
          (To_Wide_String (Trim (S (First_Idx .. Colon_Idx - 1), Both)));

      if Result then
         Result :=
           Is_Identifier_Prefix
             (To_Wide_String (Trim (S (Colon_Idx + 1 .. Last_Idx), Both)));
      end if;

      return Result;
   end Is_Derived_Type_Par;

   --------------------------------------
   -- Print_Rule (Identifier_Prefixes) --
   --------------------------------------

   overriding procedure Print_Rule
     (Rule         : Identifier_Prefixes_Rule_Type;
      Indent_Level : Natural := 0)
   is
      First_Param       : Boolean         := True;
      Rule_Name_Padding : constant String :=
        (1 .. Rule.Name'Length + 2 => ' ');
      C : Derived_Prefixes.Cursor;

   begin
      Print_Rule (Rule_Template (Rule), Indent_Level);

      if Rule.Type_Prefix /= null then
         Report_No_EOL (": Type = " & Rule.Type_Prefix.all);
         First_Param := False;
      end if;

      if Rule.Concurrent_Prefix /= null then
         if First_Param then
            Report_No_EOL (": Concurrent = " & Rule.Concurrent_Prefix.all);
            First_Param := False;
         else
            Report (", ");
            Report_No_EOL
              (Rule_Name_Padding &
               "Concurrent = " & Rule.Concurrent_Prefix.all,
              Indent_Level);
         end if;
      end if;

      if Rule.Access_Prefix /= null then
         if First_Param then
            Report_No_EOL (": Access = " & Rule.Access_Prefix.all);
            First_Param := False;
         else
            Report (", ");
            Report_No_EOL
              (Rule_Name_Padding &
               "Access = " & Rule.Access_Prefix.all,
              Indent_Level);
         end if;
      end if;

      if Rule.Class_Access_Prefix /= null then
         if First_Param then
            Report_No_EOL (": Class_Access = " & Rule.Class_Access_Prefix.all);
            First_Param := False;
         else
            Report (", ");
            Report_No_EOL
              (Rule_Name_Padding &
               "Class_Access = " & Rule.Class_Access_Prefix.all,
              Indent_Level);
         end if;
      end if;

      if Rule.Subprogram_Access_Prefix /= null then
         if First_Param then
            Report_No_EOL (": Subprogram_Access = " &
                           Rule.Subprogram_Access_Prefix.all);
            First_Param := False;
         else
            Report (", ");
            Report_No_EOL
              (Rule_Name_Padding &
               "Subprogram_Access = " & Rule.Subprogram_Access_Prefix.all,
              Indent_Level);
         end if;
      end if;

      if Rule.Constant_Prefix /= null then
         if First_Param then
            Report_No_EOL (": Constant = " & Rule.Constant_Prefix.all);
            First_Param := False;
         else
            Report (", ");
            Report_No_EOL
              (Rule_Name_Padding &
               "Constant = " & Rule.Constant_Prefix.all,
              Indent_Level);
         end if;
      end if;

      if Rule.Enum_Prefix /= null then
         if First_Param then
            Report_No_EOL (": Enum = " & Rule.Enum_Prefix.all);
            First_Param := False;
         else
            Report (", ");
            Report_No_EOL
              (Rule_Name_Padding &
               "Enum = " & Rule.Enum_Prefix.all,
              Indent_Level);
         end if;
      end if;

      if not Derived_Prefixes.Is_Empty (Rule.Derived_Prefix) then
         C := Derived_Prefixes.First (Rule.Derived_Prefix);

         while C /= Derived_Prefixes.No_Element loop

            if First_Param then
               Report_No_EOL (": Derived  = " & Derived_Pref (C));
               First_Param := False;
            else
               Report (", ");
               Report_No_EOL
                 (Rule_Name_Padding &
                  "Derived = " & Derived_Pref (C),
                 Indent_Level);
            end if;

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

      --  We have to print out Exclusive parameter, but this would make sense
      --  only if at least one prefix is specified

      if not First_Param and then Rule.Exclusive then
         Report (", ");
         Report_No_EOL
           (Rule_Name_Padding & "Exclusive");
      end if;

   end Print_Rule;

   ----------------------------------------------
   -- Print_Rule_To_File (Identifier_Prefixes) --
   ----------------------------------------------

   overriding procedure Print_Rule_To_File
     (Rule         : Identifier_Prefixes_Rule_Type;
      Rule_File    : File_Type;
      Indent_Level : Natural := 0)
   is
      First_Param       : Boolean         := True;
      Rule_Name_Padding : constant String :=
        (1 .. Rule.Name'Length + 4 => ' ');
      C : Derived_Prefixes.Cursor;

   begin
      Print_Rule_To_File (Rule_Template (Rule), Rule_File, Indent_Level);

      if Rule.Type_Prefix /= null then
         Put (Rule_File, ": Type = " & Rule.Type_Prefix.all);
         First_Param := False;
      end if;

      if Rule.Concurrent_Prefix /= null then
         if First_Param then
            Put (Rule_File, ": Concurrent = " & Rule.Concurrent_Prefix.all);
            First_Param := False;
         else
            Put_Line (Rule_File, ", ");

            for J in 1 .. Indent_Level loop
               Put (Rule_File, Get_Indent_String);
            end loop;

            Put (Rule_File,
                 Rule_Name_Padding &
                 "Concurrent = " & Rule.Concurrent_Prefix.all);
         end if;
      end if;

      if Rule.Access_Prefix /= null then
         if First_Param then
            Put (Rule_File, ": Access = " & Rule.Access_Prefix.all);
            First_Param := False;
         else
            Put_Line (Rule_File, ", ");

            for J in 1 .. Indent_Level loop
               Put (Rule_File, Get_Indent_String);
            end loop;

            Put (Rule_File,
                 Rule_Name_Padding & "Access = " & Rule.Access_Prefix.all);
         end if;
      end if;

      if Rule.Class_Access_Prefix /= null then
         if First_Param then
            Put
              (Rule_File, ": Class_Access = " & Rule.Class_Access_Prefix.all);
            First_Param := False;
         else
            Put_Line (Rule_File, ", ");

            for J in 1 .. Indent_Level loop
               Put (Rule_File, Get_Indent_String);
            end loop;

            Put (Rule_File,
                 Rule_Name_Padding &
                 "Class_Access = " & Rule.Class_Access_Prefix.all);
         end if;
      end if;

      if Rule.Subprogram_Access_Prefix /= null then
         if First_Param then
            Put (Rule_File,
                ": Subprogram_Access = " & Rule.Subprogram_Access_Prefix.all);
            First_Param := False;
         else
            Put_Line (Rule_File, ", ");

            for J in 1 .. Indent_Level loop
               Put (Rule_File, Get_Indent_String);
            end loop;

            Put (Rule_File,
                 Rule_Name_Padding &
                 "Subprogram_Access = " & Rule.Subprogram_Access_Prefix.all);
         end if;
      end if;

      if Rule.Constant_Prefix /= null then
         if First_Param then
            Put (Rule_File, ": Constant = " & Rule.Constant_Prefix.all);
            First_Param := False;
         else
            Put_Line (Rule_File, ", ");

            for J in 1 .. Indent_Level loop
               Put (Rule_File, Get_Indent_String);
            end loop;

            Put (Rule_File,
                 Rule_Name_Padding & "Constant = " & Rule.Constant_Prefix.all);
         end if;
      end if;

      if Rule.Enum_Prefix /= null then
         if First_Param then
            Put (Rule_File, ": Enum = " & Rule.Enum_Prefix.all);
            First_Param := False;
         else
            Put_Line (Rule_File, ", ");

            for J in 1 .. Indent_Level loop
               Put (Rule_File, Get_Indent_String);
            end loop;

            Put (Rule_File,
                 Rule_Name_Padding & "Enum = " & Rule.Enum_Prefix.all);
         end if;
      end if;

      if not Derived_Prefixes.Is_Empty (Rule.Derived_Prefix) then
         C := Derived_Prefixes.First (Rule.Derived_Prefix);

         while C /= Derived_Prefixes.No_Element loop

            if First_Param then
               Put (Rule_File, ": Derived  = " & Derived_Pref (C));
               First_Param := False;
            else
               Put_Line (Rule_File, ", ");

               for J in 1 .. Indent_Level loop
                  Put (Rule_File, Get_Indent_String);
               end loop;

               Put (Rule_File,
                    Rule_Name_Padding & "Derived = " & Derived_Pref (C));
            end if;

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

      --  We have to print out Exclusive parameter, but this would make sense
      --  only if at least one prefix is specified

      if not First_Param and then Rule.Exclusive then
         Put_Line (Rule_File, ", ");
         Put (Rule_File, Rule_Name_Padding & "Exclusive");
      end if;
   end Print_Rule_To_File;

   --------------------------------------------------
   -- Process_Rule_Parameter (Identifier_Prefixes) --
   --------------------------------------------------

   overriding procedure Process_Rule_Parameter
     (Rule    : in out Identifier_Prefixes_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_Prefix       : Boolean := False;
      Is_Legal_Der_Type_Par : Boolean := False;

      Parameter_Kind : Identifier_Prefixes_Parameter_Kinds;

   begin
      if Param = "" then
         if Enable then
            Rule.Rule_State := Enabled;
         else
            Rule.Rule_State := Disabled;
         end if;

         return;
      end if;

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

      Parameter_Kind :=
        Get_Identifier_Prefixes_Parameter_Kind
          (Param (First_Par_Idx .. Last_Par_Idx));

      if Parameter_Kind = Not_A_Parameter then
         Error ("(" & Rule.Name.all & ") wrong parameter : " &
                Param & ", ignored");
         return;
      end if;

      if First_Str_Idx = 0 then

         if Enable then  --  +R
            if Parameter_Kind =  Exclusive_Par then
               Rule.Exclusive := True;

               if At_Least_One_Prefix_Set (Rule) then
                  Rule.Rule_State := Enabled;
               end if;
            else
               Error
                ("(" & Rule.Name.all & ") wrong parameter : " &
                 Param & ", ignored");
            end if;
         else    --  -R
            case Parameter_Kind is
               when All_Prefixes_Par =>
                  Free_All_Prefixes (Rule);
                  Rule.Rule_State := Disabled;
               when Type_Par =>
                  Free (Rule.Type_Prefix);
               when Concurrent_Par =>
                  Free (Rule.Concurrent_Prefix);
               when Access_Par =>
                  Free (Rule.Access_Prefix);
               when Class_Access_Par =>
                  Free (Rule.Class_Access_Prefix);
               when Subprogram_Access_Par =>
                  Free (Rule.Subprogram_Access_Prefix);
               when Derived_Par =>
                  Free_All_Prefixes (Rule);
               when Constant_Par =>
                  Free (Rule.Constant_Prefix);
               when Enum_Par =>
                  Free (Rule.Enum_Prefix);
               when Exclusive_Par =>
                  Rule.Exclusive := False;
               when others =>
                  pragma Assert (False);
                  return;
            end case;

            if not At_Least_One_Prefix_Set (Rule) then
               Rule.Rule_State := Disabled;
            end if;

         end if;

      else

         if not Enable
           or else Parameter_Kind = Exclusive_Par
         then
            Error
             ("(" & Rule.Name.all & ") wrong parameter : " &
              Param & ", ignored");
            return;
         end if;

         if Parameter_Kind = Derived_Par then
            Is_Legal_Der_Type_Par :=
              Is_Derived_Type_Par (Param (First_Str_Idx .. Last_Str_Idx));
         else
            Is_Legal_Prefix :=
              Is_Identifier_Prefix
                (To_Wide_String (Param (First_Str_Idx .. Last_Str_Idx)));
         end if;

         if not (Is_Legal_Prefix or else Is_Legal_Der_Type_Par) then
            Error
             ("(" & Rule.Name.all & ") wrong parameter : " &
              Param & ", ignored");
            return;
         end if;

         case Parameter_Kind is
            when Type_Par =>
               Rule.Type_Prefix :=
                 new String'(Param (First_Str_Idx .. Last_Str_Idx));
            when Concurrent_Par =>
               Rule.Concurrent_Prefix :=
                 new String'(Param (First_Str_Idx .. Last_Str_Idx));
            when Access_Par =>
               Rule.Access_Prefix :=
                 new String'(Param (First_Str_Idx .. Last_Str_Idx));
            when Class_Access_Par =>
               Rule.Class_Access_Prefix :=
                 new String'(Param (First_Str_Idx .. Last_Str_Idx));
            when Subprogram_Access_Par =>
               Rule.Subprogram_Access_Prefix :=
                 new String'(Param (First_Str_Idx .. Last_Str_Idx));
            when Derived_Par =>
               declare
                  Colon_Idx : constant Natural :=
                    Index (Param (First_Str_Idx .. Last_Str_Idx), ":");
                  New_Pref : Derived_Pref_Record;

                  C        : Derived_Prefixes.Cursor;
                  Inserted : Boolean;
               begin
                  New_Pref.Parent_Name := new String'
                    (Trim (Param (First_Str_Idx .. Colon_Idx - 1), Right));

                  New_Pref.Prefix := new String'
                    (Trim (Param (Colon_Idx + 1 .. Last_Str_Idx), Left));

                  Derived_Prefixes.Insert
                    (Container => Rule.Derived_Prefix,
                     New_Item  => New_Pref,
                     Position  => C,
                     Inserted  => Inserted);

                  if not Inserted then
                     Derived_Prefixes.Replace_Element
                       (Container => Rule.Derived_Prefix,
                        Position  => C,
                        New_Item  => New_Pref);
                  end if;
               end;
            when Constant_Par =>
               Rule.Constant_Prefix :=
                 new String'(Param (First_Str_Idx .. Last_Str_Idx));
            when Enum_Par =>
               Rule.Enum_Prefix :=
                 new String'(Param (First_Str_Idx .. Last_Str_Idx));
            when others =>
               pragma Assert (False);
               return;
         end case;

         Rule.Rule_State := Enabled;
      end if;

   end Process_Rule_Parameter;

   ---------------------------------------------
   -- Rule_Check_Pre_Op (Identifier_Prefixes) --
   ---------------------------------------------

   overriding procedure Rule_Check_Pre_Op
     (Rule    : in out Identifier_Prefixes_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State)
   is
      pragma Unreferenced (Control);
      Tmp             : Asis.Element;
      Check_Exclusive : Boolean := False;
      Derived_Check   : Derived_Pref_Record;
      C_Pref_To_Check : Derived_Prefixes.Cursor;
   begin
      case Defining_Name_Kind (Element) is
         when A_Defining_Identifier =>
            Tmp := Get_Enclosing_Element;
         when A_Defining_Enumeration_Literal =>
            Tmp := Element;
         when others =>
            return;
      end case;

      case Flat_Element_Kind (Tmp) is

         when A_Defining_Enumeration_Literal =>
            if Rule.Enum_Prefix /= null then
               if not Has_Prefix
                 (Element, To_Wide_String (Rule.Enum_Prefix.all))
               then
                  State.Detected  := True;
                  State.Diagnosis := 9;
               end if;

               return;
            else
               Check_Exclusive := True;
            end if;

         when A_Constant_Declaration          |
              A_Deferred_Constant_Declaration =>

            if Flat_Element_Kind (Tmp) = A_Constant_Declaration
             and then
               not Is_Nil (Corresponding_Constant_Declaration (Element))
            then
               --  No check for names from full declarations that correspond to
               --  deferred constants
               return;
            end if;

            if Rule.Constant_Prefix /= null then
               if not Has_Prefix
                 (Element, To_Wide_String (Rule.Constant_Prefix.all))
               then
                  State.Detected  := True;
                  State.Diagnosis := 8;
               end if;

               return;
            end if;

            Check_Exclusive := True;

         when An_Ordinary_Type_Declaration    |
              A_Task_Type_Declaration         |
              A_Protected_Type_Declaration    |
              A_Private_Type_Declaration      |
              A_Private_Extension_Declaration |
              A_Formal_Type_Declaration       =>

            if Flat_Element_Kind (Tmp) in
               An_Ordinary_Type_Declaration .. A_Protected_Type_Declaration
              and then
               Declaration_Kind (Corresponding_Type_Declaration (Tmp)) in
               A_Private_Type_Declaration .. A_Private_Extension_Declaration
            then
               --  No check for full type declarations corresponding to
               --  private types
               return;
            end if;

            if Flat_Element_Kind (Tmp) in
               A_Task_Type_Declaration .. A_Protected_Type_Declaration
              and then
               Rule.Concurrent_Prefix /= null
            then
               if not Has_Prefix
                 (Element, To_Wide_String (Rule.Concurrent_Prefix.all))
               then
                  State.Detected  := True;

                  if Flat_Element_Kind (Tmp) = A_Task_Type_Declaration then
                     State.Diagnosis := 2;
                  else
                     State.Diagnosis := 3;
                  end if;
               end if;

               return;
            end if;

            Tmp := Type_Declaration_View (Tmp);

            if Type_Kind (Tmp) = An_Access_Type_Definition
              or else
               Formal_Type_Kind (Tmp) = A_Formal_Access_Type_Definition
            then

               if Access_Type_Kind (Tmp) in
                  An_Access_To_Procedure .. An_Access_To_Protected_Function
                 and then
                   Rule.Subprogram_Access_Prefix /= null
               then
                  if not Has_Prefix
                    (Element,
                     To_Wide_String (Rule.Subprogram_Access_Prefix.all))
                  then
                     State.Detected  := True;
                     State.Diagnosis := 6;
                  end if;

                  return;

               end if;

               if Is_Access_To_Class (Tmp) and then
                  Rule.Class_Access_Prefix /= null
               then
                  if not Has_Prefix
                    (Element,
                     To_Wide_String (Rule.Class_Access_Prefix.all))
                  then
                     State.Detected  := True;
                     State.Diagnosis := 5;
                  end if;

                  return;

               end if;

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

                  return;

               end if;

            end if;

            if Type_Kind (Tmp) in
               A_Derived_Type_Definition ..
                 A_Derived_Record_Extension_Definition
              or else
               Formal_Type_Kind (Tmp) = A_Formal_Derived_Type_Definition
              or else
               Declaration_Kind (Get_Enclosing_Element) =
                 A_Private_Extension_Declaration
            then
               Derived_Check.Parent_Name :=
                 new String'(To_String (Get_Full_Parent_Name (Tmp)));

               if Derived_Check.Parent_Name.all /= "" then
                  C_Pref_To_Check :=
                    Find (Rule.Derived_Prefix, Derived_Check);

                  if C_Pref_To_Check /= Derived_Prefixes.No_Element then
                     if not Has_Prefix
                       (Element,
                        To_Wide_String
                          (Derived_Prefixes.Element
                             (C_Pref_To_Check).Prefix.all))
                     then
                        State.Detected    := True;
                        State.Diagnosis   := 7;
                        State.Diag_Params :=
                          Enter_String
                            ("%1%" &
                             Derived_Prefixes.Element
                               (C_Pref_To_Check).Parent_Name.all);
                     end if;

                     return;
                  end if;

               end if;

            end if;

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

               return;
            else
               Check_Exclusive := True;
            end if;

         when An_Incomplete_Type_Declaration       |
              A_Tagged_Incomplete_Type_Declaration |
              A_Formal_Incomplete_Type_Declaration =>
            --  These names are never checked
            return;

         when others =>
            Check_Exclusive := True;
      end case;

      if Check_Exclusive
       and then
         Rule.Exclusive
       and then
         Has_Specific_Prefix (Element)
      then
         State.Detected  := True;
         State.Diagnosis := 10;
      end if;

   end Rule_Check_Pre_Op;

   -----------------------------------------
   -- XML_Rule_Help (Identifier_Prefixes) --
   -----------------------------------------

   overriding procedure XML_Rule_Help
     (Rule  : Identifier_Prefixes_Rule_Type;
      Level : Natural)
   is
   begin
      null;
   end XML_Rule_Help;

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

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

   procedure Init_Rule (Rule : in out Implicit_IN_Mode_Parameters_Rule_Type) is
   begin
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Implicit_IN_Mode_Parameters");
      Rule.Synonym     := new String'("Implicit_IN_Parameter_Mode");
      Rule.Rule_Status := Fully_Implemented;
      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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Implicit_SMALL_For_Fixed_Point_Types");
      Rule.Synonym     := new String'("Missing_Small_For_Fixed_Point_Type");
      Rule.Rule_Status := Fully_Implemented;
      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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Improperly_Located_Instantiations");
      Rule.Synonym    := new String'("Unreasonable_Places_For_Instantiations");
      Rule.Rule_Status := Fully_Implemented;
      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_Suffixes (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_Suffixes (Misnamed_Identifiers) --
   ----------------------------------------------

   procedure Free_All_Suffixes
     (Rule : in out Misnamed_Identifiers_Rule_Type)
   is
   begin
      Free (Rule.Type_Suffix);
      Free (Rule.Access_Suffix);
      Free (Rule.Access_To_Access_Suffix);
      Free (Rule.Class_Subtype_Suffix);
      Free (Rule.Class_Access_Suffix);
      Free (Rule.Constant_Suffix);
      Free (Rule.Renaming_Suffix);
   end Free_All_Suffixes;

   ---------------------------------------
   -- 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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Misnamed_Identifiers");
      Rule.Synonym     := new String'("Def_Name_Suffix");
      Rule.Rule_Status := Fully_Implemented;
      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"           &
                    "#5#wrong suffix in access-to-access type name" &
                    "#6#wrong suffix in class-wide subtype name"    &
                    "#7#wrong suffix in access-to-class type name");

   end Init_Rule;

   ---------------------------------------
   -- Print_Rule (Misnamed_Identifiers) --
   ---------------------------------------

   procedure Print_Rule
     (Rule         : Misnamed_Identifiers_Rule_Type;
      Indent_Level : Natural := 0)
   is
      First_Param       : Boolean         := True;
      Rule_Name_Padding : constant String :=
        (1 .. Rule.Name'Length + 2 => ' ');
   begin
      Print_Rule (Rule_Template (Rule), Indent_Level);

      if Rule.Type_Suffix /= null then
         Report_No_EOL (": Type_Suffix = " & Rule.Type_Suffix.all);
         First_Param := False;
      end if;

      if Rule.Access_Suffix /= null then

         if First_Param then
            Report_No_EOL (": Access_Suffix = " & Rule.Access_Suffix.all);
            First_Param := False;
         else
            Report (",");
            Report_No_EOL
              (Rule_Name_Padding &
               "Access_Suffix = " & Rule.Access_Suffix.all,
              Indent_Level);
         end if;

      end if;

      if Rule.Access_To_Access_Suffix /= null then

         if First_Param then
            Report_No_EOL
              (": Access_To_Access_Suffix = " &
               Rule.Access_To_Access_Suffix.all);
            First_Param := False;
         else
            Report (",");
            Report_No_EOL
              (Rule_Name_Padding &
               "Access_To_Access_Suffix = " & Rule.Access_To_Access_Suffix.all,
              Indent_Level);
         end if;

      end if;

      if Rule.Class_Subtype_Suffix /= null then

         if First_Param then
            Report_No_EOL
              (": Class_Subtype_Suffix = " & Rule.Class_Subtype_Suffix.all);
            First_Param := False;
         else
            Report (",");
            Report_No_EOL
              (Rule_Name_Padding &
               "Class_Subtype_Suffix = " & Rule.Class_Subtype_Suffix.all,
              Indent_Level);
         end if;

      end if;

      if Rule.Class_Access_Suffix /= null then

         if First_Param then
            Report_No_EOL
              (": Class_Access_Suffix = " & Rule.Class_Access_Suffix.all);
            First_Param := False;
         else
            Report (",");
            Report_No_EOL
              (Rule_Name_Padding &
               "Class_Access_Suffix = " & Rule.Class_Access_Suffix.all,
              Indent_Level);
         end if;

      end if;

      if Rule.Constant_Suffix /= null then

         if First_Param then
            Report_No_EOL (":  = " & Rule.Constant_Suffix.all);
            First_Param := False;
         else
            Report (",");
            Report_No_EOL
              (Rule_Name_Padding &
               "Constant_Suffix = " & Rule.Constant_Suffix.all,
              Indent_Level);
         end if;

      end if;

      if Rule.Renaming_Suffix /= null then

         if First_Param then
            Report_No_EOL (": Renaming_Suffix = " & Rule.Renaming_Suffix.all);
            First_Param := False;
         else
            Report (",");
            Report_No_EOL
              (Rule_Name_Padding &
               "Renaming_Suffix = " & Rule.Renaming_Suffix.all,
              Indent_Level);
         end if;

      end if;

   end Print_Rule;

   -----------------------------------------------
   -- Print_Rule_To_File (Misnamed_Identifiers) --
   -----------------------------------------------

   procedure Print_Rule_To_File
     (Rule         : Misnamed_Identifiers_Rule_Type;
      Rule_File    : File_Type;
      Indent_Level : Natural := 0)
   is
      First_Param       : Boolean         := True;
      Rule_Name_Padding : constant String :=
        (1 .. Rule.Name'Length + 4 => ' ');
   begin
      Print_Rule_To_File (Rule_Template (Rule), Rule_File, Indent_Level);

      if Rule.Type_Suffix /= null then
         Put (Rule_File, ": Type_Suffix = " & Rule.Type_Suffix.all);
         First_Param := False;
      end if;

      if Rule.Access_Suffix /= null then

         if First_Param then
            Put (Rule_File, ": Access_Suffix = " & Rule.Access_Suffix.all);
            First_Param := False;
         else
            Put_Line (Rule_File, ",");

            for J in 1 .. Indent_Level loop
               Put (Rule_File, Get_Indent_String);
            end loop;

            Put (Rule_File,
                 Rule_Name_Padding &
                 "Access_Suffix = " & Rule.Access_Suffix.all);
         end if;

      end if;

      if Rule.Access_To_Access_Suffix /= null then

         if First_Param then
            Put (Rule_File,
               ": Access_To_Access_Suffix = " &
               Rule.Access_To_Access_Suffix.all);
            First_Param := False;
         else
            Put_Line (Rule_File, ",");

            for J in 1 .. Indent_Level loop
               Put (Rule_File, Get_Indent_String);
            end loop;

            Put (Rule_File,
                 Rule_Name_Padding            &
                 "Access_To_Access_Suffix = " &
                 Rule.Access_To_Access_Suffix.all);
         end if;

      end if;

      if Rule.Class_Subtype_Suffix /= null then

         if First_Param then
            Put (Rule_File,
                 ": Class_Subtype_Suffix = " & Rule.Class_Subtype_Suffix.all);
            First_Param := False;
         else
            Put_Line (Rule_File, ",");

            for J in 1 .. Indent_Level loop
               Put (Rule_File, Get_Indent_String);
            end loop;

            Put (Rule_File,
                 Rule_Name_Padding &
                "Class_Subtype_Suffix = " & Rule.Class_Subtype_Suffix.all);
         end if;

      end if;

      if Rule.Class_Access_Suffix /= null then

         if First_Param then
            Put (Rule_File,
                 ": Class_Access_Suffix = " & Rule.Class_Access_Suffix.all);
            First_Param := False;
         else
            Put_Line (Rule_File, ",");

            for J in 1 .. Indent_Level loop
               Put (Rule_File, Get_Indent_String);
            end loop;

            Put (Rule_File,
                 Rule_Name_Padding &
                 "Class_Access_Suffix = " & Rule.Class_Access_Suffix.all);
         end if;

      end if;

      if Rule.Constant_Suffix /= null then

         if First_Param then
            Put (Rule_File, ":  = " & Rule.Constant_Suffix.all);
            First_Param := False;
         else
            Put_Line (Rule_File, ",");

            for J in 1 .. Indent_Level loop
               Put (Rule_File, Get_Indent_String);
            end loop;

            Put (Rule_File,
                 Rule_Name_Padding &
                 "Constant_Suffix = " & Rule.Constant_Suffix.all);
         end if;

      end if;

      if Rule.Renaming_Suffix /= null then

         if First_Param then
            Put (Rule_File, ": Renaming_Suffix = " & Rule.Renaming_Suffix.all);
            First_Param := False;
         else
            Put (Rule_File, ",");

            for J in 1 .. Indent_Level loop
               Put (Rule_File, Get_Indent_String);
            end loop;

            Put (Rule_File,
                 Rule_Name_Padding &
                 "Renaming_Suffix = " & Rule.Renaming_Suffix.all);
         end if;

      end if;

   end Print_Rule_To_File;

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

      Last_Str_Idx_Original : Natural;

      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 := False;
      Is_Legal_Access_Suffix : Boolean := False;

   begin

      if Param = "" then
         if Enable then
            Rule.Rule_State := Enabled;
         else
            Rule.Rule_State := Disabled;
         end if;

         return;
      end if;

      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_Suffixes (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);
               Free (Rule.Access_To_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)) =
               "class_subtype_suffix"
            then
               Free (Rule.Class_Subtype_Suffix);
            elsif To_Lower (Param (First_Par_Idx .. Last_Par_Idx)) =
               "class_access_suffix"
            then
               Free (Rule.Class_Access_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
              (To_Wide_String (Param (First_Str_Idx .. Last_Str_Idx)));

            if not Is_Legal_Suffix
              and then
               To_Lower (Param (First_Par_Idx .. Last_Par_Idx)) =
                  "access_suffix"
            then
               Is_Legal_Access_Suffix :=
                 Is_Access_Suffix (Param (First_Str_Idx .. Last_Str_Idx));
            end if;

            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.Access_To_Access_Suffix := null;

                  Rule.Rule_State := Enabled;

               elsif To_Lower (Param (First_Par_Idx .. Last_Par_Idx)) =
                  "class_subtype_suffix"
               then
                  Rule.Class_Subtype_Suffix :=
                    new String'(Param (First_Str_Idx .. Last_Str_Idx));
                  Rule.Rule_State := Enabled;

               elsif To_Lower (Param (First_Par_Idx .. Last_Par_Idx)) =
                 "class_access_suffix"
               then
                  Rule.Class_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;

            elsif Is_Legal_Access_Suffix then
               --  In this case we already know that
               --    To_Lower (Param (First_Par_Idx .. Last_Par_Idx)) =
               --      "access_suffix"
               Last_Str_Idx_Original := Last_Str_Idx;

               Last_Str_Idx :=
                 Index (Param (First_Str_Idx .. Last_Str_Idx), "(") - 1;

               Rule.Access_Suffix := new String'(Trim
                 (Param (First_Str_Idx .. Last_Str_Idx), Right));

               First_Str_Idx := Last_Str_Idx + 2;
               Last_Str_Idx  := Last_Str_Idx_Original - 1;

               Rule.Access_To_Access_Suffix := new String'(Trim
                 (Param (First_Str_Idx .. Last_Str_Idx), Both));

               Rule.Rule_State := Enabled;
            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);
      pragma Unmodified  (Rule);

      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
                       or else
                        Rule.Class_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

                           --  First, case of access-to-class type
                           if Rule.Class_Access_Suffix /= null
                             and then
                              Is_Access_To_Class (Tmp)
                           then
                              if not Has_Suffix
                                       (Element,
                                        To_Wide_String
                                          (Rule.Class_Access_Suffix.all))
                              then
                                 State.Detected  := True;
                                 State.Diagnosis := 7;
                              end if;

                              return;
                           end if;

                           if Rule.Access_Suffix /= null then

                              if Rule.Access_To_Access_Suffix = null then

                                 if not Has_Suffix
                                          (Element,
                                           To_Wide_String
                                             (Rule.Access_Suffix.all))
                                 then
                                    State.Detected  := True;
                                    State.Diagnosis := 2;
                                 end if;
                              else
                                 if Is_Access_To_Access (Tmp) then

                                    if not Has_Suffix
                                             (Element,
                                              To_Wide_String
                                               (Rule.Access_Suffix.all &
                                                Rule.Access_To_Access_Suffix.
                                                  all))
                                    then
                                       State.Detected  := True;
                                       State.Diagnosis := 5;
                                    end if;

                                 else

                                    if not Has_Suffix
                                             (Element,
                                              To_Wide_String
                                                (Rule.Access_Suffix.all))
                                    then
                                       State.Detected  := True;
                                       State.Diagnosis := 2;
                                    end if;

                                 end if;
                              end if;

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

               null;
            when A_Subtype_Declaration =>
               if Rule.Class_Subtype_Suffix /= null then

                  Tmp := Type_Declaration_View (Tmp);
                  Tmp := Asis.Definitions.Subtype_Mark (Tmp);

                  if (Attribute_Kind (Tmp) = A_Class_Attribute
                     or else
                      Denotes_Class_Wide_Subtype (Tmp))
                    and then
                     not Has_Suffix
                          (Element,
                           To_Wide_String (Rule.Class_Subtype_Suffix.all))
                  then
                     State.Detected  := True;
                     State.Diagnosis := 6;
                  end if;

               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_Suffixes (Rule);

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

   -----------------------------------------------------
   -- XML_Rule_Parameters_Help (Misnamed_Identifiers) --
   -----------------------------------------------------

   procedure XML_Rule_Help
     (Rule  : Misnamed_Identifiers_Rule_Type;
      Level : Natural)
   is
   begin
      Info (Level * Ident_String                  &
            "<check switch=""+R"                  &
            Rule.Name.all                         &
            ":Default"""                          &
            " label="""                           &
            "identifiers use standard suffixes""" &
            "/>");

      Info (Level * Ident_String               &
            "<field switch=""+R"               &
            Rule.Name.all                      &
            ":Type_Suffix"""                   &
            " label="""                        &
            "suffix for type names"            &
            " (empty string disables check)""" &
            " separator=""="""                 &
            " switch-off=""-R"                 &
            Rule.Name.all                      &
            ":Type_Suffix"""                   &
            "/>");

      Info (Level * Ident_String               &
            "<field switch=""+R"               &
            Rule.Name.all                      &
            ":Access_Suffix"""                 &
            " label="""                        &
            "suffix for access type names "    &
            " (empty string disables check)""" &
            " separator=""="""                 &
            " switch-off=""-R"                 &
            Rule.Name.all                      &
            ":Access_Suffix"""                 &
            "/>");

      Info (Level * Ident_String               &
            "<field switch=""+R"               &
            Rule.Name.all                      &
            ":Constant_Suffix"""               &
            " label="""                        &
            "suffix for constant names"        &
            " (empty string disables check)""" &
            " separator=""="""                 &
            " switch-off=""-R"                 &
            Rule.Name.all                      &
            ":Constant_Suffix"""               &
            "/>");

      Info (Level * Ident_String                   &
            "<field switch=""+R"                   &
            Rule.Name.all                          &
            ":Renaming_Suffix"""                   &
            " label="""                            &
            "suffix for package renaming names"    &
            " (empty string disables check)"""     &
            " separator=""="""                     &
            " switch-off=""-R"                     &
            Rule.Name.all                          &
            ":Renaming_Suffix"""                   &
            "/>");

      --  Specifying the dependencies between the default suffixes and the
      --  content of the fields for specific suffixes

      Info (Level * Ident_String                          &
           "<default-value-dependency master-switch=""+R" &
            Rule.Name.all                                 &
            ":Default"""                                  &
            " slave-switch=""+R"                          &
            Rule.Name.all                                 &
            ":Type_Suffix=_T""/>");

      Info (Level * Ident_String                          &
           "<default-value-dependency master-switch=""+R" &
            Rule.Name.all                                 &
            ":Default"""                                  &
            " slave-switch=""+R"                          &
            Rule.Name.all                                 &
            ":Access_Suffix=_A""/>");

      Info (Level * Ident_String                          &
           "<default-value-dependency master-switch=""+R" &
            Rule.Name.all                                 &
            ":Default"""                                  &
            " slave-switch=""+R"                          &
            Rule.Name.all                                 &
            ":Constant_Suffix=_C""/>");

      Info (Level * Ident_String                          &
           "<default-value-dependency master-switch=""+R" &
            Rule.Name.all                                 &
            ":Default"""                                  &
            " slave-switch=""+R"                          &
            Rule.Name.all                                 &
            ":Renaming_Suffix=_R""/>");

   end XML_Rule_Help;

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

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

   procedure Init_Rule (Rule : in out Non_Short_Circuit_Operators_Rule_Type) is
   begin
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Non_Short_Circuit_Operators");
      Rule.Synonym     := new String'("Use_Of_Non_Short_Circuit");
      Rule.Rule_Status := Fully_Implemented;
      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 --
   ----------------------------

   --------------------------------------
   -- Has_Tip (Non_Visible_Exceptions) --
   --------------------------------------

   function Has_Tip (Rule : Non_Visible_Exceptions_Rule_Type) return Boolean is
      pragma Unreferenced (Rule);
   begin
      return True;
   end Has_Tip;

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

   procedure Init_Rule (Rule : in out Non_Visible_Exceptions_Rule_Type) is
   begin
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Non_Visible_Exceptions");
      Rule.Rule_Status := Fully_Implemented;
      Rule.Help_Info   := new String'("potential propagations 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;

   ------------------------------------------------
   -- XML_Rule_Help_Tip (Non_Visible_Exceptions) --
   ------------------------------------------------

   procedure XML_Rule_Help_Tip
     (Rule  : Non_Visible_Exceptions_Rule_Type;
      Level : Natural)
   is
      pragma Unreferenced (Rule);
   begin
      Info_No_EOL (Level * Ident_String & "<tip>");
      Info ("Flag constructs leading to the possibility of propagating an");
      Info ("exception out of the scope in which the exception is declared.");
      Info ("Two cases are detected:");
      Info ("* An exception declaration in a subprogram body, task body");
      Info ("or block statement is flagged if the body or statement does not");
      Info ("contain a handler for that exception or a handler with an ");
      Info ("others choice.");
      Info ("* A raise statement in an exception handler of a subprogram");
      Info ("body, task body or block statement is flagged if it (re)raises");
      Info ("a locally declared exception. This may occur under the");
      Info ("following circumstances:");
      Info (" - it explicitly raises a locally declared exception, or");
      Info (" - it does not specify an exception name (i.e., it is simply");
      Info ("raise;) and the enclosing handler contains a locally declared");
      Info ("exception in its exception choices.");
      Info ("Renamings of local exceptions are not flagged.</tip>");
   end XML_Rule_Help_Tip;

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

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

   procedure Init_Rule (Rule : in out Numeric_Literals_Rule_Type) is
   begin
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Numeric_Literals");
      Rule.Rule_Status := Fully_Implemented;
      Rule.Help_Info   := new String'("numeric literals");
      Rule.Diagnosis   := new String'("numeric literal (%1%) 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 Param = "" then
         if Enable then
            Rule.Rule_State := Enabled;
         else
            Rule.Rule_State := Disabled;

            --  Restore defaults:
            Rule.Up_To           := 1;
            Rule.Statements_Only := False;
         end if;

         return;
      end if;

      if Enable then
         Rule.Rule_State := Enabled;

         if To_Lower (Param) = "all" then
            Rule.Up_To := -1;
         elsif To_Lower (Param) = "statements_only" then
            Rule.Statements_Only := True;
         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);
      pragma Unmodified  (Rule);

      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

            begin
               Integer_Literal_Value :=
                 Natural'Value (To_String (Value_Image (Element)));
            exception
               when Constraint_Error =>
                  --  The value is definitely too big to be an exception for
                  --  this rule!
                  return;
            end;

         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
                     Path_Kind (Encl_El) in
                       A_Case_Expression_Path .. An_Else_Expression_Path
                   or else
                     Association_Kind (Encl_El) in
                       A_Record_Component_Association ..
                       A_Parameter_Association
                   or else
                     (Definition_Kind (Encl_El) = A_Discrete_Subtype_Definition
                    and then
                      Declaration_Kind (Enclosing_Element (Encl_El)) =
                        A_Loop_Parameter_Specification)
               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
                  if Rule.Statements_Only then
                     State.Detected :=
                       Element_Kind (Encl_El) in A_Statement .. A_Path
                         or else
                       Declaration_Kind (Encl_El) =
                         A_Loop_Parameter_Specification;
                  else
                     State.Detected := True;
                  end if;
               end if;

            end if;
         end;

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

         end if;

      end if;

   end Rule_Check_Pre_Op;

   -------------------------------------------------
   -- XML_Rule_Parameters_Help (Numeric_Literals) --
   -------------------------------------------------

   procedure XML_Rule_Help
     (Rule  : Numeric_Literals_Rule_Type;
      Level : Natural)
   is
   begin

--      Info (Level * Ident_String              &
--            "<check switch=""+R"              &
--            Rule.Name.all                     &
--            ":ALL"                            &
--            """ label="""                     &
--            "all integer literals"""          &
--            "/>");

      Info (Level * Ident_String               &
            "<field switch=""+R"               &
            Rule.Name.all                      &
            """ separator="":"""               &
            " label="""                        &
            "Checks that no numeric literal "  &
            "is greater than the entered "     &
            "number, or set ALL to check all " &
            "numeric literals"""               &
            "/>");

      Info (Level * Ident_String               &
            "<check switch=""+R"               &
            Rule.Name.all                      &
            ":Statements_Only"                 &
            """ label="""                      &
            "check numeric literals "          &
            "on statements only"""             &
            "/>");

--      Info (Level * Ident_String              &
--            "<spin switch=""+R"               &
--            Rule.Name.all                     &
--            """ label="""                     &
--            "integer literals greater than"   &
--            """ min=""1"                      &
--            """ max=""99999"""                &
--            " default=""0"                    &
--            """ separator="":"""              &
--            "/>");
   end XML_Rule_Help;

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

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

   procedure Init_Rule (Rule : in out OTHERS_In_Aggregates_Rule_Type) is
   begin
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("OTHERS_In_Aggregates");
      Rule.Rule_Status := Fully_Implemented;
      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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("OTHERS_In_CASE_Statements");
      Rule.Rule_Status := Fully_Implemented;
      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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("OTHERS_In_Exception_Handlers");
      Rule.Rule_Status := Fully_Implemented;
      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
      Init_Rule (One_Integer_Parameter_Rule_Template (Rule));

      Rule.Name        := new String'("Overly_Nested_Control_Structures");
      Rule.Synonym     := new String'("Control_Structure_Nesting");
      Rule.Rule_Status := Fully_Implemented;
      Rule.Help_Info   := new String'("deep nesting level of " &
                                      "control structures");
      Rule.Diagnosis   := new String'("nesting level of control structures " &
                                      "too deep");
   end Init_Rule;

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

   ----------------------------------------------------------
   -- 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);
      pragma Unmodified  (Rule);

      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.Rule_Limit 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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Parameters_Out_Of_Order");
      Rule.Synonym     := new String'("Parameter_Mode_Ordering");
      Rule.Rule_Status := Fully_Implemented;
      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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        :=
        new String'("Positional_Actuals_For_Defaulted_Generic_Parameters");
      Rule.Rule_Status := Fully_Implemented;
      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 than one
            --  formal parameter declared in one parameter specification.

            for J in Formal_Params'Range loop

               if Element_Kind (Formal_Params (J)) /= A_Clause then

                  Move_Form := Move_Form + Names (Formal_Params (J))'Length;

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

               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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        :=
        new String'("Positional_Actuals_For_Defaulted_Parameters");
      Rule.Rule_Status := Fully_Implemented;
      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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Positional_Components");
      Rule.Synonym     := new String'("Positional_Component_Associations");
      Rule.Rule_Status := Fully_Implemented;
      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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Positional_Generic_Parameters");
      Rule.Synonym     := new String'("Positional_Generic_Associations");
      Rule.Rule_Status := Fully_Implemented;
      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
         if not Has_One_Parameter (Get_Enclosing_Element) then
            State.Detected := True;
         end if;
      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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Positional_Parameters");
      Rule.Synonym     := new String'("Positional_Parameter_Associations");
      Rule.Rule_Status := Fully_Implemented;
      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 --
   -----------------------------------------

   procedure Init_Rule (Rule : in out Predefined_Numeric_Types_Rule_Type) is
   begin
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Predefined_Numeric_Types");
      Rule.Rule_Status := Fully_Implemented;
      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 --
   -------------------------------------------------

   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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Raising_External_Exceptions");
      Rule.Synonym     := new String'("Visible_Exceptions");
      Rule.Rule_Status := Fully_Implemented;
      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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Raising_Predefined_Exceptions");
      Rule.Synonym     := new String'("Predefined_Exceptions");
      Rule.Rule_Status := Fully_Implemented;
      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 Defining_Name_Kind (Tmp_El) = A_Defining_Identifier then
               Tmp_El := Corresponding_Body_Parameter_Definition (Tmp_El);
            end if;

            if Defining_Name_Kind (Tmp_El) = A_Defining_Identifier 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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Unassigned_OUT_Parameters");
      Rule.Rule_Status := Fully_Implemented;
      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

            if Raises_Exception (Element) then
               return;
            end if;

            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;

         if Unassigned_Params > 0 then
            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 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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Uncommented_BEGIN_In_Package_Bodies");
      Rule.Synonym     := new String'("Non_Marked_BEGIN_In_Package_Body");
      Rule.Rule_Status := Fully_Implemented;
      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 package 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
                    (ASIS_Trim (To_String (Non_Comment_Image (LList (J))))) =
                  "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 :=
                    ASIS_Trim (To_String (Comment_Image (LList (Begin_Line))));

                  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
      Init_Rule (Rule_Template (Rule));

      Rule.Name        := new String'("Unnamed_Blocks_And_Loops");
      Rule.Synonym     := new String'("Non_Named_Blocks_And_Loops");
      Rule.Rule_Status := Fully_Implemented;
      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;
