------------------------------------------------------------------------------
--                                                                          --
--                            GCH COMPONENTS                                --
--                                                                          --
--                          G C H . R U L E S                               --
--                                                                          --
--                              S p e c                                     --
--                                                                          --
--                                                                          --
--              Copyright (c) 1999, Vitali Sh.Kaufman.                      --
--                                                                          --
--  Gch is distributed as free software; that is with full sources          --
--  and 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. You can freely copy, modify and redistribute  --
--  this software, provided that full sources are available for the version --
--  being distribute (original and modified), and for a modified version,   --
--  any changes that you have made are clearly indicated.                   --
--                                                                          --
--  Gch was developed by Vitali Sh. Kaufman using a prototype               --
--  and consultations by Sergey I. Rybin.                                   --
------------------------------------------------------------------------------

--  This package defines the rules to be checked by Gch and a top-level
--  data structure used for rule checking process.

--  ???
with Ada.Wide_Text_IO;        use Ada.Wide_Text_IO;

with Asis;                    use Asis;

with GNAT.OS_Lib;             use GNAT.OS_Lib;

with Gch.Options;         use Gch.Options;
with Gch.Globals;         use Gch.Globals;

package Gch.Rules is

   ------------------------------
   --  Rule checking functions --
   ------------------------------

--  The specs for all the functions checking particular rules should go here.
--  Rules could be "local" or "global" depending of wheither they need to
--  collect some information about the unit as a whole or not.

--  Local rules could be checked by a rule checking function
--  that is called as an pre-operation by Check_Unit_Elements,
--  an instantiation of Traverse_Unit.
--  Each global rule needs also a finalization part of rule checking function.

--  A rule "Use  named  parameter association in calls of infrequently
--  used subprograms or entries with many formal parameters" can serve as
--  an example of such global (non local) kind of rules.
--  It is impossible to recognize the violations before the whole unit
--  is checked.
--  All diagnostics of such global rules should be collected inside them until
--  a finalization part of the rule.
--
--  Array Rules contains references to all rule checking functions and a
--  Global flag that marks checking functions of global rules.

--  So, for now we have not use post-operations while traversing elements.
--  It is unclear how often they could be really useful. That is why we prefer
--  to use post-operations (finalization part of rule checking functions)
--  just for units, not for elements.
--  The decision could be change if future rule implementation analysis show
--  that element post-operations are preferable.

--  From an other side, a post-check of a single element could lead to
--  finding of several violations for several different elements. That is why
--  some potential violation buffers could be created to store such potential
--  violations before usage by such kind post-checks.

--  The specs could be removed to minimize changes needed for the rule
--  set modification but an assignment should be used instead
--  of initialization.

