asis_2019.0.0_3ca32fa2/tools/gnatcheck/gnatcheck-rules-custom_1.ads

------------------------------------------------------------------------------
--                                                                          --
--                          GNATCHECK COMPONENTS                            --
--                                                                          --
--             G N A T C H E C K . R U L E S . C U S T O M _ 1              --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--                     Copyright (C) 2006-2018, AdaCore                     --
--                                                                          --
-- GNATCHECK  is  free  software;  you can redistribute it and/or modify it --
-- under terms of the  GNU  General Public License as published by the Free --
-- Software Foundation;  either version 3, or ( at your option)  any  later --
-- version.  GNATCHECK  is  distributed in the hope that it will be useful, --
-- but  WITHOUT  ANY  WARRANTY;   without  even  the  implied  warranty  of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
-- Public License for more details.  You should have received a copy of the --
-- GNU General Public License distributed with GNAT; see file  COPYING3. If --
-- not,  go  to  http://www.gnu.org/licenses  for  a  complete  copy of the --
-- license.                                                                 --
--                                                                          --
-- GNATCHECK is maintained by AdaCore (http://www.adacore.com).             --
--                                                                          --
------------------------------------------------------------------------------

--  This package defines the a set of gnatcheck rules for gnatcheck developed
--  to satisfy some specific requests from gnatcheck users

pragma Ada_2012;

with Ada.Containers.Ordered_Sets;
package Gnatcheck.Rules.Custom_1 is

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

   package String_Access_Sets is new Ada.Containers.Ordered_Sets
     (Element_Type => String_Access,
      "="          => Eq);
   --  To be used as simple dictionaries

   use String_Access_Sets;

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

   --  Definitions of anonymous array types in the object declarations should
   --  be detected.
   --
   --  The rule does not have any parameter.

   type Anonymous_Arrays_Rule_Type is new Rule_Template with null record;

   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);
   --  If Element represents an array type definition, checks if the enclosing
   --  element is an object declaration

   procedure Init_Rule (Rule : in out Anonymous_Arrays_Rule_Type);

   Anonymous_Arrays_Rule : aliased Anonymous_Arrays_Rule_Type;

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

   --  Detect use of a range of enumeration literals as a choice in a case
   --  statement. All the possible forms of specifying a range (explicit
   --  ranges, such as A .. B, subtype marks and 'Range attributes) are
   --  flagged. An enumeration range is flagged even if contains exactly one
   --  enumeration value or no values at all. A type derived from an
   --  enumeration type is considered as an enumeration type.
   --
   --  This rule has no parameters.
   --
   --  The original enhancement request says nothing about any exception to
   --  this rule. But when the range of the case control expression subtype is
   --  too big (for example, Character or even Wide_Character), using ranges
   --  is the only practical way to write a case statement. Should we have a
   --  parameter that somehow controls the exceptions to the rule ???

   type Enumeration_Ranges_In_CASE_Statements_Rule_Type is new Rule_Template
     with null record;

   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);
   --  Checks if Element is an enumeration discrete range used as a choice in
   --  a case statement.

   procedure Init_Rule
     (Rule : in out Enumeration_Ranges_In_CASE_Statements_Rule_Type);

   Enumeration_Ranges_In_CASE_Statements_Rule :
     aliased Enumeration_Ranges_In_CASE_Statements_Rule_Type;

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

   --  Detect cases when an exception is raised and handled in the same
   --  subprogram body. Raise statements that are part of exception handlers
   --  are not flagged. Raise statements that are parts of package bodies, task
   --  bodies or entry bodies are not flagged.
   --
   --  The rule does not have any parameter.
   --
   --  Rationale: this rule is aimed against using exceptions to implement
   --             a normal control flow.

   type Exceptions_As_Control_Flow_Rule_Type is new Rule_Template
     with null record;

   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);
   --  If Element is a raise statement with an exception name, checks if it is
   --  located in a subprogram body and that body contains a handler for this
   --  exception or a handler with OTHERS choice.

   procedure Init_Rule (Rule : in out Exceptions_As_Control_Flow_Rule_Type);

   Exceptions_As_Control_Flow_Rule :
     aliased Exceptions_As_Control_Flow_Rule_Type;

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

   --  Exit statements that do not contain the name of the loop being exited
   --  are detected.
   --
   --  The rule does not have any parameter.

   type EXIT_Statements_With_No_Loop_Name_Rule_Type is new Rule_Template
     with null record;

   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);
   --  If Element is an exit statement checks if it contain the name of the
   --  loop being exited.

   procedure Init_Rule
     (Rule : in out EXIT_Statements_With_No_Loop_Name_Rule_Type);

   EXIT_Statements_With_No_Loop_Name_Rule :
     aliased EXIT_Statements_With_No_Loop_Name_Rule_Type;

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

   --  A discrete range of the form A'First .. A'Last should be detected.
   --
   --  The rule does not have any parameter.

   type Explicit_Full_Discrete_Ranges_Rule_Type is new Rule_Template
     with null record;

   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);
   --  If Element is a discrete range, checks if it has the form of
   --  A'First .. A'Last.

   procedure Init_Rule (Rule : in out Explicit_Full_Discrete_Ranges_Rule_Type);

   Explicit_Full_Discrete_Ranges_Rule :
     aliased Explicit_Full_Discrete_Ranges_Rule_Type;

   --------------------------
   -- Forbidden_Attributes --
   --------------------------

   --  A use of a specified attributes is detected. Attribute designator (s) to
   --  be checked for should be provided as the rule parameter(s).
   --
   --  The rule has the following parameters:
   --
   --  * For +R option
   --
   --      Attribute_Designator - adds the specified attribute to the set of
   --                    attributes to be checked and sets the checks for all
   --                    the specified attributes ON. If Attribute_Designator
   --                    does not correspond to any attribute designator
   --                    defined in the Ada Standard or to any designator of
   --                    the GNAT-specific attribute defined in the GNAT
   --                    Reference Manual, this is treated as a name of unknown
   --                    attribute.
   --
   --      GNAT        - all the GNAT-specific attributes are detected, this
   --                    also sets the checks for all the other specified
   --                    attributes ON.
   --
   --      ALL         - all the attributes are detected, this sets the rule
   --                    ON.
   --
   --  * For -R option
   --
   --      Attribute_Designator - removes the specified attribute from the set
   --                    of attributes to be checked. This does not turn the
   --                    rule (that is, checks for other attributes) ON or OFF.
   --                    If Attribute_Designator does not correspond to any
   --                    attribute designator defined in the Ada Standard or to
   --                    any designator of the GNAT-specific attribute defined
   --                    in the GNAT Reference Manual, this option is
   --                    treated as turning OFF detection of all the unknown
   --                    attributes.
   --
   --      GNAT        - turn OFF detection of all the GNAT-specific
   --                    attributes.
   --
   --      ALL         - cleans the list of the attributes to be detected and
   --                    turns the rule OFF.
   --
   --  Parameters are not case sensitive, If Attribute_Designator does not have
   --  a syntax of Ada identifier and, therefore, can not be considered as a
   --  (part of) the attribute designator, a diagnostic message is generated
   --  and the corresponding parameter is ignored. (If a specific attribute
   --  allows a static expression to be a part of the attribute designator,
   --  an expression should not be used as a part of the rule parameter, and
   --  for such attributes only an identifiers from the designator are
   --  checked.)
   --
   --  When more than one parameter is given in the same rule option, the
   --  parameters should be are separated by a comma.
   --
   --  If more than one option for this rule is specified for the gnatcheck
   --  call, a new option overrides the previous one(s).
   --
   --  +R option with no parameter turns the rule ON with the set of attributes
   --  to be detected defined by the previous rule options. (Note, that by
   --  default this set is empty, so if the only option specified for the rule
   --  is '+RForbidden_Attributes' (with no parameter), then the rule is
   --  enabled, but it does not detect anything). -R option with no parameter
   --  turns the rule OFF, but it does not affect a set of attributes to be
   --  detected.

   type Forbidden_Attributes_Rule_Type is new Rule_Template with null record;

   overriding procedure Activate_In_Test_Mode
     (Rule : in out Forbidden_Attributes_Rule_Type);
   --  Enables rule with parameters Range, Access, Img (GNAT-specific) and
   --  Object_Size (GNAT-specific)

   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);
   --  If Element is an attribute, checks that this attribute should be
   --  detected according to the current rule settings

   procedure Init_Rule (Rule : in out Forbidden_Attributes_Rule_Type);

   procedure Process_Rule_Parameter
     (Rule       : in out Forbidden_Attributes_Rule_Type;
      Param      :        String;
      Enable     :        Boolean;
      Defined_At : String);
   --  Process the Param string according to the parameter structure described
   --  above
   --
   --  No warning about parameter redefinition is issued by this procedure.

   procedure XML_Rule_Help
     (Rule  : Forbidden_Attributes_Rule_Type;
      Level : Natural);

   procedure Print_Rule
     (Rule         : Forbidden_Attributes_Rule_Type;
      Indent_Level : Natural := 0);

   overriding procedure Print_Rule_To_File
     (Rule         : Forbidden_Attributes_Rule_Type;
      Rule_File    : File_Type;
      Indent_Level : Natural := 0);
   --  Prints the rule with the actual settings for forbidden attributes

   overriding procedure XML_Print_Rule
     (Rule         : Forbidden_Attributes_Rule_Type;
      Indent_Level : Natural := 0);
   --  Prints the rule with the actual settings for forbidden attributes

   overriding function Allows_Parametrized_Exemption
     (Rule : Forbidden_Attributes_Rule_Type)
      return Boolean is (True);

   overriding function Allowed_As_Exemption_Parameter
     (Rule      : Forbidden_Attributes_Rule_Type;
      Parameter : String)
      return  Boolean;

   overriding function Rule_Parameter
     (Rule : Forbidden_Attributes_Rule_Type;
      Diag : String)
      return String;

   Forbidden_Attributes_Rule : aliased Forbidden_Attributes_Rule_Type;

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

   --  A use of a specified pragmas is detected. Pragma name(s) to be checked
   --  for should be provided as the rule parameter(s).
   --
   --  The rule has the following parameters:
   --
   --  * For +R option
   --
   --      Pragma_Name - adds the specified pragma to the set of pragmas to
   --                    be checked and sets the checks for all the specified
   --                    pragmas ON. Pragma_Name is treated as a name of a
   --                    pragma. If it does not correspond to any pragma name
   --                    defined in the Ada Standard or to any name of the
   --                    GNAT-specific pragma defined in the GNAT Reference
   --                    Manual, this is treated as a name of unknown pragma.
   --
   --      GNAT        - all the GNAT-specific pragmas are detected, this sets
   --                    the checks for all the specified pragmas ON.
   --
   --      ALL         - all the pragmas are detected, this sets the rule ON.
   --
   --  * For -R option
   --
   --      Pragma_Name - removes the specified pragma from the set of pragmas
   --                    to be checked. This does not turn the rule (that is,
   --                    checks for other pragmas) ON or OFF. Pragma_Name is
   --                    treated as a name of a pragma. If it does not
   --                    correspond to any pragma name defined in the Ada
   --                    Standard or to any name of the GNAT-specific pragma
   --                    defined in the GNAT Reference Manual, this option is
   --                    treated as turning OFF detection of all the unknown
   --                    pragmas.
   --
   --      GNAT        - turn OFF detection of all the GNAT-specific pragmas
   --
   --      ALL         - cleans the list of the pragmas to be detected and
   --                    turns the rule OFF.
   --
   --  Parameters are not case sensitive, If Pragma_Name does not have a syntax
   --  of Ada identifier and, therefore, can not be considered as a pragma
   --  name, a diagnostic message is generated and the corresponding parameter
   --  is ignored.
   --
   --  When more than one parameter is given in the same rule option, the
   --  parameters should be are separated by a comma.
   --
   --  If more than one option for this rule is specified for the gnatcheck
   --  call, a new option overrides the previous one(s).
   --
   --  +R option with no parameter turns the rule ON with the set of pragmas
   --  to be detected defined by the previous rule options. (Note, that by
   --  default this set is empty, so if the only option specified for the rule
   --  is '+RForbidden_Pragmas' (with no parameter), then the rule is enabled,
   --  but it does not detect anything). -R option with no parameter turns the
   --  rule OFF, but it does not affect a set of pragmas to be detected.

   type Forbidden_Pragmas_Rule_Type is new Rule_Template with null record;

   overriding procedure Activate_In_Test_Mode
     (Rule : in out Forbidden_Pragmas_Rule_Type);
   --  Enables rule with parameters Inline, Suppress, Initialize_Scalars
   --  (GNAT-specific) and Keep_Names  (GNAT-specific)

   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);
   --  If Element is a pragma, checks that this pragma should be detected
   --  according to the current rule settings

   procedure Init_Rule (Rule : in out Forbidden_Pragmas_Rule_Type);

   procedure Process_Rule_Parameter
     (Rule       : in out Forbidden_Pragmas_Rule_Type;
      Param      :        String;
      Enable     :        Boolean;
      Defined_At : String);
   --  Process the Param string according to the parameter structure described
   --  above
   --
   --  No warning about parameter redefinition is issued by this procedure.

   procedure XML_Rule_Help
     (Rule  : Forbidden_Pragmas_Rule_Type;
      Level : Natural);

   procedure Print_Rule
     (Rule         : Forbidden_Pragmas_Rule_Type;
      Indent_Level : Natural := 0);

   overriding procedure Print_Rule_To_File
     (Rule         : Forbidden_Pragmas_Rule_Type;
      Rule_File    : File_Type;
      Indent_Level : Natural := 0);
   --  Prints the rule with the actual settings for forbidden pragmas

   overriding procedure XML_Print_Rule
     (Rule         : Forbidden_Pragmas_Rule_Type;
      Indent_Level : Natural := 0);
   --  Prints the rule with the actual settings for forbidden pragmas

   overriding function Allows_Parametrized_Exemption
     (Rule : Forbidden_Pragmas_Rule_Type)
      return Boolean is (True);

   overriding function Allowed_As_Exemption_Parameter
     (Rule      : Forbidden_Pragmas_Rule_Type;
      Parameter : String)
      return  Boolean;

   overriding function Rule_Parameter
     (Rule : Forbidden_Pragmas_Rule_Type;
      Diag : String)
      return String;

   Forbidden_Pragmas_Rule : aliased Forbidden_Pragmas_Rule_Type;

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

   --  Detect procedures that can be rewritten as functions. A procedure can be
   --  converted into a function if it has exactly one parameter of mode IN and
   --  no parameter of IN OUT mode. Procedure declarations, formal procedure
   --  declarations and generic procedure declarations are always flagged.
   --  Procedure bodies and body stubs are flagged only if they do not have
   --  corresponding separate declarations. Procedure renamings and procedure
   --  instantiations are not flagged.
   --
   --  If a procedure can be rewritten as a function, but its OUT parameter is
   --  of limited type, this procedure is not flagged.
   --
   --  Protected procedures are not flagged. Null procedures also are not
   --  flagged.
   --
   --  The rule does not have any parameter.

   type Function_Style_Procedures_Rule_Type is new Rule_Template
     with null record;

   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);
   --  If Element is a (generic/formal) procedure declaration or a procedure
   --  body (body stub) that acts as a spec, checks if this procedure can be
   --  rewritten as a function.

   procedure Init_Rule (Rule : in out Function_Style_Procedures_Rule_Type);

   Function_Style_Procedures_Rule :
     aliased Function_Style_Procedures_Rule_Type;

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

   --  Declarations of generic units in subprograms are detected. Generic
   --  declarations in the bodies of generic subprograms are also flagged.
   --  Generic nested into another generic is never flagged. If a generic is
   --  declared in a local package that is declared in a subprogram body, this
   --  generic is flagged.
   --
   --  The rule does not have any parameter.
   --
   --  Rationale: this rule was originally provided as being related to code
   --             safety, complexity and efficiency.
   --
   --  Problems:
   --
   --     What about generic units declared in task and entry bodies? In block
   --     statements?

   type Generics_In_Subprograms_Rule_Type is new Rule_Template
     with null record;

   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);
   --  If Element represents a generic unit declarations, checks if it is
   --  declared in a subprogram body

   procedure Init_Rule (Rule : in out Generics_In_Subprograms_Rule_Type);

   Generics_In_Subprograms_Rule : aliased Generics_In_Subprograms_Rule_Type;

   -----------------------
   -- Identifier_Casing --
   -----------------------

   --  Flag each defining identifier that does not have a casing corresponding
   --  to the kind of entity being declared. All the defining names are
   --  checked. For The defining names from the following kinds of declarations
   --  a special casing scheme can be defined:
   --
   --     * type and subtype declarations;
   --     * enumeration literal specifications (not including character
   --       literals), and function renaming declarations if the renaming
   --       entity is an enumeration literal;
   --     * constant and named number declarations (including object renaming
   --       declarations if the renamed object is a constant)
   --     * exception declarations and exception renaming declarations
   --
   --  The rule may have the following parameters:
   --
   --  o For the `+R' option:
   --
   --    Type=casing_scheme
   --          Specifies casing for names from type and subtype declarations.
   --
   --    Enum=casing_scheme
   --          Specifies casing for defining enumeration literals and of the
   --          defining name in a function renaming declaration if the renamed
   --          entity is an enumeration literal.
   --
   --    Constant=casing_scheme
   --          Specifies the casing for a defining name from a constant or
   --          number declaration, including the object renaming declaration if
   --          the renamed object is a constant
   --
   --    Exception=casing_scheme
   --          Specifies the casing for names from exception declarations and
   --          exception renaming declarations.
   --
   --    Others=casing_scheme
   --          Specifies the casing for all the defining names for that a
   --          special casing scheme is not specified. If this parameter is not
   --          set, the casing for the entities that do not correspond to
   --          the specified parameters is not checked
   --
   --    Exclude=dictionary_file
   --          Specifies casing exceptions. Is a defining identifier is listed
   --          in some dictionary file, it should be using the same casing as
   --          it is specified in the dictionary
   --
   --  Where
   --
   --     casing_scheme ::= upper|lower|mixed
   --        upper means that the identifier should be upper-case
   --        lower means that the identifier should be lower-case
   --        mixed means that the first identifier letter and the first letter
   --           after underscore should be upper-case, and all the other
   --           letters should be lower-case;
   --
   --  If a defining identifier is from a declaration for that a specific
   --  casing scheme can be set, but the corresponding parameter is not
   --  specified for the rule, then the casing scheme defined by 'Others'
   --  parameter is used to check this identifier. If 'Others' parameter also
   --  is not set, the identifier is not checked.
   --
   --  dictionary_file is the name of the text file that contains casing
   --  exceptions. There are two kinds of exceptions:
   --
   --  * identifier - if a dictionary file contains an identifier, then any
   --                 (defining) identifier in the checked source should use
   --                 exactly the same casing as the identifier included in
   --                 dictionary_file
   --
   --  * wildcard   - a wildcard has the following syntax:
   --
   --                   wildcard := *identifier | *identifier* | identifier*
   --
   --                 where 'identifier' is an identifier in Ada sense, but
   --                 it does not allowed to contain underscores. Wildcards
   --                 specify the casing of subwords. A subword of the defining
   --                 identifier to check is a part if the identifier separated
   --                 by an underscore or the beginning/end of identifier.
   --                 A wildcard of the form identifier* defines the casing of
   --                 the first subword if the subword is case-insensitively
   --                 equal to 'identifier', *identifier defines the casing of
   --                 the last subword, and *identifier* - of any subword. The
   --                 parts of the identifier that cannot be mapped onto any
   --                 wildcard should satisfy the casing scheme defined for the
   --                 corresponding kind of entity.
   --
   --  If some identifier is included in the exception dictionary as a whole
   --  identifier and if it can be mapped onto some wildcard from the
   --  dictionary then the whole identifier but not wildcard is used to check
   --  the identifier casing.
   --
   --  If more than one dictionary file is specified, or a dictionary file
   --  contains more than one exception variant for the same identifier, the
   --  new casing exception overrides the previous one.
   --
   --  Casing check against dictionary file has higher priority then checks
   --  against the casing scheme specified for a given entity/declaration kind.
   --
   --  '+R' option should contain at least one parameter
   --  There is no parameter for '-R' option, it just turns the rule off. Note
   --  that -R does NOT clean up any parameter setting that have been done by
   --  previous +R option, so if you enable the rule, then disable it and
   --  enable again, the rule will have parameter setting defined by the first
   --  and second enabling. This does not look user-friendly, probably we
   --  should do clean-up when disabling the rule.

   type Casing_Schemes is
     (Not_A_Casing_Scheme,
      Lower,
      Mixed,
      Upper);

   type Wildcard_Rec is record
      Img      : String_Access;
      Orig_Img : String_Access;
   end record;

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

   package Wildcard_Sets is new  Ada.Containers.Ordered_Sets
     (Element_Type => Wildcard_Rec,
      "="          => Eq);

   type Identifier_Casing_Rule_Type is new Rule_Template with record
      Type_Casing      : Casing_Schemes;
      Enum_Casing      : Casing_Schemes;
      Constant_Casing  : Casing_Schemes;
      Exception_Casing : Casing_Schemes;
      Others_Casing    : Casing_Schemes;
      Exclude          : String_Access_Sets.Set;

      Type_Casing_Def_At      : String_Loc;
      Enum_Casing_Def_At      : String_Loc;
      Constant_Casing_Def_At  : String_Loc;
      Exception_Casing_Def_At : String_Loc;
      Others_Casing_Def_At    : String_Loc;

      Type_Casing_Synonym      : Rule_Name_Str;
      Enum_Casing_Synonym      : Rule_Name_Str;
      Constant_Casing_Synonym  : Rule_Name_Str;
      Exception_Casing_Synonym : Rule_Name_Str;
      Others_Casing_Synonym    : Rule_Name_Str;
      Exclude_Synonym          : Rule_Name_Str;

      Wilcards         : Wildcard_Sets.Set;
      Dictionaries     : String_Access_Sets.Set;
   end record;

   overriding procedure Activate_In_Test_Mode
     (Rule : in out Identifier_Casing_Rule_Type);
   --  Activates the rule with the following parameters:
   --    Type=upper
   --    Enum=mixed
   --    Constant=lower
   --    Exception=upper
   --    Others=mixed
   --
   --  and casing exceptions specified as:
   --
   --    UNIT ASIS bits1 *_IO

   overriding function Annotate_Rule
     (Rule : Identifier_Casing_Rule_Type;
      Var  : Diagnosis_Variant := 0)
      return String;
   --  Returns the rule name followed by the specified parameter that is the
   --  most relevant for the given diagnosis variant

   overriding procedure Rule_Check_Pre_Op
     (Rule    : in out Identifier_Casing_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State);
   --  If Element is a defining identifier check its casing

   overriding procedure Init_Rule
     (Rule : in out Identifier_Casing_Rule_Type);

   overriding procedure Process_Rule_Parameter
     (Rule       : in out Identifier_Casing_Rule_Type;
      Param      :        String;
      Enable     :        Boolean;
      Defined_At : String);
   --  Process the Param string according to the parameter structure described
   --  above
   --
   --  Issues a warning (with the corresponding debug option ON) if the casing
   --  scheme is redefined for the rule that is already enabled. The warhing
   --  is issued only for changing a case scheme for the specific kind of
   --  entities, but not for cnages in the description of casing exceptions.

   overriding procedure XML_Rule_Help
     (Rule  : Identifier_Casing_Rule_Type;
      Level : Natural);

   overriding procedure Print_Rule
     (Rule         : Identifier_Casing_Rule_Type;
      Indent_Level : Natural := 0);

   overriding procedure Print_Rule_To_File
     (Rule         : Identifier_Casing_Rule_Type;
      Rule_File    : File_Type;
      Indent_Level : Natural := 0);
   --  Prints the rule with the actually specified prefixes.

   overriding procedure XML_Print_Rule
     (Rule         : Identifier_Casing_Rule_Type;
      Indent_Level : Natural := 0);
   --  Prints the rule with the actually specified prefixes.

   overriding function Allows_Parametrized_Exemption
     (Rule : Identifier_Casing_Rule_Type)
      return Boolean is (True);

   overriding function Allowed_As_Exemption_Parameter
     (Rule      : Identifier_Casing_Rule_Type;
      Parameter : String)
      return  Boolean;

   overriding function Rule_Parameter
     (Rule : Identifier_Casing_Rule_Type;
      Diag : String)
      return String;

   Identifier_Casing_Rule : aliased Identifier_Casing_Rule_Type;

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

   --  Flag each defining identifier that does not have a prefix corresponding
   --  to the kind of declaration it is defined by. The defining names in the
   --  following kinds of declarations are checked:
   --
   --     * type and subtype declarations (task, protected and access types are
   --       treated separately)
   --     * enumeration literal (not including character literals), and
   --       function renaming declarations if the renaming entity is an
   --       enumeration literal
   --     * exception declarations and exception renaming declarations
   --     * constant and named number declarations (including object renaming
   --       declarations if the renamed object is a constant)
   --
   --  Defining names declared by single task declarations or single protected
   --  declarations are not checked by this rule.
   --
   --  The defining name from the full type declaration corresponding to a
   --  private type declaration or a private extension declaration is never
   --   flagged. A defining name from an incomplete type declaration is never
   --  flagged.
   --
   --  The defining name from a body that is a completion of a program unit
   --  declaration or a proper body of a subunit is never flagged.
   --
   --  The defining name from a body stub that is a completion of a program
   --  unit declaration is never flagged.
   --
   --  The defining name from a subprogram renaming-as-body declaration is
   --  never flagged.
   --
   --  For a deferred constant, the defining name in the corresponding full
   --  constant declaration is never flagged.
   --
   --  Note that the rule checks only defining names. Usage name occurrence are
   --  not checked and are never flagged.
   --
   --  The rule may have the following parameters:
   --
   --  o For the `+R' option:
   --
   --    Type=string
   --          Specifies the prefix for a type or subtype name.
   --
   --    Concurrent=string
   --        Specifies the prefix for a task and protected type/subtype name.
   --        If this parameter is set, it overrides for task and protected
   --        types the prefix set by the Type parameter.
   --
   --    Access=string
   --        Specifies the prefix for an access type/subtype name. If this
   --        parameter is set, it overrides for access types the prefix set by
   --        the Type parameter.
   --
   --    Class_Acces=string
   --        Specifies the prefix for the name of an access type/subtype that
   --        points to some class-wide type. If this parameter is set, it
   --        overrides for such access types and subtypes the prefix set by the
   --        Type or Access parameter.
   --
   --    Subprogram_Access=string
   --        Specifies the prefix for the name of an access type/subtype that
   --        points to a subprogram. If this parameter is set, it overrides for
   --        such access types/subtypes the prefix set by the Type or Access
   --        parameter.
   --
   --    Derived=string1:string2
   --        Specifies the prefix for a type that is directly derived from a
   --        given type or from a subtype thereof. string1 should be a full
   --        expanded Ada name of the ancestor type (starting from the full
   --        expanded compilation unit name), string2 defines the prefix to
   --        check.
   --
   --    Constant=string
   --        Specifies the prefix for a defining name from a constant or number
   --        declaration, including the object renaming declaration if the
   --        renamed object is a constant
   --
   --    Enum=string
   --        Specifies the prefix for defining enumeration literals and of the
   --        defining name in a function renaming declaration if the renamed
   --        entity is an enumeration literal.
   --
   --    Exception=string
   --        Specifies the prefix for a defining name from an exception
   --        declaration and exception renaming declaration.
   --
   --    Exclusive
   --         Check that only those kinds of names for which specific prefix is
   --         defined have the specified prefix (e.g., only type/subtype names
   --         have prefix T_, but not variable or package names), and flag all
   --         the defining names that have some of the specified prefixes but
   --         does not belong to the kind of the entities this prefix is
   --         defined for. By default the exclusive check mode is ON.
   --
   --  o For the `-R' option:
   --
   --    All_Prefixes
   --        Removes all the prefixes specified for the identifier prefix
   --        checks, whether by default or as specified by other rule
   --        parameters and disables the rule.
   --
   --    Type
   --    Concurrent
   --    Access
   --    Class_Access
   --    Subprogram_Access
   --    Derived
   --        Removes the specified prefix. This does not disable the rule, and
   --        in case if a prefix for a specific type kind is removed, but there
   --        is a prefix specified for more general type kind, this prefix will
   --        be used for a specific type kind (E.g. if
   --        '-RSubprogram_Access_Prefix is given but the prefix for access
   --        type names is specified, the prefix for all the access subtypes
   --        will be used for access-to-subprogram type names)
   --
   --    Constant
   --        Removes the prefix specified for constant names and turns off the
   --        check for constant names.
   --
   --    Exception
   --        Removes the prefix specified for exception names and turns off the
   --        check for exception names.
   --
   --    Enum
   --        Removes the prefix specified for enumeration literal names and
   --        turns off the check for enumeration literals.
   --
   --    Exclusive
   --        Turns off strong check mode.
   --
   --  If more than one parameter is used, parameters must be separated by
   --  commas.
   --
   --  If more than one option is specified for the gnatcheck invocation, a new
   --  option overrides the previous one(s).
   --
   --  The `+R Identifier_Prefixes' option (with no parameter) enables checks
   --  for all the name prefixes specified by previous options used for this
   --  rule. If no prefix is specified, the rule is not enabled.
   --
   --  The `-RIdentifier_Prefixes' option (with no parameter) disables all the
   --  checks but keeps all the prefixes specified by previous options used for
   --  this rule.
   --
   --  There is no default prefix setting for this rule. All the checks for
   --  name prefixes are case-sensitive
   --
   --  If any error is detected in a rule parameter, the parameter is ignored.
   --  In such a case the options that are set for the rule are not specified.

   type Derived_Pref_Record is record
      Parent_Name : String_Access;
      Prefix      : String_Access;
   end record;

   function "=" (Left, Right : Derived_Pref_Record) return Boolean;
   function "<" (Left, Right : Derived_Pref_Record) return Boolean;

   package Derived_Prefixes is new
     Ada.Containers.Ordered_Sets (Derived_Pref_Record);
   use Derived_Prefixes;

   type Identifier_Prefixes_Rule_Type is new Rule_Template with record
      Type_Prefix                      : String_Access;
      Type_Prefix_Synonym              : Rule_Name_Str;

      Concurrent_Prefix                : String_Access;
      Concurrent_Prefix_Synonym        : Rule_Name_Str;

      Access_Prefix                    : String_Access;
      Access_Prefix_Synonym            : Rule_Name_Str;

      Class_Access_Prefix              : String_Access;
      Class_Access_Prefix_Synonym      : Rule_Name_Str;

      Subprogram_Access_Prefix         : String_Access;
      Subprogram_Access_Prefix_Synonym : Rule_Name_Str;

      Derived_Prefix                   : Derived_Prefixes.Set;
      Derived_Prefix_Synonym           : Rule_Name_Str;

      Constant_Prefix                  : String_Access;
      Constant_Prefix_Synonym          : Rule_Name_Str;

      Exception_Prefix                 : String_Access;
      Exception_Prefix_Synonym         : Rule_Name_Str;

      Enum_Prefix                      : String_Access;
      Enum_Prefix_Synonym              : Rule_Name_Str;

      Exclusive                        : Boolean := True;
      Exclusive_Prefix_Synonym         : Rule_Name_Str;
   end record;

   overriding procedure Activate_In_Test_Mode
     (Rule : in out Identifier_Prefixes_Rule_Type);
   --  Activates the rule with the following parameters:
   --     Type=T_
   --     Concurrent=J_
   --     Access=P_
   --     Class_Access=CP_
   --     Subprogram_Access=F_
   --     Derived=Ada.Finalization.Controlled:CTRL_
   --     Enum=E_
   --     Constant=C_
   --     Exception= X_
   --     Exclusive

   overriding function Annotate_Rule
     (Rule : Identifier_Prefixes_Rule_Type;
      Var  : Diagnosis_Variant := 0)
      return String;
   --  Returns the rule name followed by the specified parameter that is the
   --  most relevant for the given diagnosis variant

   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);
   --  If Element is a defining identifier check its prefix

   overriding procedure Init_Rule
     (Rule : in out Identifier_Prefixes_Rule_Type);

   overriding procedure Process_Rule_Parameter
     (Rule       : in out Identifier_Prefixes_Rule_Type;
      Param      :        String;
      Enable     :        Boolean;
      Defined_At : String);
   --  Process the Param string according to the parameter structure described
   --  above
   --  ??? Defined_At ???

   overriding procedure XML_Rule_Help
     (Rule  : Identifier_Prefixes_Rule_Type;
      Level : Natural);

   overriding procedure Print_Rule
     (Rule         : Identifier_Prefixes_Rule_Type;
      Indent_Level : Natural := 0);

   overriding procedure Print_Rule_To_File
     (Rule         : Identifier_Prefixes_Rule_Type;
      Rule_File    : File_Type;
      Indent_Level : Natural := 0);
   --  Prints the rule with the actually specified prefixes.

   overriding procedure XML_Print_Rule
     (Rule         : Identifier_Prefixes_Rule_Type;
      Indent_Level : Natural := 0);
   --  Prints the rule with the actually specified prefixes.

   overriding function Allows_Parametrized_Exemption
     (Rule : Identifier_Prefixes_Rule_Type)
      return Boolean is (True);

   overriding function Allowed_As_Exemption_Parameter
     (Rule      : Identifier_Prefixes_Rule_Type;
      Parameter : String)
      return  Boolean;

   overriding function Rule_Parameter
     (Rule : Identifier_Prefixes_Rule_Type;
      Diag : String)
      return String;

   Identifier_Prefixes_Rule : aliased Identifier_Prefixes_Rule_Type;

   -------------------------
   -- Identifier_Suffixes --
   -------------------------

   --  A defined name for a specific kind of entity should have a specific
   --  suffix. The defining names in the following declarations are checked:
   --
   --    * type declarations
   --    * subtype declarations
   --    * object declarations:
   --      - variable and constant declarations, but not number declarations
   --      - record component declarations
   --      - formal parameter declarations
   --      - formal object declarations
   --    * package renaming declarations (but not generic package renaming
   --      declarations
   --    * (protected) subprograms used as unterrupt handlers
   --
   --  This rule may have parameters. When used without parameters, the
   --  following checks are made:
   --
   --    * type defining name ends with '_T' unless the type is an access type,
   --      in this case the suffix should be '_A'
   --
   --    * constant names end with '_C'
   --
   --    * names defining package renamings end with '_R'
   --
   --    * the check for access type objects is not enabled
   --
   --    * the check for interrupt hundlers is not enabled
   --
   --  Defined names from incomplete type declarations are not checked.
   --
   --  For a private type declaration (including private extensions) - the
   --  defining identifier from the private type declaration is checked against
   --  the type suffix (even if the corresponding full declaration is an access
   --  type declaration), and the defining identifier from the corresponding
   --  full type declaration is not checked;
   --
   --  For a deferred constant, the defining name in the corresponding full
   --  constant declaration is not checked.
   --
   --  Defining names of formal types are not checked.
   --
   --  Check for the suffix of access type data objects is applied to the
   --  following kinds of declarations:
   --     * variable and constant declarations
   --     * record component declarations
   --     * return object declaration
   --     * formal parameter declarations
   --     * formal object declarations
   --
   --  ???
   --  If both checks for constant suffixes and for access object suffixes are
   --  enabled, and if different suffixes are defined for them, then the rule
   --  has a check conflict for constants of access type. At the moment the
   --  check for access object suffixes suffixes is applied, and no error or
   --  warning message is issued to mark this situation. We may want to change
   --  this in future(???)
   --  ???
   --
   --  The rule may have the following parameters:
   --
   --  o For +R option:
   --
   --      Default                - sets the default listed above for all
   --                               the names to be checked
   --
   --      Type_Suffix=string     - specifies the suffix for a type name
   --
   --      Access_Suffix=string   - specifies the suffix for an access type
   --                               name, if this parameter is set, it
   --                               overrides for access types the suffix set
   --                               by 'Type_Suffix' parameter. For access
   --                               types, 'string' may have the following
   --                               format: 'suffix1(suffix2). That means that
   --                               an access type name should have the
   --                               'suffix1' suffix except for the case when
   --                               the designated type is also an access type,
   --                               in this case the type name should have the
   --                               'suffix1 & suffix2' suffix.
   --
   --      Class_Access_Suffix=string - specify the suffix for access type in
   --                               case if it is an access-to-object
   --                               definition and the subtype mark in its
   --                               definition is 'Class attribute. This
   --                               overrides setting for access-to-class type
   --                               names specified by Type_Suffix and
   --                               Access_Suffix parameters, if any.
   --
   --      Class_Subtype_Suffix=string - specify the suffix for subtype name in
   --                               case when the subtype mark is 'Class
   --                               attribute.
   --
   --      Constant_Suffix=string -  specifies the suffix for a constant name
   --
   --      Renaming_Suffix=string -  specifies the suffix for package renaming
   --                                name
   --
   --      Access_Obj_Suffix=string -  specifies the suffix for objects that
   --                               have an access type (including types
   --                               derived from access types)
   --
   --      Interrupt_Suffix       - specifies the suffix for protected
   --                               subprograms used as interrupt handlers
   --
   --  o For -R option:
   --
   --      All_Suffixes           - remove all the suffixes specified for the
   --                               identifier suffix checks, either by default
   --                               or specified by other rule parameters. All
   --                               the checks for this rule are disabled as
   --                               the result.
   --
   --      Type_Suffix            - removes the suffix specified for types,
   --                               this disables checks for types. It does not
   --                               disable any other checks for this rule
   --                               (including the check for access type names
   --                               if Access_Suffix is set).
   --
   --      Access_Suffix          - removes the suffix specified for access
   --                               types, this disables checks for access
   --                               type names. It does not disable any other
   --                               checks for this rule. If Type_Suffix is
   --                               set, access type names are checked as
   --                               ordinary type names.
   --
   --      Class_Subtype_Suffix   - removes the suffix specified for subtypes
   --                               defined for class-wide types, this
   --                               disables checks for subtype names. It does
   --                               not disable any other checks for this rule.
   --
   --      Class_Access_Suffix    - removes the suffix specified for access
   --                               types pointing to class-wide types.  For
   --                               access type names the check is defined by
   --                               other parameters. It does not disable any
   --                               other checks for this rule.
   --
   --      Constant_Suffix        - removes the suffix specified for constants
   --                               this disables checks for constant names.
   --                               It does not disable any other checks for
   --                               this rule.
   --
   --      Renaming_Suffix        - removes the suffix specified for package
   --                               renamings, this disables checks for
   --                               package renamings. It does not disable any
   --                               other checks for this rule.
   --
   --      Access_Obj_Suffix      - removes the suffix specified for objects of
   --                               access types, this disables checks for
   --                               such objects. It does not disable any
   --                               other checks for this rule.
   --      Interrupt_Suffix       - removes the suffix for protected
   --                               subprograms used as interrupt handlers. It
   --                               does not disable any other checks for this
   --                               rule.
   --
   --  If more than one parameter is used, parameters should be separated by
   --  comma.
   --
   --  If more than one  option is specified for the gnatcheck call, a new
   --  option overrides the previous one(s).
   --
   --  +RIdentifier_Suffixes option (with no parameter) enables all the
   --  check for all the name suffixes specified by previous options used for
   --  this rule.
   --  -RIdentifier_Suffixes option (with no parameter) disables all the
   --  checks but keeps all the suffixes specified by previous options used for
   --  this rule.
   --
   --  'string' should be a valid suffix for an Ada identifier (after cutting
   --  out all the leading and trailing space characters, if any), except for
   --  the case when 'string' specifies suffixes for access and
   --  access-to access types, in the latter case both components of this
   --  'string' should be valid Ada identifier suffixes. Parameters are not
   --  case sensitive, except the 'string' part.
   --
   --  If any error is detected in a rule parameter, a parameter is ignored.
   --  Note, that in this case nothing definite can be said about options that
   --  are set for the rule.

   type Identifier_Suffixes_Rule_Type is new Rule_Template with record
      Type_Suffix                     : String_Access;
      Type_Suffix_Synonym             : Rule_Name_Str;

      Access_Suffix                   : String_Access;
      Access_Suffix_Synonym           : Rule_Name_Str;

      Access_To_Access_Suffix         : String_Access;
      --  Share Access_Suffix_Synonym for user-defined rule synonym

      Class_Subtype_Suffix            : String_Access;
      Class_Subtype_Suffix_Synonym    : Rule_Name_Str;

      Class_Access_Suffix             : String_Access;
      Class_Access_Suffix_Synonym     : Rule_Name_Str;

      Constant_Suffix                 : String_Access;
      Constant_Suffix_Synonym         : Rule_Name_Str;

      Renaming_Suffix                 : String_Access;
      Renaming_Suffix_Synonym         : Rule_Name_Str;

      Access_Obj_Suffix               : String_Access;
      Access_Obj_Suffix_Synonym       : Rule_Name_Str;

      Interrupt_Suffix                : String_Access;
      Interrupt_Suffix_Synonym        : Rule_Name_Str;
   end record;

   overriding procedure Activate_In_Test_Mode
     (Rule : in out Identifier_Suffixes_Rule_Type);
   --  Activates the rule with the following parameters:
   --     Type_Suffix=_T
   --     Access_Suffix=_Access(_Access)
   --     Class_Access_Suffix=_Class_Access
   --     Class_Subtype_Suffix=_Class
   --     Constant_Suffix=_C
   --     Renaming_Suffix=_R

   overriding function Annotate_Rule
     (Rule : Identifier_Suffixes_Rule_Type;
      Var  : Diagnosis_Variant := 0)
      return String;
   --  Returns the rule name followed by the specified parameter that is the
   --  most relevant for the given diagnosis variant

   procedure Rule_Check_Pre_Op
     (Rule    : in out Identifier_Suffixes_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State);
   --  If Element is a defining identifier from a type, constant or package
   --  renaming declaration, check that it has a specified suffix

   procedure Init_Rule (Rule : in out Identifier_Suffixes_Rule_Type);

   procedure Process_Rule_Parameter
     (Rule       : in out Identifier_Suffixes_Rule_Type;
      Param      :        String;
      Enable     :        Boolean;
      Defined_At : String);
   --  Process the Param string according to the parameter structure described
   --  above
   --  ??? Defined_At ???

   procedure Set_Rule_Defaults
     (Rule : in out Identifier_Suffixes_Rule_Type);
   --  Set the default check mode and name suffixes described above. This
   --  procedure does not belong to the set of primitive operations of the
   --  parent type for Defining_Names_Suffixes_Rule_Type.

   procedure XML_Rule_Help
     (Rule  : Identifier_Suffixes_Rule_Type;
      Level : Natural);

   overriding procedure Print_Rule
     (Rule         : Identifier_Suffixes_Rule_Type;
      Indent_Level : Natural := 0);

   overriding procedure Print_Rule_To_File
     (Rule         : Identifier_Suffixes_Rule_Type;
      Rule_File    : File_Type;
      Indent_Level : Natural := 0);
   --  Prints the rule with the actually specified suffixes.

   overriding procedure XML_Print_Rule
     (Rule         : Identifier_Suffixes_Rule_Type;
      Indent_Level : Natural := 0);
   --  Prints the rule with the actually specified suffixes.

   overriding function Allows_Parametrized_Exemption
     (Rule : Identifier_Suffixes_Rule_Type)
      return Boolean is (True);

   overriding function Allowed_As_Exemption_Parameter
     (Rule      : Identifier_Suffixes_Rule_Type;
      Parameter : String)
      return  Boolean;

   overriding function Rule_Parameter
     (Rule : Identifier_Suffixes_Rule_Type;
      Diag : String)
      return String;

   Identifier_Suffixes_Rule : aliased Identifier_Suffixes_Rule_Type;

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

   --  Implicit IN mode in formal parameter specification is detected.
   --
   --  The rule does not have any parameter.
   --
   --  Should we extend this rule on generic formal objects?
   --  Should we flag implicit IN mode in function parameters?

   type Implicit_IN_Mode_Parameters_Rule_Type is new Rule_Template
     with null record;

   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);
   --  If Element is a parameter specification, checks that the mode is
   --  specified explicitly

   procedure Init_Rule (Rule : in out Implicit_IN_Mode_Parameters_Rule_Type);

   Implicit_IN_Mode_Parameters_Rule :
     aliased Implicit_IN_Mode_Parameters_Rule_Type;

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

   --  Fixed point definitions that do not have the corresponding
   --  representation clauses that define the 'Small value for a type are
   --  detected. 'Small can be defined only for ordinary fixed points, so
   --  decimal fixed point definitions are not checked.
   --
   --  The rule does not have any parameter.

   type Implicit_SMALL_For_Fixed_Point_Types_Rule_Type is new Rule_Template
     with null record;

   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);
   --  If Element is an ordinary fixed point definition, checks that there is a
   --  representation clause that defines 'Small for the fixed point type.

   procedure Init_Rule
     (Rule : in out Implicit_SMALL_For_Fixed_Point_Types_Rule_Type);

   Implicit_SMALL_For_Fixed_Point_Types_Rule :
     aliased Implicit_SMALL_For_Fixed_Point_Types_Rule_Type;

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

   --  Detects generic instantiations that are done in library package
   --  specifications (including library generic packages) and in subprogram
   --  bodies.
   --
   --  Instantiations in task and entry bodies are not flagged. Instantiations
   --  in the bodies of protected subprograms are flagged.
   --
   --  The rule does not have any parameter.
   --
   --  Rationale:
   --
   --  - If an instantiation is placed in the spec of a library (generic)
   --    package, then modification of the generic body may cause a lot of
   --    recompilations;
   --
   --  - If an instantiation is placed in a subprogram body, the instantiation
   --    is expanded each time the subprogram is called, this may result in
   --    Storage_Error;
   --
   --  - Instantiations in task and entry bodies seems to need a special rule.
   --
   --  Problems:
   --
   --     Should this rule be split into two separate rules (for subprograms
   --     and for generic packages respectively)?

   type Improperly_Located_Instantiations_Rule_Type is new Rule_Template
     with null record;

   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);
   --  If Element is an instantiation, checks if it corresponds to the
   --  requirements stated above.

   procedure Init_Rule
     (Rule : in out Improperly_Located_Instantiations_Rule_Type);

   Improperly_Located_Instantiations_Rule :
     aliased Improperly_Located_Instantiations_Rule_Type;

   ----------------------
   -- Numeric_Indexing --
   ----------------------

   --  Flag numeric literals, including those preceded by an predefined unary
   --  minus, if they are used as index expressions in array components.
   --  Literals that are subcomponents of index expressions are not flagged
   --  (other than the aforementioned case of unary minus)..
   --
   --  This rule has no parameters.

   type Numeric_Indexing_Rule_Type is new Rule_Template
     with null record;

   procedure Rule_Check_Pre_Op
     (Rule    : in out Numeric_Indexing_Rule_Type;
      Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out Rule_Traversal_State);
   --  If Element is an integer literal checks if it is used as an index
   --  expression.

   procedure Init_Rule (Rule : in out Numeric_Indexing_Rule_Type);

   Numeric_Indexing_Rule : aliased Numeric_Indexing_Rule_Type;

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

   --  Detect calls to predefined AND and OR operators for any boolean type.
   --  Calls to user-defined AND and OR operators and to operators defined by
   --  renaming declarations are not flagged. Calls to predefined AND and OR
   --  operators for modular types or boolean array types are not flagged.
   --
   --  This rule has no parameters.

   type Non_Short_Circuit_Operators_Rule_Type is new Rule_Template
     with null record;

   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);
   --  If Element is of An_And_Operator or An_Or_Operator Operator_Kind, checks
   --  if it represents a call to a predefined operator of a boolean type.

   procedure Init_Rule (Rule : in out Non_Short_Circuit_Operators_Rule_Type);

   Non_Short_Circuit_Operators_Rule :
     aliased Non_Short_Circuit_Operators_Rule_Type;

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

   --  Detect the possibility of raising of an exception then can never be
   --  handled properly. Two cases are detected.
   --
   --  - An exception declaration in a subprogram body, task body or in a block
   --    statement is flagged if the body or statement does not contain a
   --    handler for this particular exception or a handler with OTHERS choice;
   --
   --  - a raise statement in an exception handler of a subprogram body, a
   --    task body or a block statement is flagged if it (re)raises a locally
   --    declared exception (that is, if in contains a name of a locally
   --    declared exception or if it does not contain an exception name, but
   --    the enclosing handler contains a locally declared exception in its
   --    exception choices.
   --
   --  Renamings of local exceptions are not flagged
   --
   --  This rule has no parameters.
   --
   --  Rationale: This rule detect most of the cases when a program unit or
   --             a block statement can raise an exception that is not visible
   --             outside this construct and, therefore, can never be properly
   --             handled.

   type Non_Visible_Exceptions_Rule_Type is new Rule_Template with null record;

   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);
   --  If Element a defining exception name, checks if it is an
   --  exception declared in a local frame that can not be properly handled
   --  outside. If Element is of A_Raise_Statement kind, checks if it can
   --  propagate the local exception.

   procedure Init_Rule (Rule : in out Non_Visible_Exceptions_Rule_Type);

   function Has_Tip (Rule : Non_Visible_Exceptions_Rule_Type) return Boolean;

   procedure XML_Rule_Help_Tip
     (Rule  : Non_Visible_Exceptions_Rule_Type;
      Level : Natural);

   Non_Visible_Exceptions_Rule : aliased Non_Visible_Exceptions_Rule_Type;

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

   --  Any use of a numeric literal is detected except the three following
   --  cases:
   --
   --  * a literal is a subcomponet of the initialization expression in a
   --    constant declaration or a number declaration;
   --
   --  * a literal is a part of a aspect clause or an aspect definition;
   --
   --  * a literal is an integer literal that is less than or equal to a value
   --    specified by the rule parameter (if no parameter is set, this value
   --    is 1;
   --
   --  The rule may have the following parameters:
   --
   --  * For +R option:
   --
   --      N   - N is an integer literal - sets the maximal value not to detect
   --           integer literals if they are less than or equal to it
   --
   --      ALL - no exception is made when checking integer literals
   --
   --      Statements_Only - the check for numeric literals is performed only
   --           in statements (except for the case of index expressions that
   --           are checked in any context);
   --
   --  The latest specified check limit (or the fact that there is no limit at
   --  all) is used in case when more than one +R option are used. -R option
   --  for this rule does not have any parameter, it turns the rule off and
   --  resets the default rule mode (all the literals except integer literals
   --  0 and 1 are checked in any context)

   type Numeric_Literals_Rule_Type is new Rule_Template with record
     Up_To           : Integer := 1;
     Statements_Only : Boolean := False;
   end record;

   overriding function Annotate_Rule
     (Rule : Numeric_Literals_Rule_Type;
      Var  : Diagnosis_Variant := 0)
      return String;
   --  Returns the rule annotation with the parameters specified for the rule.

   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);
   --  If Element is a numeric literal checks if it is to be detected according
   --  to the rules specified above.

   procedure Init_Rule (Rule : in out Numeric_Literals_Rule_Type);

   procedure Process_Rule_Parameter
     (Rule       : in out Numeric_Literals_Rule_Type;
      Param      :        String;
      Enable     :        Boolean;
      Defined_At : String);
   --  Process the Param string according to the parameter structure described
   --  above
   --  ??? Defined_At ???

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

   Numeric_Literals_Rule : aliased Numeric_Literals_Rule_Type;

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

   --  Detect use of OTHERS choice in extension record and array aggregates.
   --  For record and array aggregates, use of OTHERS is not detected if its
   --  used to refer to all or to all but one components of the aggregate.

   --  If, in case of a named array aggregate, there are two associations, one
   --  with OTHERS choice, and another with a discrete range, the OTHERS choice
   --  is flagged even if this discrete range specifies exactly one component
   --  (for example, (1 .. 1 => 0, others => 1) )
   --
   --  This rule has no parameters.
   --
   --  The original enhancement request says nothing about extension
   --  aggregates - to be discussed???

   type OTHERS_In_Aggregates_Rule_Type is new Rule_Template
     with null record;

   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);
   --  If Element is an OTHERS choice from an aggregate component association,
   --  checks if this association represents all or all but one components.

   procedure Init_Rule (Rule : in out OTHERS_In_Aggregates_Rule_Type);

   OTHERS_In_Aggregates_Rule : aliased OTHERS_In_Aggregates_Rule_Type;

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

   --  Detect use of OTHERS choice in a case statement.
   --
   --  This rule has no parameters.
   --
   --  The original enhancement request says nothing about any exception to
   --  this rule. But in some cases OTHERS may make sense, for example when
   --  the range of the case control expression subtype is too big (for
   --  example, Integer or Wide_Character). Should we have a parameter that
   --  somehow controls the exceptions to the rule ???

   type OTHERS_In_CASE_Statements_Rule_Type is new Rule_Template
     with null record;

   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);
   --  Checks if Element is an OTHERS choice from a case statement path.

   procedure Init_Rule (Rule : in out OTHERS_In_CASE_Statements_Rule_Type);

   OTHERS_In_CASE_Statements_Rule :
     aliased OTHERS_In_CASE_Statements_Rule_Type;

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

   --  Detect use of OTHERS choice in exception handler.
   --
   --  This rule has no parameters.
   --
   --  Problems:
   --
   --     Should we combine all the rules about the OTHERS choice into a single
   --     parametrized rule?

   type OTHERS_In_Exception_Handlers_Rule_Type is new Rule_Template
     with null record;

   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);
   --  Checks if Element is an OTHERS choice from an exception handler

   procedure Init_Rule (Rule : in out OTHERS_In_Exception_Handlers_Rule_Type);

   OTHERS_In_Exception_Handlers_Rule :
     aliased OTHERS_In_Exception_Handlers_Rule_Type;

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

   --  A control structure having the nested level more than N is detected, By
   --  default N is equal to four, it can be specified by the rule parameter.
   --  A control structure is any of the following operators:
   --     IF statement
   --     CASE statement
   --     LOOP statement
   --     selective accept statement
   --     timed entry call statement
   --     conditional entry call
   --     asynchronous select statement
   --
   --  The rule has the following parameters:
   --
   --  * for +R option:
   --
   --     N - positive integer specifying the maximal control structure nesting
   --         level that is not flagged
   --
   --  The parameter of +R option is mandatory, if it is not specified or if it
   --  is not a positive integer, the '+R" option is ignored.
   --
   --  If more than one  option is specified for the gnatcheck call, a new
   --  option and a new parameter override the previous one(s).
   --
   --  Note that this rule is something in common with the GNAT style
   --  -gnatyLnnn options, but the details of checking construct nesting level
   --  are different

   type Overly_Nested_Control_Structures_Rule_Type is new
     One_Integer_Parameter_Rule_Template with null record;

   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);
   --  If Element is a control structure from the list given above, checks if
   --  it nesting level is not greater than specified for the rule.

   procedure Init_Rule
     (Rule : in out Overly_Nested_Control_Structures_Rule_Type);

   Overly_Nested_Control_Structures_Rule :
     aliased Overly_Nested_Control_Structures_Rule_Type;

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

   --  Detects subprogram and entry declarations where the formal parameters
   --  are not properly ordered. The proper order is the following:
   --
   --  * IN parameters first, then IN OUT parameters, and then OUT parameters;
   --
   --  * for IN parameters, parameters with default initialization expressions
   --    do last
   --
   --  Only the first violation of the described order is flagged.
   --
   --  The following constructs are checked:
   --     subprogram declarations (including null procedures)
   --     generic subprogram declarations
   --     formal subprogram declarations
   --     entry declarations
   --     subprogram bodies and subprogram body stubs if they work as specs
   --
   --  Subprogram renamings are not checked.
   --
   --  The rule does not have any parameter.
   --
   --  This rule is directly derived from the gnatcheck enhancement request
   --  (F323-030). The following things may require additional discussion and
   --  possible changes in gnatcheck:
   --
   --  - This particular order IN - IN OUT - OUT does not have any obvious
   --    advantages before other ways of mode ordering. May be, it would make
   --    sense to have a parameter that sets a particular order to check.
   --
   --  - We may want to check parameter mode ordering and ordering of the
   --    parameters with default expressions separately, and this may require
   --    splitting this rule into two rules.

   type Parameters_Out_Of_Order_Rule_Type is new Rule_Template
     with null record;

   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);
   --  ??? To be provided after clarifying the corresponding enhancement
   --  request.

   procedure Init_Rule (Rule : in out Parameters_Out_Of_Order_Rule_Type);

   Parameters_Out_Of_Order_Rule : aliased Parameters_Out_Of_Order_Rule_Type;

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

   --  Detect generic actual parameters that pass a value to a formal object or
   --  to a formal subprogram that has a default initialization if this
   --  parameter is in positional association form
   --
   --  The rule does not have any parameter.

   type Positional_Actuals_For_Defaulted_Generic_Parameters_Rule_Type is
     new Rule_Template with null record;

   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);
   --  If Element is positional generic parameter association, checks if the
   --  corresponding generic formal parameter has a default initialization

   procedure Init_Rule (Rule : in out
     Positional_Actuals_For_Defaulted_Generic_Parameters_Rule_Type);

   Positional_Actuals_For_Defaulted_Generic_Parameters_Rule :
     aliased Positional_Actuals_For_Defaulted_Generic_Parameters_Rule_Type;

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

   --  Detect actual subprogram or entry call parameters that pass a value to
   --  a formal parameter that has a default expression if this parameter is
   --  in positional association form.
   --
   --  The rule does not have any parameter.

   type Positional_Actuals_For_Defaulted_Parameters_Rule_Type is new
     Rule_Template with null record;

   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);
   --  If Element is positional parameter association, checks if the
   --  corresponding formal parameter has a default initialization

   procedure Init_Rule
     (Rule : in out Positional_Actuals_For_Defaulted_Parameters_Rule_Type);

   Positional_Actuals_For_Defaulted_Parameters_Rule :
     aliased Positional_Actuals_For_Defaulted_Parameters_Rule_Type;

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

   --  An (array, record or extension) aggregate that has a positional
   --  association should be detected.
   --
   --  The rule does not have any parameter.

   type Positional_Components_Rule_Type is new Rule_Template with null record;

   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);
   --  If Element is an aggregate, checks if its first association is a
   --  positional one. The rule is checked for an aggregate, but not for a
   --  component association to get the proper source location and to avoid
   --  multiple diagnosis for the same aggregate in case if it contains more
   --  then one positional association

   procedure Init_Rule
     (Rule : in out Positional_Components_Rule_Type);

   Positional_Components_Rule :
     aliased Positional_Components_Rule_Type;

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

   --  A positional generic parameter associations should be detected.
   --
   --  The rule does not have any parameter.

   type Positional_Generic_Parameters_Rule_Type is new Rule_Template
     with null record;

   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);
   --  If Element is of A_Generic_Association kind, checks if the named
   --  notation is used for it.

   procedure Init_Rule
     (Rule : in out Positional_Generic_Parameters_Rule_Type);

   Positional_Generic_Parameters_Rule :
     aliased Positional_Generic_Parameters_Rule_Type;

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

   --  A subprogram or entry call positional parameter associations should be
   --  detected, except the following situations:
   --
   --  * parameters of a call to an operator function are not flagged;
   --
   --  * parameters of a call to attribute subprograms are not flagged;
   --
   --  * if the called subprogram or entry has only one formal parameter, the
   --    actual parameter in the call is not flagged;
   --
   --  * if a subprogram call uses a prefixed view of the called subprogram,
   --    then the first parameter of the call (that makes up a prefix in the
   --    prefixed view) is not flagged. If the called subprogram has two
   --    parameters, its second parameter also is not flagged.
   --
   --  This rule has the following (optional) parameters for the `+R' option:
   --
   --   All - if this parameter is specified, all the positional parameter
   --         associations that can be replaced with named associations
   --         according to language rules are flagged.

   type Positional_Parameters_Rule_Type is new
     Rule_With_Exceptions_Template (1) with null record;

   overriding procedure Activate_In_Test_Mode
     (Rule : in out Positional_Parameters_Rule_Type);
   --  Activates the rule with All parameter.

   overriding function Exception_Name
     (Rule      : Positional_Parameters_Rule_Type;
      Exc_Index : Exception_Index)
      return      String;

   overriding function Exception_Number
     (Rule     : Positional_Parameters_Rule_Type;
      Exc_Name : String)
      return     Exception_Numbers;

   overriding 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);
   --  If Element is of A_Parameter_Association kind, checks if the named
   --  notation is used for it.

   overriding procedure Init_Rule
     (Rule : in out Positional_Parameters_Rule_Type);

   Positional_Parameters_Rule :
     aliased Positional_Parameters_Rule_Type;

   -------------------------------
   --  Predefined_Numeric_Types --
   -------------------------------

   --  Any explicit use of any name of a predefined numeric type or subtype
   --  defined in package Standard is detected.
   --
   --  The rule does not have any parameter.
   --
   --  The idea of this rule is to detect the situations when the behavior of
   --  the program may depend on platform-specific characteristics of the
   --  implementation of the predefined numeric types. Note, that this rule
   --  is over-pessimistic for this purpose: for example, a program that
   --  would like to do string indexing most probably needs a variable of
   --  an Integer type or of a subtype of integer type. Another example is
   --  the situation when predefined numeric types are used with explicit
   --  constraints:
   --
   --     subtype My_Integer is Integer range Left .. Right;
   --     My_Var : My_Integer;
   --
   --  Note also, that this rule detects only numeric types and subtypes
   --  defined in Standard. The use of numeric types and subtypes defined in
   --  other predefined packages (such as System.Any_Priority or
   --  Ada.Text_IO.Count) is not detected

   type Predefined_Numeric_Types_Rule_Type is new Rule_Template with
     null record;

   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);
   --  If Element is of An_Identifier kind, checks if it is a reference to a
   --  predefined numeric (sub)type defined in Standard

   procedure Init_Rule (Rule : in out Predefined_Numeric_Types_Rule_Type);

   Predefined_Numeric_Types_Rule : aliased Predefined_Numeric_Types_Rule_Type;

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

   --  For any program unit declared in a library package or in a generic
   --  library package, checks if an exception that is explicitly raised by the
   --  program unit, is either a predefined exception or an exception that is
   --  also declared (or renamed) in the visible part of this package.
   --
   --  This rule has no parameters.
   --
   --  Rationale: this rule ensures that if some unit "withes" a package or
   --             instantiates a generic package, it already has access to all
   --             the exceptions that can be raised by anything that contains
   --             in the package without "withing" any other package.
   --
   --  Problems:
   --
   --  - the current implementation also checks raise statements from the
   --    statement sequence of the package body (and from the statement
   --    sequences of the bodies of the enclosed packages), if any.

   type Raising_External_Exceptions_Rule_Type is new Rule_Template with
     null record;

   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);
   --  If Element is a raise statement, and if the enclosing unit is a package,
   --  a generic package or a body thereof, checks if the raised exception is
   --  either a predefined exception or that it is defined in the visible
   --  part of the package

   procedure Init_Rule (Rule : in out Raising_External_Exceptions_Rule_Type);

   Raising_External_Exceptions_Rule :
     aliased Raising_External_Exceptions_Rule_Type;

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

   --  Raising of the predefined exceptions should be detected The predefined
   --  exceptions are: Constraint_Error, Numeric_Error, Program_Error,
   --  Storage_Error, Tasking_Error.
   --
   --  The rule does not have any parameter.

   type Raising_Predefined_Exceptions_Rule_Type is new Rule_Template
     with null record;

   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);
   --  If Element is a raise statement, checks if the raised exception is
   --  any of the predefined exceptions.

   procedure Init_Rule (Rule : in out Raising_Predefined_Exceptions_Rule_Type);

   Raising_Predefined_Exceptions_Rule :
     aliased Raising_Predefined_Exceptions_Rule_Type;

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

   --  Detects procedure bodies that do not assign values to OUT parameters.
   --  A procedure body is flagged if the code of this body (excluding body
   --  exception handlers, if any) does not contain statements that set value
   --  for any OUT parameter. An exception handler in a procedure body is
   --  flagged if it does not contain statements that set value for any OUT
   --  parameter or a RAISE statement. Bodies of generic procedures are also
   --  considered.
   --
   --  Only two ways of setting a value to an OUT parameter are considered:
   --
   --  * an assignment statement (the parameter is in the left part);
   --
   --  * passing as an actual for OUT or IN OUT (???) parameter
   --
   --  If any component of an OUT parameter gets a value, we consider that a
   --  whole parameter gets a value.
   --
   --  The rule does not have any parameter.

   type Unassigned_OUT_Parameters_Rule_Type is new Rule_Template
     with null record;

   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);
   --  If Element is a procedure body or an exception handler from a procedure
   --  body, implements the check described above.

   procedure Init_Rule (Rule : in out Unassigned_OUT_Parameters_Rule_Type);

   Unassigned_OUT_Parameters_Rule :
     aliased Unassigned_OUT_Parameters_Rule_Type;

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

   --  Checks if the BEGIN keyword in package body is marked by the trailing
   --  comment containing the package name. BEGIN is not flagged if the package
   --  body does not contain any declaration.
   --
   --  The case when the BEGIN keyword is placed not on a separate line, but
   --  on the same line with the last declaration or the first statement is
   --  flagged undependently on the  fact if the line contains a trailing
   --  comment, the diagnostic message is attached to the line containing the
   --  first statement
   --
   --  The rule does not have any parameter.

   type Uncommented_BEGIN_In_Package_Bodies_Rule_Type is new Rule_Template
     with null record;

   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);
   --  If Element is a package body, checks if it contains the BEGIN keyword,
   --  and if it does, checks if it is marked by a trailing comment with the
   --  package name.

   procedure Init_Rule
     (Rule : in out Uncommented_BEGIN_In_Package_Bodies_Rule_Type);

   Uncommented_BEGIN_In_Package_Bodies_Rule :
     aliased Uncommented_BEGIN_In_Package_Bodies_Rule_Type;

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

   --  Non-named block statements are detected. Non-named nested loop
   --  statements are detected (both enclosing and enclosed non-named loop
   --  statements are flagged).
   --
   --  The rule does not have any parameter.

   type Unnamed_Blocks_And_Loops_Rule_Type is new Rule_Template
     with null record;

   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);
   --  If Element is a block statement, checks if in contains a statement
   --  identifier If Element is a loop statement, checks if it is enclosed by
   --  or itself encloses another loop statement, and if it is, checks if it
   --  contains a statement identifier.

   procedure Init_Rule (Rule : in out Unnamed_Blocks_And_Loops_Rule_Type);

   Unnamed_Blocks_And_Loops_Rule :
     aliased Unnamed_Blocks_And_Loops_Rule_Type;

end Gnatcheck.Rules.Custom_1;