------------------------------------------------------------------------------
--                                                                          --
--                          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-2007, AdaCore                     --
--                                                                          --
-- GNATCHECK  is  free  software;  you can redistribute it and/or modify it --
-- under terms of the  GNU  General Public License as published by the Free --
-- Software Foundation;  either version 2, or ( at your option)  any  later --
-- version.  GNATCHECK  is  distributed in the hope that it will be useful, --
-- but  WITHOUT  ANY  WARRANTY;   without  even  the  implied  warranty  of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
-- Public License for more details.  You should have received a copy of the --
-- GNU  General Public License distributed with GNAT; see file  COPYING. If --
-- not,  write to the  Free Software Foundation,  51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA.                                       --
--                                                                          --
-- GNATCHECK is maintained by AdaCore (http://www.adacore.com).             --
--                                                                          --
------------------------------------------------------------------------------

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

package Gnatcheck.Rules.Custom_1 is

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

   --  Definitions of anonymous array types in the object declarations shoud
   --  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 fom 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 handlen in the same same
   --  subprogram body. Raise statements that are part of exception handlers
   --  are not flagged. Rase 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 statementm 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_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 pargma 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 pargma
   --                    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         - cleas 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 correspondong parameter
   --  is ignored.
   --
   --  When more then one parameter is given in the same rule option, the
   --  parameters shuoul be are separated by a comma.
   --
   --  If more then 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;

   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);
   --  Process the Param string according to the parameter structure described
   --  above

   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 fucntion, 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 supbrograms 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;

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

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

   --  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
   --    * constant declarations (but not number declarations)
   --    * package renaming declarations (but not generic package renaming
   --      declarations
   --
   --  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'
   --
   --  In case of a private or incomplete type declarations the following
   --  checks are made for defining name suffix:
   --
   --  * for an incomplete type declaration: if the corresponding full type
   --    declaration is available, the defining identifier from the full type
   --    declaration is checked, but the defining identifier from the
   --    incomplete type declaration is not; otherwise the defining identifier
   --    from the incomplete type declaration is checked against the suffix
   --    specified for type declarations;
   --
   --  * 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.
   --
   --  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
   --
   --      Constant_Suffix=string -  specifies the suffix for a constant name
   --
   --      Renaming_Suffix=string -  specifies the suffix for package renaming
   --                                name
   --  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
   --                               oedinary type names.
   --
   --      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.
   --
   --  If more then one parameter is used, parameters should be separated by
   --  comma.
   --
   --  If more then one  option is specified for the gnatcheck call, a new
   --  option overrides the previous one(s).
   --
   --  +RMisnamed_Identifiers option (with no parameter) enables all the
   --  check for all the name suffixes specified by previous options used for
   --  this rule.
   --  -RMisnamed_Identifiers 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). 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 Misnamed_Identifiers_Rule_Type is new Rule_Template with record
      Type_Suffix     : String_Access;
      Access_Suffix   : String_Access;
      Constant_Suffix : String_Access;
      Renaming_Suffix : String_Access;
   end record;

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

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

   procedure Set_Rule_Defaults
     (Rule : in out Misnamed_Identifiers_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.

   Misnamed_Identifiers_Rule : aliased Misnamed_Identifiers_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 modylar 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 shoice;
   --
   --  - 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 localy declared exception in its
   --    exception choices.
   --
   --  Renamings of local exceptions are not flagged
   --
   --  This rule has no parameters.
   --
   --  Rationale: This rule detect most pf 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);

   Non_Visible_Exceptions_Rule : aliased Non_Visible_Exceptions_Rule_Type;

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

   --  Any use of a numeric literal is detected except the two followin cases:
   --
   --  * a literal is a subcomponet of the initialization expression in a
   --    constant declaration or a number declaration;
   --
   --  * a literal is an integer literal that is less than or equal to a value
   --    specificed by the rule parameter (if no parameter is set, this value
   --    is 1 (except the case when it is an index expression)
   --
   --  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 then or equal to it
   --
   --      ALL - no exception is made when checking integer literals
   --
   --  The latest specified check limit (or the fact that there is no limit at
   --  all) is used in case when more then one +R option are used. -R option
   --  for this rule does not have any parameter, it turns the rule off, but it
   --  keeps the latest specified value up to that integer literals should not
   --  be flagged. If +R option is used after that, this value is used for the
   --  check.
   --
   --  (What about literals in representation clauses? Default expressions? The
   --  rule may need some ramification.)

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

   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 specificed 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);
   --  Process the Param string according to the parameter structure described
   --  above

   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 disctere 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
   --  aggregares - 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 accosiation,
   --  checks if this accosiation 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 then 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 may have the following parameter for +R option:
   --
   --     N - positive integer specifying the maximal control structure nesting
   --         level that is not flagged
   --
   --  If the parameter of +R option is not a positive integer, the parameter
   --  is ignored and the rule is turned ON with the latest specified
   --  non-flagge nesting level.
   --
   --  If more then one  option is specified for the gnatcheck call, a new
   --  option and a new parameter override the previous one(s).
   --
   --  +R option with no parameter turns the rule ON using the maximal
   --  non-flagged nesting level specified by the latest processing +R option
   --  with parameter.
   --
   --  Note that this rule is something in common with the GNAT style
   --  -gnatyLnnn options, but the details of checkung consruct nesting level
   --  are different

   type Overly_Nested_Control_Structures_Rule_Type is new Rule_Template with
      record
         Max_Nesting_Level : Positive;
      end 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 then specified for the rule.

   procedure Init_Rule
     (Rule : in out Overly_Nested_Control_Structures_Rule_Type);

   procedure Process_Rule_Parameter
     (Rule    : in out Overly_Nested_Control_Structures_Rule_Type;
      Param   :        String;
      Enable  :        Boolean);
   --  Process the rule parameter

   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 paremeter 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 paremeter 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;
   --
   --  * 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 maked up a prefix in the
   --    prefixed view) is not flagged. If the called subprogram has two
   --    parameters, its second parameter also is not flagged.
   --
   --  The rule does not have any parameter.

   type Positional_Parameters_Rule_Type is new Rule_Template with null record;

   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.

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

   --  Rasing 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
   --  handled if it does not contain statements that set value for any OUT
   --  parameter. 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
   --  boidy, 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 trailng
   --  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 enlosed 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;