--  These specifications could be also used as an convenient location of
--  the rule switching comments (now they are below at Rules array
--  initialization).

   function QS_5_1_1_1 (E : Element) return Boolean;
   function QS_5_1_1_2 (E : Element) return Boolean;
   function QS_5_2_2 (E : Element) return Boolean;
   function QS_4_3_1_10 (E : Element) return Boolean;
   function QS_4_3_1_11 (E : Element) return Boolean;
   function Rule_0 (E : Element) return Boolean;
   function Rule_1 (E : Element) return Boolean;

   type Rule_Access is access function (E : Element) return Boolean;
   --  This type is used to point to rule checking routines for individual
   --  rules. A rule checking routine is a function which takes an Element
   --  and returnes True iF the rule to check is either obeyed or non
   --  applicable for an argument Element. Any exception raised in a rule
   --  checking routine should propagate out from the routine.

   type Rule_Record is record
      Diagnosis : String_Access;
      --  The diagnostic message to be generated in case of rule violation.
      Rule_Name  : String_Access;
      --  Short description (name, if possible) of the rule
      On : Boolean := True;
      --  If the rule is on; is set using rules.ini
      Global : Boolean := False;
      --  If the rule checking needs finalization
      Rule_To_Check : Rule_Access;
      --  The rule checking function
   end record;

   type Rule_Array is array (Positive range <>) of Rule_Record;

   --  The Rules array below defines a set of rules to be checked by Gch.
   --  To modify an existing rule, correct the body of the corresponding rule
   --  checking subunit. To remove a check for a given
   --  rule, use the file rules.ini.
   --  To add a check for a new rule, add the corresponding rule
   --  function, add the corresponding value (that is, the aggregate of
   --  Rule_Record type containing the reference to this function and the
   --  corresponding diagnosis) to the following initialization aggregate
   --  for Rules, and edit rules.ini in an appropriate way.

   --  Extension note : Diagnosis field could be extended if we need more
   --  detailed diagnostics connected to some rules

   --  Caution: don't use the following aggregate to enable/disable rules.
   --  Use the file rules.ini for that.

   Rules : Rule_Array := (

--  + Replacing the plus by minus and back switches the following rule
      (Diagnosis  => new String' ("unnamed nested loop"),
       Rule_Name  => new String' ("Q&S 5.1.1(1)"),
       On => True,
       Global => False,
       Rule_To_Check => QS_5_1_1_1'Access),

--  + Replacing the plus by minus and back switches the following rule
      (Diagnosis  => new String' ("exit inside unnamed loop"),
       Rule_Name  => new String' ("Q&S 5.1.1(2)"),
       On => True,
       Global => False,
       Rule_To_Check => QS_5_1_1_2'Access),

--  + Replacing the plus by minus and back switches the following rule
      (Diagnosis  => new String' ("named parameter association recommended"),
       Rule_Name  => new String' ("Q&S 5.2.2"),
       On => True,
       Global => True, --  the rule needs finalization
       Rule_To_Check => QS_5_2_2'Access),

--  + Replacing the plus by minus and back switches the following rule
      (Diagnosis  => new String' ("explicitly raised predefined exception"),
       Rule_Name  => new String' ("Q&S 4.3.1(10)"),
       On => True,
       Global => False,
       Rule_To_Check => QS_4_3_1_10'Access),

--  + Replacing the plus by minus and back switches the following rule
      (Rule_To_Check => QS_4_3_1_11'Access,
       Global => False,
       Rule_Name  => new String' ("Q&S 4.3.1(11)"),
       On => True,
       Diagnosis  => new String' ("risk of propagation beyond scope")),

--  - Replacing the plus by minus and back switches the following rule
      (Diagnosis  => new String' ("redundant 'in'"),
       Rule_Name  => new String' ("Rule_0"),
       On => True,
       Global => False,
       Rule_To_Check => Rule_0'Access),

--  + Replacing the plus by minus and back switches the following rule
      (Diagnosis  => new String' ("multi-identifier declaration"),
       Rule_Name  => new String' ("Rule_1"),
       On => True,
       Global => False,
       Rule_To_Check => Rule_1'Access)

      );  -- end of Rules array initialization

   -------------------------
   --  List of Violations --
   -------------------------

   subtype Rule_Index is Positive range Rules'Range;
   Current_Rule : Rule_Index;
   --  used to store a checking rule index (to avoid additional
   --  parameters of rule checking functions

   type Rule_Violation_Node;
   --  to form a rule violation list Diagnostics defined below

   type Rule_Violation_Node_Access is access Rule_Violation_Node;

   type Rule_Violation_Node is record

      Bad_Element : Element;
      --  A source of violation, an ASIS Element where the violation is found

      Violated_Rule  : Rule_Index;
      --  Index of violated rule in the Rules array

      Next_Node : Rule_Violation_Node_Access;
      --  A reference to next node in a list

   end record;

   Diagnostics : Rule_Violation_Node_Access;
   --  A list of violations found by Gch

   Last_Diagnosis : Rule_Violation_Node_Access;
   --  End of the list of violations found by Gch

   procedure Add_Violation (Elem : Element; Rule : Rule_Index);
   --  Adds a new violation found into Diagnostics list and
   --  changes global statistics.

private
--  contains common "private" objects for rule checking procedures
--  and also specific "private" objects for some (often global) rules
--  that are impossible to place into appropriate rule checking subunits

   package Int_IO is new Integer_IO (Integer);
   use Int_IO;
   package Nat_IO is new Integer_IO (Natural);
   use Nat_IO;

--   ---------------------------
--   --  Report_ASIS_Failure  --
--   ---------------------------

   procedure Report_ASIS_Failure (Rule : Wide_String := "");
   --  Should be called when an ASIS exception is caught in a rule checking
   --  procedure. Repots ASIS Error Status and ASIS Diagnosis. Rule should
   --  be used as some indication of the rule which check fails (if the
   --  (default) null string is used as an actual for the Rule parameter,
   --  the produced output does not mention the rule causing this failure).
   --
   --  This procedure resets the ASIS diagnosis to an empty string and it
   --  resets ASIS Status to Not_An_Error

   -----------------------------
   -- Simple_Traverse_Element --
   -----------------------------
--  It is a partial instantiation of generic Traverse_Element procedure from
--  Asis.Iterator. It allows just a single pre- Operation instead of two pre-
--  and post- operations of Traverse_Element. It seems convenient to have
--  such simplified procedure since very offen we need not any post operation
--  at all.

--  We placed the procedure inside the private part since we intend to use it
--  just for rule checking.

--  Element             - Specifies the initial element in the traversal
--  Control             - Specifies what next to do with the traversal
--  State_Information   - Specifies other information for the traversal
--
--  Traverses the element and all its component elements, if any.
--  Component elements are all elements that can be obtained by a combination
--  of the ASIS structural queries appropriate for the given element.
--
--  If an element has one or more component elements, each is called a child
--  element.  An element's parent element is its Enclosing_Element.  Children
--  with the same parent are sibling elements.  The type Traverse_Control uses
--  the terms children and siblings to control the traverse.
--
--  For each element, the formal procedure Operation is called when first
--  visiting the element.
--
--  The order of Element traversal is in terms of the textual representation of
--  the Elements.  Elements are traversed in left-to-right and
--  top-to-bottom order.
--
--  Look for more information at Asis.Iterator.Traverse_Element.

   generic

      type State_Information is limited private;

      with procedure Operation
                       (Element : in     Asis.Element;
                        Control : in out Traverse_Control;
                        State   : in out State_Information) is <>;

   procedure Simple_Traverse_Element
     (Element : in     Asis.Element;
      Control : in out Traverse_Control;
      State   : in out State_Information);

   -------------------------
   -- Objects of QS_5_2_2 --
   -------------------------

   --  As a rule to check we use the following:
   --  "Use  named  parameter association in calls of infrequently
   --  used subprograms or entries with many formal parameters".

   --  We use some parameters that clarifies the rule meaning.
   --  They are placed into the Gch.Options for some reasons
   --  that are not essential now. They could be relocated for simplicity.
   --  Renaming of these parameters are placed below.

      Infrequently : Positive renames Gch.Options.Infrequently_Used_Subprograms;
      --  Meaning of "infrequently used"

      Many : Positive renames Gch.Options.Many_Formal_Parameters;
      --  Meaning of "many formal parameters"

      Seldom : Positive renames
               Gch.Options.Lines_Between_Infrequently_Used_Calls;
      --  not used yet; A different meaning of "infrequently used"

   --  We need also some variables that collect information during calls
   --  of the rule checking routine for different elements.
   --  They should be out of the routine to serve its different calls.
   --  That is why they are placed below.

      type Calls is array (1 .. Infrequently) of Element;
      --  To collect calls before to recognize a violation

      --  List of subprograms that have many formal parameters,
      --  have some not named parameter association and could be
      --  "infrequently used"
      type Subpr;
      type Subpr_Access is access Subpr;
      type Subpr is record
         Sub : Element;  -- a subprogram
         Bad_Calls : Calls; -- calls of the subprogram
         Amount_Calls : Positive range Calls'Range; -- amount of calls
         Bad_Subpr : Boolean;
         Next : Subpr_Access;
      end record;
      Subprs : Subpr_Access;
      Last_Subpr : Subpr_Access;

      Current_Subpr : Subpr_Access;
      --  serves as a common variable of some local procedure
      --  Stores a reference to a current subprogram record

      Waiting : Boolean := False;
      --  Is some diagnostics to analyse while traversing an unit?
   ------------------------------
   -- end of QS_5_2_2  objects --
   ------------------------------
end Gch.Rules;