diff --git a/Makefile b/Makefile index 9dff59ab9..6db740c65 100644 --- a/Makefile +++ b/Makefile @@ -34,6 +34,7 @@ lkql: build/bin/liblkqllang_parse doc: build_lkql_native_jit cd user_manual && make clean html + cd lkql_checker/doc && make generate html-all gnatcheck: lkql gprbuild -P lkql_checker/gnatcheck.gpr -p $(GPR_ARGS) -XBUILD_MODE=$(BUILD_MODE) diff --git a/lkql_checker/doc/Makefile b/lkql_checker/doc/Makefile index e941d7975..68320e2bc 100644 --- a/lkql_checker/doc/Makefile +++ b/lkql_checker/doc/Makefile @@ -42,6 +42,9 @@ help: clean: -rm -rf $(BUILDDIR) +generate: + lkql doc-rules -O generated $(SOURCEDIR)/../share/lkql $(SOURCEDIR)/stubs + %.html: $(SPHINXBUILD) -b html $(ALLSPHINXOPTS) $(BUILDDIR)/$*/html diff --git a/lkql_checker/doc/gnatcheck_rm/list_of_rules.rst b/lkql_checker/doc/generated/list_of_rules.rst similarity index 100% rename from lkql_checker/doc/gnatcheck_rm/list_of_rules.rst rename to lkql_checker/doc/generated/list_of_rules.rst index 8f44b688d..af0466ffa 100644 --- a/lkql_checker/doc/gnatcheck_rm/list_of_rules.rst +++ b/lkql_checker/doc/generated/list_of_rules.rst @@ -55,8 +55,8 @@ GNATcheck rules. * :ref:`Exception_Propagation_From_Export` * :ref:`Exception_Propagation_From_Tasks` * :ref:`Exceptions_As_Control_Flow` -* :ref:`Exits_From_Conditional_Loops` * :ref:`EXIT_Statements_With_No_Loop_Name` +* :ref:`Exits_From_Conditional_Loops` * :ref:`Expanded_Loop_Exit_Names` * :ref:`Explicit_Full_Discrete_Ranges` * :ref:`Explicit_Inlining` @@ -112,12 +112,12 @@ GNATcheck rules. * :ref:`Non_Component_In_Barriers` * :ref:`Non_Constant_Overlays` * :ref:`Non_Qualified_Aggregates` -* :ref:`Nonoverlay_Address_Specifications` * :ref:`Non_Short_Circuit_Operators` * :ref:`Non_SPARK_Attributes` * :ref:`Non_Tagged_Derived_Types` -* :ref:`Not_Imported_Overlays` * :ref:`Non_Visible_Exceptions` +* :ref:`Nonoverlay_Address_Specifications` +* :ref:`Not_Imported_Overlays` * :ref:`Null_Paths` * :ref:`Number_Declarations` * :ref:`Numeric_Format` diff --git a/lkql_checker/doc/gnatcheck_rm/predefined_rules.rst b/lkql_checker/doc/generated/predefined_rules.rst similarity index 94% rename from lkql_checker/doc/gnatcheck_rm/predefined_rules.rst rename to lkql_checker/doc/generated/predefined_rules.rst index e1df6860d..f8b7120c2 100644 --- a/lkql_checker/doc/gnatcheck_rm/predefined_rules.rst +++ b/lkql_checker/doc/generated/predefined_rules.rst @@ -18,6 +18,8 @@ with one another. Proper usage of gnatcheck involves selecting the rules you wish to apply by looking at your independently developed coding standards and finding the corresponding gnatcheck rules. +Unless documentation is specifying some, rules don't have any parameters. + If not otherwise specified, a rule does not do any check for the results of generic instantiations. @@ -96,10 +98,10 @@ GNATcheck's predefined rules' parameters may have the following types: -Style-Related Rules -=================== +``Style-Related Rules`` +======================= -.. index:: Style-related rules +.. index:: Style-Related_Rules The rules in this section may be used to enforce various feature usages consistent with good software engineering, for example @@ -109,10 +111,10 @@ as described in Ada 95 Quality and Style. .. _Tasking: -Tasking -------- +``Tasking`` +----------- -.. index:: Tasking-related rules +.. index:: Tasking-related_rules The rules in this subsection may be used to enforce various feature usages related to concurrency. @@ -132,8 +134,6 @@ Diagnostic messages are generated for all the entry declarations except the first one. An entry family is counted as one entry. Entries from the private part of the protected definition are also checked. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -165,8 +165,6 @@ is applied to the object or to its type, if the object is atomic or if the GNAT compiler considers this object as volatile because of some code generation reasons. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -192,10 +190,10 @@ This rule has no parameters. .. _Object_Orientation: -Object Orientation ------------------- +``Object Orientation`` +---------------------- -.. index:: Object-Orientation related rules +.. index:: Object_Orientation-related_rules The rules in this subsection may be used to enforce various feature usages related to Object-Oriented Programming. @@ -213,8 +211,6 @@ Flag any declaration of a primitive function of a tagged type that has a controlling result and no controlling parameter. If a declaration is a completion of another declaration then it is not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -292,14 +288,10 @@ for LKQL rule options files: Flag any non-dispatching call to a dispatching primitive operation, except for: - -* - a call to the corresponding primitive of the parent type. (This +* a call to the corresponding primitive of the parent type. (This occurs in the common idiom where a primitive subprogram for a tagged type directly calls the same primitive subprogram of the parent type.) - -* - a call to a primitive of an untagged private type, even though the full type +* a call to a primitive of an untagged private type, even though the full type may be tagged, when the call is made at a place where the view of the type is untagged. @@ -366,8 +358,6 @@ for LKQL rule options files: Flag downward view conversions. -This rule has no parameters. - This rule will also flag downward view conversions done through access types. .. rubric:: Example @@ -421,8 +411,6 @@ if at least one of the operations it overrides or implements does not have (explicitly defined or inherited) Pre'Class aspect defined for it. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -458,49 +446,6 @@ This rule has no parameters. -.. _Specific_Pre_Post: - -``Specific_Pre_Post`` -^^^^^^^^^^^^^^^^^^^^^ - -.. index:: Specific_Pre_Post - -Flag a declaration of a primitive operation of a tagged type if this -declaration contains specification of Pre or/and Post aspect. - -This rule has no parameters. - -.. rubric:: Example - -.. code-block:: ada - :emphasize-lines: 5, 8, 11, 19 - - type T is tagged private; - function Check1 (X : T) return Boolean; - function Check2 (X : T) return Boolean; - - procedure Proc1 (X : in out T) -- FLAG - with Pre => Check1 (X); - - procedure Proc2 (X : in out T) -- FLAG - with Post => Check2 (X); - - function Fun1 (X : T) return Integer -- FLAG - with Pre => Check1 (X), - Post => Check2 (X); - - function Fun2 (X : T) return Integer - with Pre'Class => Check1 (X), - Post'Class => Check2 (X); - - function Fun3 (X : T) return Integer -- FLAG - with Pre'Class => Check1 (X), - Post'Class => Check2 (X), - Pre => Check1 (X), - Post => Check2 (X); - - - .. _Specific_Parent_Type_Invariant: ``Specific_Parent_Type_Invariant`` @@ -513,8 +458,6 @@ a parent type has a Type_Invariant aspect defined for it. A record extension definition is not flagged if it is a part of a completion of a private extension declaration. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -550,6 +493,47 @@ This rule has no parameters. +.. _Specific_Pre_Post: + +``Specific_Pre_Post`` +^^^^^^^^^^^^^^^^^^^^^ + +.. index:: Specific_Pre_Post + +Flag a declaration of a primitive operation of a tagged type if this +declaration contains specification of Pre or/and Post aspect. + +.. rubric:: Example + +.. code-block:: ada + :emphasize-lines: 5, 8, 11, 19 + + type T is tagged private; + function Check1 (X : T) return Boolean; + function Check2 (X : T) return Boolean; + + procedure Proc1 (X : in out T) -- FLAG + with Pre => Check1 (X); + + procedure Proc2 (X : in out T) -- FLAG + with Post => Check2 (X); + + function Fun1 (X : T) return Integer -- FLAG + with Pre => Check1 (X), + Post => Check2 (X); + + function Fun2 (X : T) return Integer + with Pre'Class => Check1 (X), + Post'Class => Check2 (X); + + function Fun3 (X : T) return Integer -- FLAG + with Pre'Class => Check1 (X), + Post'Class => Check2 (X), + Pre => Check1 (X), + Post => Check2 (X); + + + .. _Specific_Type_Invariants: ``Specific_Type_Invariants`` @@ -563,8 +547,6 @@ of Type_Invariant'Class aspects are not flagged. Definitions of (non-class-wide) Type_Invariant aspect that are parts of declarations of non-tagged types are not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -737,10 +719,10 @@ for LKQL rule options files: .. _Portability: -Portability ------------ +``Portability`` +--------------- -.. index:: Portability-related rules +.. index:: Portability-related_rules The rules in this subsection may be used to enforce various feature usages that support program portability. @@ -758,8 +740,6 @@ Flag record type declarations if a record has a component of a modular type and the record type is packed but does not have a record representation clause applied to it. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -938,6 +918,7 @@ a predefined or GNAT-specific attribute. Arr_Var (J) := Integer'Succ (J); + .. _Forbidden_Pragmas: ``Forbidden_Pragmas`` @@ -1029,8 +1010,6 @@ representation clause to define its ``'Small`` value. Since ``'Small`` can be defined only for ordinary fixed point types, decimal fixed point type declarations are not checked. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -1057,8 +1036,6 @@ This rule has no parameters. Flag all record types that have a layout representation specification but without Size and Pack representation specifications. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -1088,17 +1065,12 @@ This rule has no parameters. Flag membership tests that can be replaced by a ``'Valid`` attribute. Two forms of membership tests are flagged: -* - X in Subtype_Of_X - -* - X in Subtype_Of_X'First .. Subtype_Of_X'Last +* X in Subtype_Of_X +* X in Subtype_Of_X'First .. Subtype_Of_X'Last where X is a data object except for a loop parameter, and ``Subtype_Of_X`` is the subtype of the object as given by the corresponding declaration. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -1123,8 +1095,6 @@ Flag a declaration of a floating point type or a decimal fixed point type, including types derived from them if no explicit range specification is provided for the type. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -1148,8 +1118,6 @@ record_representation_clause that has at least one component clause applies to it (or an ancestor), but neither the type nor any of its ancestors has an explicitly specified Scalar_Storage_Order aspect. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -1208,8 +1176,6 @@ This rule detects only numeric types and subtypes declared in package predefined packages (such as ``System.Any_Priority`` or ``Ada.Text_IO.Count``) is not flagged -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -1242,8 +1208,6 @@ Flag source code text characters that are not part of the printable ASCII character set, a line feed, or a carriage return character (i.e. values 10, 13 and 32 .. 126 of the ASCII Character set). -This rule has no parameters. - .. _Separate_Numeric_Error_Handlers: @@ -1259,8 +1223,6 @@ the choice for the predefined ``Numeric_Error`` exception, or that contains the choice for ``Numeric_Error``, but does not contain the choice for ``Constraint_Error``. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -1273,39 +1235,12 @@ This rule has no parameters. -.. _Size_Attribute_For_Types: - -``Size_Attribute_For_Types`` -^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - -.. index:: Size_Attribute_For_Types - -Flag any 'Size attribute reference if its prefix denotes a type or a subtype. -Attribute references that are subcomponents of attribute definition clauses of -aspect specifications are not flagged. - -This rule has no parameters. - -.. rubric:: Example - -.. code-block:: ada - :emphasize-lines: 6 - - type T is record - I : Integer; - B : Boolean; - end record; - - Size_Of_T : constant Integer := T'Size -- FLAG - - - .. _Program_Structure: -Program Structure ------------------ +``Program Structure`` +--------------------- -.. index:: Program Structure related rules +.. index:: Program_Structure-related_rules The rules in this subsection may be used to enforce feature usages related to program structure. @@ -1450,8 +1385,6 @@ Flag all local packages declared in package and generic package specs. Local packages in bodies are not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -1465,69 +1398,6 @@ This rule has no parameters. -.. _Non_Visible_Exceptions: - -``Non_Visible_Exceptions`` -^^^^^^^^^^^^^^^^^^^^^^^^^^ - -.. index:: Non_Visible_Exceptions - -Flag constructs leading to the possibility of propagating an exception -out of the scope in which the exception is declared. -Two cases are detected: - -* - An exception declaration located immediately within a subprogram body, task - body or block statement is flagged if the body or statement does not contain - a handler for that exception or a handler with an ``others`` choice. - -* - A ``raise`` statement in an exception handler of a subprogram body, - task body or block statement is flagged if it (re)raises a locally - declared exception. This may occur under the following circumstances: - - * - it explicitly raises a locally declared exception, or - * - it does not specify an exception name (i.e., it is simply ``raise;``) - and the enclosing handler contains a locally declared exception in its - exception choices. - -Renamings of local exceptions are not flagged. - -This rule has no parameters. - -.. rubric:: Example - -.. code-block:: ada - :emphasize-lines: 5, 18 - - procedure Bar is - Var : Integer :=- 13; - - procedure Inner (I : in out Integer) is - Inner_Exception_1 : exception; -- FLAG - Inner_Exception_2 : exception; - begin - if I = 0 then - raise Inner_Exception_1; - elsif I = 1 then - raise Inner_Exception_2; - else - I := I - 1; - end if; - exception - when Inner_Exception_2 => - I := 0; - raise; -- FLAG - end Inner; - - begin - Inner (Var); - end Bar; - - - .. _Maximum_Expression_Complexity: ``Maximum_Expression_Complexity`` @@ -1539,23 +1409,12 @@ Flag any expression that is not directly a part of another expression which contains more than *N* expressions of the following kinds (each count for 1) as its subcomponents, *N* is a rule parameter: -* - Identifiers; - -* - Numeric, string or character literals; - -* - Conditional expressions; - -* - Quantified expressions; - -* - Aggregates; - -* - @ symbols (target names). +* Identifiers; +* Numeric, string or character literals; +* Conditional expressions; +* Quantified expressions; +* Aggregates; +* @ symbols (target names). This rule has the following (mandatory) parameter for the ``+R`` option and for LKQL rule options files: @@ -1575,6 +1434,25 @@ for LKQL rule options files: +.. _Maximum_Lines: + +``Maximum_Lines`` +^^^^^^^^^^^^^^^^^ + +.. index:: Maximum_Lines + +Flags the file containing the source text of a compilation unit if this +file contains more than N lines where N is a rule parameter + +This rule has the following (mandatory) parameter for the ``+R`` option and +for LKQL rule options files: + +*N: int* + Positive integer specifying the maximum allowed number of lines in + the compilation unit source text. + + + .. _Maximum_Subprogram_Lines: ``Maximum_Subprogram_Lines`` @@ -1609,32 +1487,113 @@ for LKQL rule options files: -.. _One_Tagged_Type_Per_Package: +.. _Non_Visible_Exceptions: -``One_Tagged_Type_Per_Package`` -^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +``Non_Visible_Exceptions`` +^^^^^^^^^^^^^^^^^^^^^^^^^^ -.. index:: One_Tagged_Type_Per_Package +.. index:: Non_Visible_Exceptions -Flag all package declarations with more than one tagged type declaration -in the visible part. +Flag constructs leading to the possibility of propagating an exception +out of the scope in which the exception is declared. +Two cases are detected: + +* An exception declaration located immediately within a subprogram body, task + body or block statement is flagged if the body or statement does not contain + a handler for that exception or a handler with an ``others`` choice. +* A ``raise`` statement in an exception handler of a subprogram body, + task body or block statement is flagged if it (re)raises a locally + declared exception. This may occur under the following circumstances: + * it explicitly raises a locally declared exception, or -This rule has no parameters. + * it does not specify an exception name (i.e., it is simply ``raise;``) + and the enclosing handler contains a locally declared exception in its + exception choices. + +Renamings of local exceptions are not flagged. .. rubric:: Example .. code-block:: ada - :emphasize-lines: 1 - - package P is -- FLAG + :emphasize-lines: 5, 18 - type T is tagged null record; - type T2 is tagged null record; + procedure Bar is + Var : Integer :=- 13; + + procedure Inner (I : in out Integer) is + Inner_Exception_1 : exception; -- FLAG + Inner_Exception_2 : exception; + begin + if I = 0 then + raise Inner_Exception_1; + elsif I = 1 then + raise Inner_Exception_2; + else + I := I - 1; + end if; + exception + when Inner_Exception_2 => + I := 0; + raise; -- FLAG + end Inner; + + begin + Inner (Var); + end Bar; + + + +.. _One_Tagged_Type_Per_Package: + +``One_Tagged_Type_Per_Package`` +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. index:: One_Tagged_Type_Per_Package + +Flag all package declarations with more than one tagged type declaration +in the visible part. + +.. rubric:: Example + +.. code-block:: ada + :emphasize-lines: 1 + + package P is -- FLAG + + type T is tagged null record; + type T2 is tagged null record; end P; +.. _Outside_References_From_Subprograms: + +``Outside_References_From_Subprograms`` +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. index:: Outside_References_From_Subprograms + +Within a subprogram body or an expression function flag any identifier that +denotes a non global data object declared outside this body. + +This rule analyzes generic instantiations and ignores generic packages to +avoid flagging all references to formal objects. + +.. rubric:: Example + +.. code-block:: ada + :emphasize-lines: 6 + + procedure Enclosing is + Var : Integer; + + procedure Proc (I : in out Integer) is + begin + I := I + Var; -- FLAG + + + .. _Raising_External_Exceptions: ``Raising_External_Exceptions`` @@ -1647,8 +1606,6 @@ package or in a generic library package, for an exception that is neither a predefined exception nor an exception that is also declared (or renamed) in the visible part of the package. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -1784,10 +1741,10 @@ for LKQL rule options files: .. _Programming_Practice: -Programming Practice --------------------- +``Programming Practice`` +------------------------ -.. index:: Programming Practice related rules +.. index:: Programming_Practice-related_rules The rules in this subsection may be used to enforce feature usages that relate to program maintainability. @@ -1809,8 +1766,6 @@ in those). Here both package declarations and package instantiations are considered as packages. If the attribute prefix is a dereference or a subcomponent thereof, the attribute reference is not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -1919,8 +1874,6 @@ Flag formal package declarations that are not allowed in Ada 95. Ada 95 allows the box symbol ``(<>)`` to be used alone as a whole formal package actual part only. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -1949,8 +1902,6 @@ You can check this page https://learn.adacore.com/courses/whats-new-in-ada-2022/index.html for a quick overview of the new features of Ada 2022. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -1995,8 +1946,6 @@ object defined by a variable object declaration and this object is not marked as Volatile. An entity is considered as being marked volatile if it has an aspect Volatile, Atomic or Shared declared for it. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -2020,8 +1969,6 @@ This rule has no parameters. Flag address clauses and address aspect definitions if they are applied to object declarations with explicit initializations. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -2046,8 +1993,6 @@ Flag address clauses and address aspect definitions if they are applied to data objects declared in local subprogram bodies. Data objects declared in library subprogram bodies are not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -2077,8 +2022,6 @@ This rule has no parameters. Flag all anonymous array type definitions (by Ada semantics these can only occur in object declarations). -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -2136,8 +2079,6 @@ can be simplified by excluding the outer call to the predefined ``NOT`` operator. Calls to ``NOT`` operators for the types derived from Standard.Boolean are not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -2260,8 +2201,6 @@ calls to all these subprograms as the calls to the same subprogram. Flag synchronized, task, and protected interfaces. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -2287,13 +2226,8 @@ clause ``for Overlaying'Address use Overlaid'Address;`` or a form of aspect defi declaration or a formal or generic formal parameter of mode ``IN`` if at least one of the following is true: -* - the overlaying object is not a constant object; - -* - overlaying object or overlaid object is marked as Volatile; - -This rule has no parameters. +* the overlaying object is not a constant object; +* overlaying object or overlaid object is marked as Volatile; .. rubric:: Example @@ -2317,8 +2251,6 @@ Flag a record component declaration if it contains a default expression. Do not flag record component declarations in protected definitions. Do not flag discriminant specifications. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -2338,6 +2270,31 @@ This rule has no parameters. +.. _Deriving_From_Predefined_Type: + +``Deriving_From_Predefined_Type`` +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. index:: Deriving_From_Predefined_Type + +Flag derived type declaration if the ultimate ancestor type is a +predefined Ada type. Do not flag record extensions and private +extensions. The rule is checked inside expanded generics. + +.. rubric:: Example + +.. code-block:: ada + :emphasize-lines: 3, 5 + + package Foo is + type T is private; + type My_String is new String; -- FLAG + private + type T is new Integer; -- FLAG + end Foo; + + + .. _Direct_Equalities: ``Direct_Equalities`` @@ -2383,33 +2340,6 @@ of some other expression or as a call parameter. -.. _Deriving_From_Predefined_Type: - -``Deriving_From_Predefined_Type`` -^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - -.. index:: Deriving_From_Predefined_Type - -Flag derived type declaration if the ultimate ancestor type is a -predefined Ada type. Do not flag record extensions and private -extensions. The rule is checked inside expanded generics. - -This rule has no parameters. - -.. rubric:: Example - -.. code-block:: ada - :emphasize-lines: 3, 5 - - package Foo is - type T is private; - type My_String is new String; -- FLAG - private - type T is new Integer; -- FLAG - end Foo; - - - .. _Duplicate_Branches: ``Duplicate_Branches`` @@ -2490,8 +2420,6 @@ This rule helps prevent maintenance problems arising from adding an enumeration value to a type and having it implicitly handled by an existing ``case`` statement with an enumeration range that includes the new literal. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -2513,27 +2441,6 @@ This rule has no parameters. -.. _Enumeration_Representation_Clauses: - -``Enumeration_Representation_Clauses`` -^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - -.. index:: Enumeration_Representation_Clauses - -Flag enumeration representation clauses. - -This rule has no parameters. - -.. rubric:: Example - -.. code-block:: ada - :emphasize-lines: 2 - - type Enum1 is (A1, B1, C1); - for Enum1 use (A1 => 1, B1 => 11, C1 => 111); -- FLAG - - - .. _Exception_Propagation_From_Callbacks: ``Exception_Propagation_From_Callbacks`` @@ -2544,9 +2451,7 @@ This rule has no parameters. Flag an ``'Address`` or ``'Access`` attribute if: * this attribute is a reference to a subprogram; - * this subprogram may propagate an exception; - * this attribute is an actual parameter of a subprogram call, and both the subprogram called and the corresponding formal parameter are specified by a rule parameter. @@ -2554,7 +2459,6 @@ Flag an ``'Address`` or ``'Access`` attribute if: A subprogram is considered as not propagating an exception if: * its body has an exception handler with ``others`` exception choice; - * no exception handler in the body contains a raise statement nor a call to ``Ada.Exception.Raise_Exception`` or ``Ada.Exception.Reraise_Occurrence``. @@ -2640,15 +2544,10 @@ applied to this subprogram and this subprogram may propagate an exception. A subprogram is considered as not propagating an exception if: -* - its body has an exception handler with ``others`` exception choice; - -* - no exception handler in the body contains a raise statement nor a call to +* its body has an exception handler with ``others`` exception choice; +* no exception handler in the body contains a raise statement nor a call to ``Ada.Exception.Raise_Exception`` or ``Ada.Exception.Reraise_Occurrence``. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -2672,15 +2571,13 @@ This rule has no parameters. ``Exception_Propagation_From_Tasks`` ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -.. index:: Exception_Propagation_From_Export +.. index:: Exception_Propagation_From_Tasks Flag a task body if it does not contain and exception handler with ``others`` exception choice or if it contains an exception handler with a raise statement or a call to ``Ada.Exception.Raise_Exception`` or ``Ada.Exception.Reraise_Occurrence``. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -2708,8 +2605,6 @@ Flag each place where an exception is explicitly raised and handled in the same subprogram body. A ``raise`` statement in an exception handler, package body, task body or entry body is not flagged. -The rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -2730,39 +2625,6 @@ The rule has no parameters. -.. _Exits_From_Conditional_Loops: - -``Exits_From_Conditional_Loops`` -^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - -.. index:: Exits_From_Conditional_Loops - -Flag any exit statement if it transfers the control out of a ``for`` loop -or a ``while`` loop. This includes cases when the ``exit`` statement -applies to a ``for`` or ``while`` loop, and cases when it is enclosed -in some ``for`` or ``while`` loop, but transfers the control from some -outer (unconditional) ``loop`` statement. - -The rule has no parameters. - -.. rubric:: Example - -.. code-block:: ada - :emphasize-lines: 5 - - function Bar (S : String) return Natural is - Result : Natural := 0; - begin - for J in S'Range loop - exit when S (J) = '@'; -- FLAG - Result := Result + J; - end loop; - - return 0; - end Bar; - - - .. _EXIT_Statements_With_No_Loop_Name: ``EXIT_Statements_With_No_Loop_Name`` @@ -2796,11 +2658,44 @@ for LKQL rule options files: +.. _Exits_From_Conditional_Loops: + +``Exits_From_Conditional_Loops`` +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. index:: Exits_From_Conditional_Loops + +Flag any exit statement if it transfers the control out of a ``for`` loop +or a ``while`` loop. This includes cases when the ``exit`` statement +applies to a ``for`` or ``while`` loop, and cases when it is enclosed +in some ``for`` or ``while`` loop, but transfers the control from some +outer (unconditional) ``loop`` statement. + +.. rubric:: Example + +.. code-block:: ada + :emphasize-lines: 5 + + function Bar (S : String) return Natural is + Result : Natural := 0; + begin + for J in S'Range loop + exit when S (J) = '@'; -- FLAG + Result := Result + J; + end loop; + + return 0; + end Bar; + + + .. _Final_Package: ``Final_Package`` ^^^^^^^^^^^^^^^^^ +.. index:: Final_Package + Check that package declarations annotated as final don't have child packages @@ -2892,73 +2787,21 @@ LKQL rule options files: -.. _Integer_Types_As_Enum: +.. _Improper_Returns: -``Integer_Types_As_Enum`` -^^^^^^^^^^^^^^^^^^^^^^^^^ +``Improper_Returns`` +^^^^^^^^^^^^^^^^^^^^ -.. index:: Integer_Types_As_Enum +.. index:: Improper_Returns -Flag each integer type declaration (including types derived from -integer types) if this integer type may benefit from -being replaced by an enumeration type. An integer type is considered -as being potentially replaceable by an enumeration type if all the -following conditions are true: - -* - there is no infix calls to any arithmetic or bitwise operator for objects - of this type; - -* - this type is not referenced in an actual parameter of a generics - instantiation; - -* - there is no type conversion from or to this type; - -* - no type is derived from this type; - -* - no subtype is declared for this type. - -This rule has no parameters. - -.. rubric:: Example - -.. code-block:: ada - :emphasize-lines: 2 - - procedure Proc is - type Enum is range 1 .. 3; -- FLAG - type Int is range 1 .. 3; -- NO FLAG - - X : Enum := 1; - Y : Int := 1; - begin - X := 2; - Y := Y + 1; - end Proc; - - - -.. _Improper_Returns: - -``Improper_Returns`` -^^^^^^^^^^^^^^^^^^^^ - -.. index:: Improper_Returns - -Flag each explicit ``return`` statement in procedures, and -multiple ``return`` statements in functions. -Diagnostic messages are generated for all ``return`` statements -in a procedure (thus each procedure must be written so that it -returns implicitly at the end of its statement part), -and for all ``return`` statements in a function after the first one. -This rule supports the stylistic convention that each subprogram -should have no more than one point of normal return. - -This rule has no parameters. +Flag each explicit ``return`` statement in procedures, and +multiple ``return`` statements in functions. +Diagnostic messages are generated for all ``return`` statements +in a procedure (thus each procedure must be written so that it +returns implicitly at the end of its statement part), +and for all ``return`` statements in a function after the first one. +This rule supports the stylistic convention that each subprogram +should have no more than one point of normal return. .. rubric:: Example @@ -2988,6 +2831,45 @@ This rule has no parameters. +.. _Integer_Types_As_Enum: + +``Integer_Types_As_Enum`` +^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. index:: Integer_Types_As_Enum + +Flag each integer type declaration (including types derived from +integer types) if this integer type may benefit from +being replaced by an enumeration type. An integer type is considered +as being potentially replaceable by an enumeration type if all the +following conditions are true: + +* there is no infix calls to any arithmetic or bitwise operator for objects + of this type; +* this type is not referenced in an actual parameter of a generics + instantiation; +* there is no type conversion from or to this type; +* no type is derived from this type; +* no subtype is declared for this type. + +.. rubric:: Example + +.. code-block:: ada + :emphasize-lines: 2 + + procedure Proc is + type Enum is range 1 .. 3; -- FLAG + type Int is range 1 .. 3; -- NO FLAG + + X : Enum := 1; + Y : Int := 1; + begin + X := 2; + Y := Y + 1; + end Proc; + + + .. _Local_Instantiations: ``Local_Instantiations`` @@ -3068,25 +2950,6 @@ options files: -.. _Maximum_Lines: - -``Maximum_Lines`` -^^^^^^^^^^^^^^^^^ - -.. index:: Maximum_Lines - -Flags the file containing the source text of a compilation unit if this -file contains more than N lines where N is a rule parameter - -This rule has the following (mandatory) parameter for the ``+R`` option and -for LKQL rule options files: - -*N: int* - Positive integer specifying the maximum allowed number of lines in - the compilation unit source text. - - - .. _Maximum_OUT_Parameters: ``Maximum_OUT_Parameters`` @@ -3186,31 +3049,14 @@ and the declaration of the entity it applies to. A representation item in the context of this rule is either a representation clause or one of the following representation pragmas: -* - Atomic J.15.8(9/3) - -* - Atomic_Components J.15.8(9/3) - -* - Independent J.15.8(9/3) - -* - Independent_Components J.15.8(9/3) - -* - Pack J.15.3(1/3) - -* - Unchecked_Union J.15.6(1/3) - -* - Volatile J.15.8(9/3) - -* - Volatile_Components J.15.8(9/3) - -This rule has no parameters. +* Atomic J.15.8(9/3) +* Atomic_Components J.15.8(9/3) +* Independent J.15.8(9/3) +* Independent_Components J.15.8(9/3) +* Pack J.15.3(1/3) +* Unchecked_Union J.15.6(1/3) +* Volatile J.15.8(9/3) +* Volatile_Components J.15.8(9/3) .. rubric:: Example @@ -3250,8 +3096,6 @@ or an unconditional exit statement, or a goto statement or a block statement without an exception handler with the enclosed sequence of statements that ends with some breaking statement. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -3285,8 +3129,6 @@ inside a local nested package). Protected subprograms are not flagged. Null procedure declarations are not flagged. Procedure declarations completed by null procedure declarations are not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -3408,8 +3250,6 @@ Flag a barrier condition expression in an entry body declaration if this expression contains a reference to a data object that is not a (sub)component of the enclosing record the entry belongs to. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -3458,16 +3298,9 @@ is a data object defined by a variable declaration , a formal parameter of mode ``IN OUT`` or ``OUT`` or a generic formal parameter of mode ``IN OUT`` if at least one of the following is true: -* - the overlaying object is a constant object; - -* - overlaying object is not marked as Volatile; - -* - if overlaid object is not a parameter, it is not marked as Volatile; - -This rule has no parameters. +* the overlaying object is a constant object; +* overlaying object is not marked as Volatile; +* if overlaid object is not a parameter, it is not marked as Volatile; .. rubric:: Example @@ -3480,44 +3313,6 @@ This rule has no parameters. -.. _Nonoverlay_Address_Specifications: - -``Nonoverlay_Address_Specifications`` -^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - -.. index:: Nonoverlay_Address_Specifications - -Flag an attribute definition clause that defines ``'Address`` attribute if -it does not have the form ``for Overlaying'Address use Overlaid'Address;`` -where ``Overlaying`` is an identifier defined by an object declaration -and ``Overlaid`` is an identifier defined either by an object declaration -or a parameter specification. Flag an Address aspect specification if -this aspect specification is not a part of an object declaration and -if the aspect value does not have the form ``Overlaid'Address`` -where ``Overlaid`` is an identifier defined either by an object -declaration or a parameter specification. - -Address specifications given for program units are not flagged. - -This rule has no parameters. - -.. rubric:: Example - -.. code-block:: ada - :emphasize-lines: 9 - - type Rec is record - C : Integer; - end record; - - Var_Rec : Rec; - Var_Int : Integer; - - Var1 : Integer with Address => Var_Int'Address; - Var2 : Integer with Address => Var_Rec.C'Address; -- FLAG - - - .. _Non_Short_Circuit_Operators: ``Non_Short_Circuit_Operators`` @@ -3541,45 +3336,25 @@ options files: A pragma or an aspect is considered as assertion-related if its name is from the following list: -* - ``Assert`` -* - ``Assert_And_Cut`` -* - ``Assume`` -* - ``Contract_Cases`` -* - ``Debug`` -* - ``Default_Initial_Condition`` -* - ``Dynamic_Predicate`` -* - ``Invariant`` -* - ``Loop_Invariant`` -* - ``Loop_Variant`` -* - ``Post`` -* - ``Postcondition`` -* - ``Pre`` -* - ``Precondition`` -* - ``Predicate`` -* - ``Predicate_Failure`` -* - ``Refined_Post`` -* - ``Static_Predicate`` -* - ``Type_Invariant`` - +* ``Assert`` +* ``Assert_And_Cut`` +* ``Assume`` +* ``Contract_Cases`` +* ``Debug`` +* ``Default_Initial_Condition`` +* ``Dynamic_Predicate`` +* ``Invariant`` +* ``Loop_Invariant`` +* ``Loop_Variant`` +* ``Post`` +* ``Postcondition`` +* ``Pre`` +* ``Precondition`` +* ``Predicate`` +* ``Predicate_Failure`` +* ``Refined_Post`` +* ``Static_Predicate`` +* ``Type_Invariant`` .. rubric:: Example @@ -3593,6 +3368,42 @@ is from the following list: +.. _Nonoverlay_Address_Specifications: + +``Nonoverlay_Address_Specifications`` +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. index:: Nonoverlay_Address_Specifications + +Flag an attribute definition clause that defines ``'Address`` attribute if +it does not have the form ``for Overlaying'Address use Overlaid'Address;`` +where ``Overlaying`` is an identifier defined by an object declaration +and ``Overlaid`` is an identifier defined either by an object declaration +or a parameter specification. Flag an Address aspect specification if +this aspect specification is not a part of an object declaration and +if the aspect value does not have the form ``Overlaid'Address`` +where ``Overlaid`` is an identifier defined either by an object +declaration or a parameter specification. + +Address specifications given for program units are not flagged. + +.. rubric:: Example + +.. code-block:: ada + :emphasize-lines: 9 + + type Rec is record + C : Integer; + end record; + + Var_Rec : Rec; + Var_Int : Integer; + + Var1 : Integer with Address => Var_Int'Address; + Var2 : Integer with Address => Var_Rec.C'Address; -- FLAG + + + .. _Not_Imported_Overlays: ``Not_Imported_Overlays`` @@ -3610,8 +3421,6 @@ if the aspect value has the form ``Overlaid'Address`` where ``Overlaid`` is an identifier defined by an object declaration if the object ``Overlaying`` is not marked as imported. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -3685,8 +3494,6 @@ anonymous access or array type definition. Record component definitions and parameter specifications are not flagged. Formal object declarations defined with anonymous access definitions are flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -3757,8 +3564,6 @@ with an ``others`` choice and another with a discrete range, the ``others`` choice is flagged even if the discrete range specifies exactly one component; for example, ``(1..1 => 0, others => 1)``. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -3838,8 +3643,6 @@ options files: Flag any use of an ``others`` choice in an exception handler. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -3865,8 +3668,6 @@ Flag an assignment statement located in a protected body if the variable name in the left part of the statement denotes an object declared outside this protected type or object. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -3900,35 +3701,6 @@ This rule has no parameters. -.. _Outside_References_From_Subprograms: - -``Outside_References_From_Subprograms`` -^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - -.. index:: Outside_References_From_Subprograms - -Within a subprogram body or an expression function flag any identifier that -denotes a non global data object declared outside this body. - -This rule analyzes generic instantiations and ignores generic packages to -avoid flagging all references to formal objects. - -This rule has no parameters. - -.. rubric:: Example - -.. code-block:: ada - :emphasize-lines: 6 - - procedure Enclosing is - Var : Integer; - - procedure Proc (I : in out Integer) is - begin - I := I + Var; -- FLAG - - - .. _Overly_Nested_Control_Structures: ``Overly_Nested_Control_Structures`` @@ -3992,26 +3764,15 @@ Flag a nested scope if the nesting level of this scope is more than the rule parameter. The following declarations are considered as scopes by this rule: -* - package and generic package declarations and bodies; +* package and generic package declarations and bodies; +* subprogram and generic subprogram declarations and bodies; +* task type and single task declarations and bodies; +* protected type and single protected declarations and bodies; +* entry bodies; +* block statements; -* - subprogram and generic subprogram declarations and bodies; - -* - task type and single task declarations and bodies; - -* - protected type and single protected declarations and bodies; - -* - entry bodies; - -* - block statements; - -This rule has the following (mandatory) parameter for the ``+R`` option and -for LKQL rule options files: +This rule has the following (mandatory) parameter for the ``+R`` option and +for LKQL rule options files: *N: int* Non-negative integer specifying the maximal allowed depth of scope @@ -4093,8 +3854,6 @@ for LKQL rule options files: Flag ``'Pos`` attribute in case if the attribute prefix has an enumeration type (including types derived from enumeration types). -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -4122,8 +3881,6 @@ This rule has no parameters. Flag each generic actual parameter corresponding to a generic formal parameter with a default initialization, if positional notation is used. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -4170,8 +3927,6 @@ Flag each actual parameter to a subprogram or entry call where the corresponding formal parameter has a default expression, if positional notation is used. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -4197,8 +3952,6 @@ This rule has no parameters. Flag each array, record and extension aggregate that includes positional notation. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -4234,8 +3987,6 @@ Flag each positional actual generic parameter except for the case when the generic unit being instantiated has exactly one generic formal parameter. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -4266,20 +4017,14 @@ This rule has no parameters. Flag each positional parameter notation in a subprogram or entry call, except for the following: -* - Parameters of calls to attribute subprograms are not flagged; -* - Parameters of prefix or infix calls to operator functions are not flagged; -* - If the called subprogram or entry has only one formal parameter, +* Parameters of calls to attribute subprograms are not flagged; +* Parameters of prefix or infix calls to operator functions are not flagged; +* If the called subprogram or entry has only one formal parameter, the parameter of the call is not flagged; -* - If a subprogram call uses the *Object.Operation* notation, then +* If a subprogram call uses the *Object.Operation* notation, then + * the first parameter (that is, *Object*) is not flagged; - * - the first parameter (that is, *Object*) is not flagged; - * - if the called subprogram has only two parameters, the second parameter + * if the called subprogram has only two parameters, the second parameter of the call is not flagged; This rule has the following (optional) parameter for the ``+R`` option and @@ -4363,35 +4108,6 @@ for LKQL rule options files: -.. _Profile_Discrepancies: - -``Profile_Discrepancies`` -^^^^^^^^^^^^^^^^^^^^^^^^^ - -.. index:: Profile_Discrepancies - -Flag subprogram or entry body (or body stub) if its parameter (or -parameter and result) profile does not follow the lexical structure -of the profile in the corresponding subprogram or entry declaration. - -This rule has no parameters. - -.. rubric:: Example - -.. code-block:: ada - :emphasize-lines: 8 - - package Pack is - procedure Proc - (I : Integer; - J : Integer); - end Pack; - - package body Pack is - procedure Proc (I, J : Integer) is -- FLAG - - - .. _Recursive_Subprograms: ``Recursive_Subprograms`` @@ -4469,39 +4185,30 @@ options files: Flag constructs including boolean operations that can be simplified. The following constructs are flagged: -* - ``if`` statements that have ``if`` and ``else`` paths (and no ``elsif`` path) if +* ``if`` statements that have ``if`` and ``else`` paths (and no ``elsif`` path) if both paths contain a single statement that is either: - * - an assignment to the same variable of ``True`` in one path and ``False`` + * an assignment to the same variable of ``True`` in one path and ``False`` in the other path - * - a return statement that in one path returns ``True`` and in the other - path - ``False`` + + * a return statement that in one path returns ``True`` and in the other + path ``False`` where ``True`` and ``False`` are literals of the type ``Standard.Boolean`` or any type derived from it. Note that in case of assignment statements the variable names in the left part should be literally the same (case insensitive); -* - ``if`` expressions that have ``if`` and ``else`` paths (without any ``elseif``) +* ``if`` expressions that have ``if`` and ``else`` paths (without any ``elseif``) if one path expression is ``True`` and the other is ``False``, where ``True`` and ``False`` are literals of the ``Standard.Boolean`` type (or any type derived from it). - -* - infix call to a predefined ``=`` or ``/=`` operator when the right operand +* infix call to a predefined ``=`` or ``/=`` operator when the right operand is ``True`` or ``False`` where ``True`` and ``False`` are literals of the type ``Standard.Boolean`` or any type derived from it. - -* - infix call to a predefined ``not`` operator whose argument is an infix +* infix call to a predefined ``not`` operator whose argument is an infix call to a predefined ordering operator. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -4525,8 +4232,6 @@ This rule has no parameters. Flag null statements that serve no purpose and can be removed. If a null statement has a label it is not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -4615,8 +4320,6 @@ Flags expressions that contain a chain of infix calls to the same boolean operator (``and``, ``or``, ``and then``, ``or else``, ``xor``) if an expression contains syntactically equivalent operands. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -4638,8 +4341,6 @@ Flags infix calls to binary operators ``/``, ``=``, ``/=``, ``>``, ``>=``, ``<``, ``<=``, ``-``, ``mod``, ``rem`` (except when operating on floating point types) if operands of a call are syntactically equivalent. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -4661,8 +4362,6 @@ Flags condition expressions in ``if`` statements or ``if`` expressions if a statement or expression contains another condition expression that is syntactically equivalent to the first one. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -4813,8 +4512,6 @@ is to place it into a rule file and to use this rule file as a parameter of the Flag an enumeration type definition if it contains a single enumeration literal specification -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -4825,17 +4522,40 @@ This rule has no parameters. +.. _Size_Attribute_For_Types: + +``Size_Attribute_For_Types`` +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. index:: Size_Attribute_For_Types + +Flag any 'Size attribute reference if its prefix denotes a type or a subtype. +Attribute references that are subcomponents of attribute definition clauses of +aspect specifications are not flagged. + +.. rubric:: Example + +.. code-block:: ada + :emphasize-lines: 6 + + type T is record + I : Integer; + B : Boolean; + end record; + + Size_Of_T : constant Integer := T'Size -- FLAG + + + .. _SPARK_Procedures_Without_Globals: ``SPARK_Procedures_Without_Globals`` ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -.. index:: Separates +.. index:: SPARK_Procedures_Without_Globals Flags SPARK procedures that don't have a global aspect. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -4858,10 +4578,39 @@ This rule has no parameters. +.. _Suspicious_Equalities: + +``Suspicious_Equalities`` +^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. index:: Suspicious_Equalities + +Flag 'or' expressions whose left and right operands are unequalities +referencing the same entity and a literal and 'and' expressions whose left and +right operands are equalities referencing the same entity and a literal. + +.. rubric:: Example + +.. code-block:: ada + :emphasize-lines: 4, 7 + + procedure tmp is + X : Integer := 0; + begin + if X /= 1 or x /= 2 then -- FLAG + null; + end; + if x = 1 and then X = 2 then -- Flag + null; + end; + end; + + + .. _Trivial_Exception_Handlers: ``Trivial_Exception_Handlers`` -^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. index:: Trivial_Exception_Handlers @@ -4870,8 +4619,6 @@ as their first statement unless the enclosing handled sequence of statements also contains a handler with ``OTHERS`` exception choice that starts with any statement but not a raise statement with no exception name. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -4889,6 +4636,7 @@ This rule has no parameters. end; + .. _Unavailable_Body_Calls: ``Unavailable_Body_Calls`` @@ -4984,8 +4732,6 @@ Flag call to instantiation of ``Ada.Unchecked_Conversion`` if it is an actual in procedure or entry call or if it is a default value in a subprogram or entry parameter specification. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -5017,36 +4763,6 @@ This rule has no parameters. -.. _Unconditional_Exits: - -``Unconditional_Exits`` -^^^^^^^^^^^^^^^^^^^^^^^ - -.. index:: Unconditional_Exits - -Flag unconditional ``exit`` statements. - -This rule has no parameters. - -.. rubric:: Example - -.. code-block:: ada - :emphasize-lines: 8 - - procedure Find_A (S : String; Idx : out Natural) is - begin - Idx := 0; - - for J in S'Range loop - if S (J) = 'A' then - Idx := J; - exit; -- FLAG - end if; - end loop; - end Find_A; - - - .. _Uninitialized_Global_Variables: ``Uninitialized_Global_Variables`` @@ -5059,8 +4775,6 @@ located in a library-level package or generic package or bodies of library-level or generic package (including packages and generic packages nested in those). Do not flag deferred constant declarations. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -5084,8 +4798,6 @@ Flag each unnamed block statement. Flag a unnamed loop statement if this statement is enclosed by another loop statement or if it encloses another loop statement. -The rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -5126,8 +4838,6 @@ The rule has no parameters. Flags exit statements with no loop names that exit from named loops. -The rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -5157,8 +4867,6 @@ array component and a constant value, and such a loop can be replaced by a single assignment statement with array slices or array objects as the source and the target of the assignment. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -5190,18 +4898,11 @@ Flag an ``if`` statement if this statement could be replaced by a ``case`` statement. An ``if`` statement is considered as being replaceable by a ``case`` statement if: -* - it contains at least one ``elsif`` alternative; - -* - all the conditions are infix calls to some predefined relation operator, +* it contains at least one ``elsif`` alternative; +* all the conditions are infix calls to some predefined relation operator, for all of them one operand is the reference to the same variable of some discrete type; - -* - for calls to relation operator another operand is some static expression; - -This rule has no parameters. +* for calls to relation operator another operand is some static expression; .. rubric:: Example @@ -5218,54 +4919,6 @@ This rule has no parameters. -.. _USE_Clauses: - -``USE_Clauses`` -^^^^^^^^^^^^^^^ - -.. index:: USE_Clauses - -Flag names mentioned in use clauses. Use type clauses and names mentioned -in them are not flagged. - -This rule has the following optional parameter for the ``+R`` option and for -LKQL rule options files: - -*Exempt_Operator_Packages: bool* - If ``true``, do not flag a package name in a package use clause if it refers - to a package that only declares operators in its visible part. - -.. note:: - This rule has another parameter, only available when using an LKQL rule - options file: ``allowed``. It is a list of Ada names describing packages - to exempt from begin flagged when used in "use" clauses. Strings in this - list are case insensitive. Example: - - .. code-block:: lkql - - val rules = @{ - Use_Clauses: {Allowed: ["Ada.Strings.Unbounded", "Other.Package"]} - } - -.. rubric:: Example - -.. code-block:: ada - :emphasize-lines: 10, 11 - - package Pack is - I : Integer; - end Pack; - - package Operator_Pack is - function "+" (L, R : Character) return Character; - end Operator_Pack; - - with Pack, Operator_Pack; - use Pack; -- FLAG if "Pack" is not in Allowed - use Operator_Pack; -- FLAG only if Exempt_Operator_Packages is false - - - .. _Use_For_Loops: ``Use_For_Loops`` @@ -5399,8 +5052,6 @@ and: := ...; -- same LHS on all branches end if; -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -5438,13 +5089,9 @@ a logical expression consisting of a call to one or more predefined ``or`` operation(s), each relation that is an operand of the ``or`` expression is a comparison of the same variable of one of following forms: -* - a call to a predefined ``=`` operator, the variable is the left operand +* a call to a predefined ``=`` operator, the variable is the left operand of this call; - -* - a membership test applied to this variable; - +* a membership test applied to this variable; * a range test of the form ``Var >= E1 and Var <= E2`` where ``Var`` is the variable in question and ``>=``, ``and`` and ``<=`` are predefined operators; @@ -5486,8 +5133,6 @@ for LKQL rule options files: Flag all ``use`` clauses for packages; ``use type`` clauses are not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -5510,8 +5155,6 @@ Flag expressions of the form ``Name'First .. Name'Last`` that can be replaced by ``Name'Range`` or simply ``Name``. Also flag expressions of the form ``Name'Range`` that can be replaced with ``Name``. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -5547,8 +5190,6 @@ can be replaced with a single assignment statement with a record aggregate as an expression being assigned, there is no guarantee that it detects all such sequences. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -5579,8 +5220,6 @@ This rule has no parameters. Flag ``while`` loop statements that have a condition statically known to be ``TRUE``. Such loop statements can be replaced by simple loops. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -5604,8 +5243,6 @@ Flag simple loop statements that have the exit statement completing execution of such a loop as the first statement in their sequence of statements. Such loop statements can be replaced by ``WHILE`` loops. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -5629,17 +5266,10 @@ Flag local object declarations that can be moved into declare blocks nested into the declaration scope. A declaration is considered as movable into a nested scope if: -* - The declaration does not contain an initialization expression; - -* - The declared object is used only in a nested block statement, +* The declaration does not contain an initialization expression; +* The declared object is used only in a nested block statement, and this block statement has a declare part; - -* - the block statement is not enclosed into a loop statement. - -This rule has no parameters. +* the block statement is not enclosed into a loop statement. .. rubric:: Example @@ -5734,14 +5364,16 @@ same as the parameters of the rule itself. .. _Readability: -Readability ------------ +``Readability`` +--------------- -.. index:: Readability-related rules +.. index:: Readability-related_rules The rules described in this subsection may be used to enforce feature usages that contribute towards readability. + + .. _End_Of_Line_Comments: ``End_Of_Line_Comments`` @@ -5752,8 +5384,6 @@ that contribute towards readability. Flags comments that are located in the source lines that contains Ada code. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -5802,20 +5432,13 @@ kind of entity being declared. All 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) +* 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 number declarations (including object renaming +* constant and number declarations (including object renaming declarations if the renamed object is a constant); - -* - exception declarations and exception renaming declarations. +* exception declarations and exception renaming declarations. The rule may have the following parameters for ``+R`` option and for LKQL rule options files: @@ -5968,20 +5591,13 @@ 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 +* type and subtype declarations (task, protected and access types are treated separately); - -* - enumeration literal specifications (not including character literals) +* enumeration literal specifications (not including character literals) and function renaming declarations if the renaming entity is an enumeration literal; - -* - exception declarations and exception renaming declarations; - -* - constant and number declarations (including object renaming +* exception declarations and exception renaming declarations; +* constant and number declarations (including object renaming declarations if the renamed object is a constant). Defining names declared by single task declarations or single protected @@ -6137,41 +5753,26 @@ the definition of exemption sections are: ^^^^^^^^^^^^^^^^^^^^^^^ .. index:: Identifier_Suffixes -.. index:: Misnamed_Identifiers - -Because of upward compatibility reasons this rule has a synonym -``Misnamed_Identifiers``. Flag the declaration of each identifier that does not have a suffix corresponding to the kind of entity being declared. The following declarations are checked: -* - type declarations - -* - subtype declarations - -* - object declarations (variable and constant declarations, but not number, +* type declarations +* subtype declarations +* object declarations (variable and constant declarations, but not number, declarations, record component declarations, parameter specifications, extended return object declarations, formal object declarations) - -* - package renaming declarations (but not generic package renaming +* package renaming declarations (but not generic package renaming declarations) The default checks (enforced by the *Default* rule parameter) are: -* - type-defining names end with ``_T``, unless the type is an access type, +* type-defining names end with ``_T``, unless the type is an access type, in which case the suffix must be ``_A`` -* - constant names end with ``_C`` -* - names defining package renamings end with ``_R`` -* - the check for access type objects is not enabled +* constant names end with ``_C`` +* names defining package renamings end with ``_R`` +* the check for access type objects is not enabled Defining identifiers from incomplete type declarations are never flagged. @@ -6189,23 +5790,12 @@ 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 declaration - -* - record component declaration - -* - return object declaration - -* - parameter specification - -* - extended return object declaration - -* - formal object declaration +* variable and constant declaration +* record component declaration +* return object declaration +* parameter specification +* extended return object declaration +* formal object declaration If both checks for constant suffixes and for access object suffixes are enabled, and if different suffixes are defined for them, then for constants @@ -6380,8 +5970,6 @@ A subprogram body declaration, subprogram renaming declaration, or subprogram body stub is flagged only if it is not a completion of a prior subprogram declaration. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -6457,23 +6045,14 @@ A line containing one or more identifiers may end with a comment. Flag each numeric literal which does not satisfy at least one of the following requirements: -* - the literal is given in the conventional decimal notation given, +* the literal is given in the conventional decimal notation given, or, if its base is specified explicitly, this base should be 2, 8, 10 or 16 only; - -* - if the literal base is 8 or 10, an underscore should separate groups +* if the literal base is 8 or 10, an underscore should separate groups of 3 digits starting from the right end of the literal; - -* - if the literal base is 2 or 16, an underscore should separate groups +* if the literal base is 2 or 16, an underscore should separate groups of 4 digits starting from the right end of the literal; - -* - all letters (exponent symbol and digits above 9) should be in upper case. - -This rule has no parameters. +* all letters (exponent symbol and digits above 9) should be in upper case. .. rubric:: Example @@ -6498,8 +6077,6 @@ This rule has no parameters. Flag any object declaration that is located in a library unit body if this is preceding by a declaration of a program unit spec, stub or body. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -6524,33 +6101,18 @@ line where this construct starts contains some other Ada code symbols preceding or following this construct. The following constructs are not flagged: -* - enumeration literal specification; - -* - parameter specifications; - -* - discriminant specifications; - -* - mod clauses; - -* - loop parameter specification; - -* - entry index specification; - -* - choice parameter specification; +* enumeration literal specification; +* parameter specifications; +* discriminant specifications; +* mod clauses; +* loop parameter specification; +* entry index specification; +* choice parameter specification; In case if we have two or more declarations/statements/clauses on a line and if there is no Ada code preceding the first construct, the first construct is flagged -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -6565,6 +6127,33 @@ This rule has no parameters. +.. _Profile_Discrepancies: + +``Profile_Discrepancies`` +^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. index:: Profile_Discrepancies + +Flag subprogram or entry body (or body stub) if its parameter (or +parameter and result) profile does not follow the lexical structure +of the profile in the corresponding subprogram or entry declaration. + +.. rubric:: Example + +.. code-block:: ada + :emphasize-lines: 8 + + package Pack is + procedure Proc + (I : Integer; + J : Integer); + end Pack; + + package body Pack is + procedure Proc (I, J : Integer) is -- FLAG + + + .. _Style_Checks: ``Style_Checks`` @@ -6739,10 +6328,11 @@ for LKQL rule options files: end record; -- FLAG -Feature Usage Rules -=================== -.. index:: Feature usage related rules +``Feature-Related Rules`` +========================= + +.. index:: Feature-Related_Rules The rules in this section can be used to enforce specific usage patterns for a variety of language features. @@ -6758,8 +6348,6 @@ usage patterns for a variety of language features. Flag abort statements. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -6783,8 +6371,6 @@ For an abstract private type, the full type declarations is flagged only if it is itself declared as abstract. Interface types are not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -6810,8 +6396,6 @@ Flag object declarations, formal object declarations and component declarations anonymous access type definitions. Discriminant specifications and parameter specifications are not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -6842,14 +6426,11 @@ This rule has no parameters. Flag all uses of anonymous subtypes except for the following: -* - when the subtype indication depends on a discriminant, this includes the +* when the subtype indication depends on a discriminant, this includes the cases of a record component definitions when a component depends on a discriminant, and using the discriminant of the derived type to constraint the parent type; - -* - when a self-referenced data structure is defined, and a discriminant +* when a self-referenced data structure is defined, and a discriminant is constrained by the reference to the current instance of a type; A use of an anonymous subtype is @@ -6883,8 +6464,6 @@ Declaring an explicit subtype solves the problem: ... end loop; -This rule has no parameters. - .. _At_Representation_Clauses: @@ -6897,8 +6476,6 @@ This rule has no parameters. Flag at clauses and mod clauses (treated as obsolescent features in the Ada Standard). -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -6926,8 +6503,6 @@ This rule has no parameters. Flag each block statement. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -6956,17 +6531,12 @@ Flag a subprogram (or generic subprogram, or instantiation of a subprogram) if pragma Inline is applied to it and at least one of the following conditions is met: -* - it contains at least one complex declaration such as a subprogram body, +* it contains at least one complex declaration such as a subprogram body, package, task, protected declaration, or a generic instantiation (except instantiation of ``Ada.Unchecked_Conversion``); - -* - it contains at least one complex statement such as a loop, a case +* it contains at least one complex statement such as a loop, a case or an if statement; - -* - the number of statements exceeds +* the number of statements exceeds a value specified by the *N* rule parameter; Subprogram renamings are also considered. @@ -7022,88 +6592,42 @@ for LKQL rule options files: *Language-defined* -* - ``Assert`` +* ``Assert`` *GNAT-specific* -* - ``Assert_And_Cut`` - -* - ``Assume`` - -* - ``Contract_Cases`` - -* - ``Debug`` - -* - ``Invariant`` - -* - ``Loop_Invariant`` - -* - ``Loop_Variant`` - -* - ``Postcondition`` - -* - ``Precondition`` - -* - ``Predicate`` - -* - ``Refined_Post`` +* ``Assert_And_Cut`` +* ``Assume`` +* ``Contract_Cases`` +* ``Debug`` +* ``Invariant`` +* ``Loop_Invariant`` +* ``Loop_Variant`` +* ``Postcondition`` +* ``Precondition`` +* ``Predicate`` +* ``Refined_Post`` *definition of the following aspects* *Language-defined* -* - ``Static_Predicate`` - -* - ``Dynamic_Predicate`` - -* - ``Pre`` - -* - ``Pre'Class`` - -* - ``Post`` - -* - ``Post'Class`` - -* - ``Type_Invariant`` - -* - ``Type_Invariant'Class`` +* ``Static_Predicate`` +* ``Dynamic_Predicate`` +* ``Pre`` +* ``Pre'Class`` +* ``Post`` +* ``Post'Class`` +* ``Type_Invariant`` +* ``Type_Invariant'Class`` *GNAT-specific* -* - ``Contract_Cases`` - -* - ``Invariant`` - -* - ``Invariant'Class`` - -* - ``Predicate`` - -* - ``Refined_Post`` +* ``Contract_Cases`` +* ``Invariant`` +* ``Invariant'Class`` +* ``Predicate`` +* ``Refined_Post`` .. rubric:: Example @@ -7129,8 +6653,6 @@ declarations are not checked. A declaration of a type that itself is not a descendant of a type declared in ``Ada.Finalization`` but has a controlled component is not checked. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -7153,8 +6675,6 @@ Flag all block statements containing local declarations. A ``declare`` block with an empty *declarative_part* or with a *declarative part* containing only pragmas and/or ``use`` clauses is not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -7276,8 +6796,6 @@ declarations of record and record extension types are checked. Incomplete, formal, private, derived and private extension type declarations are not checked. Task and protected type declarations also are not checked. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -7301,6 +6819,25 @@ This rule has no parameters. +.. _Enumeration_Representation_Clauses: + +``Enumeration_Representation_Clauses`` +-------------------------------------- + +.. index:: Enumeration_Representation_Clauses + +Flag enumeration representation clauses. + +.. rubric:: Example + +.. code-block:: ada + :emphasize-lines: 2 + + type Enum1 is (A1, B1, C1); + for Enum1 use (A1 => 1, B1 => 11, C1 => 111); -- FLAG + + + .. _Explicit_Full_Discrete_Ranges: ``Explicit_Full_Discrete_Ranges`` @@ -7310,8 +6847,6 @@ This rule has no parameters. Flag each discrete range that has the form ``A'First .. A'Last``. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -7342,8 +6877,6 @@ or an Inline pragma applied to it. If a generic subprogram declaration has an Inline aspect specified or pragma Inline applied, then only generic subprogram declaration is flagged but not its instantiations. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -7360,7 +6893,7 @@ This rule has no parameters. .. _Expression_Functions: ``Expression_Functions`` ---------------------------------- +------------------------ .. index:: Expression_Functions @@ -7368,8 +6901,6 @@ Flag each expression function declared in a package specification (including specification of local packages and generic package specifications). -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -7396,8 +6927,6 @@ that are renamings of the predefined equality operations. Also, the '``=``' and '``/=``' operations for floating-point types are not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -7480,8 +7009,6 @@ of a limited type, it is not flagged. Protected procedures are not flagged. Null procedures also are not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -7495,14 +7022,12 @@ This rule has no parameters. .. _Generic_IN_OUT_Objects: ``Generic_IN_OUT_Objects`` ---------------------------- +-------------------------- .. index:: Generic_IN_OUT_Objects Flag declarations of generic formal objects of mode IN OUT. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -7530,8 +7055,6 @@ If a generic unit is declared in a local package that is declared in a subprogram body, the generic unit is flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -7556,8 +7079,6 @@ Flag each occurrence of a formal parameter with an implicit ``in`` mode. Note that ``access`` parameters, although they technically behave like ``in`` parameters, are not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -7582,8 +7103,6 @@ Flag all generic instantiations in library-level package specs Instantiations in task and entry bodies are not flagged. Instantiations in the bodies of protected subprograms are flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -7605,8 +7124,6 @@ This rule has no parameters. Flag all library-level subprograms (including generic subprogram instantiations). -This rule has no parameters. - .. code-block:: ada :emphasize-lines: 2 @@ -7618,7 +7135,7 @@ This rule has no parameters. .. _Membership_Tests: ``Membership_Tests`` ---------------------------- +-------------------- .. index:: Membership_Tests @@ -7644,88 +7161,42 @@ for LKQL rule options files: *Language-defined* -* - ``Assert`` +* ``Assert`` *GNAT-specific* -* - ``Assert_And_Cut`` - -* - ``Assume`` - -* - ``Contract_Cases`` - -* - ``Debug`` - -* - ``Invariant`` - -* - ``Loop_Invariant`` - -* - ``Loop_Variant`` - -* - ``Postcondition`` - -* - ``Precondition`` - -* - ``Predicate`` - -* - ``Refined_Post`` +* ``Assert_And_Cut`` +* ``Assume`` +* ``Contract_Cases`` +* ``Debug`` +* ``Invariant`` +* ``Loop_Invariant`` +* ``Loop_Variant`` +* ``Postcondition`` +* ``Precondition`` +* ``Predicate`` +* ``Refined_Post`` *definition of the following aspects* *Language-defined* -* - ``Static_Predicate`` - -* - ``Dynamic_Predicate`` - -* - ``Pre`` - -* - ``Pre'Class`` - -* - ``Post`` - -* - ``Post'Class`` - -* - ``Type_Invariant`` - -* - ``Type_Invariant'Class`` +* ``Static_Predicate`` +* ``Dynamic_Predicate`` +* ``Pre`` +* ``Pre'Class`` +* ``Post`` +* ``Post'Class`` +* ``Type_Invariant`` +* ``Type_Invariant'Class`` *GNAT-specific* -* - ``Contract_Cases`` - -* - ``Invariant`` - -* - ``Invariant'Class`` - -* - ``Predicate`` - -* - ``Refined_Post`` +* ``Contract_Cases`` +* ``Invariant`` +* ``Invariant'Class`` +* ``Predicate`` +* ``Refined_Post`` These three parameters are independent on each other. @@ -7754,8 +7225,6 @@ string literal is not considered an aggregate, but an array aggregate of a string type is considered as a normal aggregate. Aggregates of anonymous array types are not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -7777,8 +7246,6 @@ This rule has no parameters. Number declarations are flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -7804,8 +7271,6 @@ 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. - .. rubric:: Example .. code-block:: ada @@ -7828,27 +7293,16 @@ This rule has no parameters. Flag each use of a numeric literal except for the following: -* - a literal occurring in the initialization expression for a constant +* a literal occurring in the initialization expression for a constant declaration or a named number declaration, or - -* - a literal occurring in an aspect definition or in an aspect clause, or - -* - an integer literal that is less than or equal to a value +* a literal occurring in an aspect definition or in an aspect clause, or +* an integer literal that is less than or equal to a value specified by the *N* rule parameter, or - -* - an integer literal that is the right operand of an infix call to an +* an integer literal that is the right operand of an infix call to an exponentiation operator, or - -* - an integer literal that denotes a dimension in array types attributes +* an integer literal that denotes a dimension in array types attributes ``First``, ``Last`` and ``Length``, or - -* - a literal occurring in a declaration in case the *Statements_Only* +* a literal occurring in a declaration in case the *Statements_Only* rule parameter is given. This rule may have the following parameters for the ``+R`` option and for @@ -7930,7 +7384,7 @@ rule parameters are listed above. .. _Predicate_Testing: ``Predicate_Testing`` ---------------------------- +--------------------- .. index:: Predicate_Testing @@ -7951,44 +7405,25 @@ for LKQL rule options files: A pragma or an aspect is considered as assertion-related if its name is from the following list: -* - ``Assert`` -* - ``Assert_And_Cut`` -* - ``Assume`` -* - ``Contract_Cases`` -* - ``Debug`` -* - ``Default_Initial_Condition`` -* - ``Dynamic_Predicate`` -* - ``Invariant`` -* - ``Loop_Invariant`` -* - ``Loop_Variant`` -* - ``Post`` -* - ``Postcondition`` -* - ``Pre`` -* - ``Precondition`` -* - ``Predicate`` -* - ``Predicate_Failure`` -* - ``Refined_Post`` -* - ``Static_Predicate`` -* - ``Type_Invariant`` +* ``Assert`` +* ``Assert_And_Cut`` +* ``Assume`` +* ``Contract_Cases`` +* ``Debug`` +* ``Default_Initial_Condition`` +* ``Dynamic_Predicate`` +* ``Invariant`` +* ``Loop_Invariant`` +* ``Loop_Variant`` +* ``Post`` +* ``Postcondition`` +* ``Pre`` +* ``Precondition`` +* ``Predicate`` +* ``Predicate_Failure`` +* ``Refined_Post`` +* ``Static_Predicate`` +* ``Type_Invariant`` .. rubric:: Example @@ -8005,22 +7440,112 @@ is from the following list: -.. _Relative_Delay_Statements: +.. _Quantified_Expressions: -``Relative_Delay_Statements`` ----------------------------------- +``Quantified_Expressions`` +-------------------------- -.. index:: Relative_Delay_Statements +.. index:: Quantified_Expressions -Relative delay statements are flagged. Delay until statements are not -flagged. +Flag use of quantified expression. -This rule has no parameters. +This rule has the following (optional) parameter for the ``+R`` option and +for LKQL rule options files: -.. rubric:: Example +*Except_Assertions: bool* + If ``true``, do not flag a conditional expression if it is a subcomponent + of the following constructs: -.. code-block:: ada - :emphasize-lines: 4 +*argument of the following pragmas* + +*Language-defined* + +* ``Assert`` + +*GNAT-specific* + +* ``Assert_And_Cut`` +* ``Assume`` +* ``Contract_Cases`` +* ``Debug`` +* ``Invariant`` +* ``Loop_Invariant`` +* ``Loop_Variant`` +* ``Postcondition`` +* ``Precondition`` +* ``Predicate`` +* ``Refined_Post`` + +*definition of the following aspects* + +*Language-defined* + +* ``Static_Predicate`` +* ``Dynamic_Predicate`` +* ``Pre`` +* ``Pre'Class`` +* ``Post`` +* ``Post'Class`` +* ``Type_Invariant`` +* ``Type_Invariant'Class`` + +*GNAT-specific* + +* ``Contract_Cases`` +* ``Invariant`` +* ``Invariant'Class`` +* ``Predicate`` +* ``Refined_Post`` + +.. rubric:: Example + +.. code-block:: ada + :emphasize-lines: 5, 6 + + subtype Ind is Integer range 1 .. 10; + type Matrix is array (Ind, Ind) of Integer; + + function Check_Matrix (M : Matrix) return Boolean is + (for some I in Ind => -- FLAG + (for all J in Ind => M (I, J) = 0)); -- FLAG + + + +.. _Raising_Predefined_Exceptions: + +``Raising_Predefined_Exceptions`` +--------------------------------- + +.. index:: Raising_Predefined_Exceptions + +Flag each ``raise`` statement that raises a predefined exception +(i.e., one of the exceptions ``Constraint_Error``, ``Numeric_Error``, +``Program_Error``, ``Storage_Error``, or ``Tasking_Error``). + +.. rubric:: Example + +.. code-block:: ada + :emphasize-lines: 2 + + begin + raise Constraint_Error; -- FLAG + + + +.. _Relative_Delay_Statements: + +``Relative_Delay_Statements`` +----------------------------- + +.. index:: Relative_Delay_Statements + +Relative delay statements are flagged. Delay until statements are not +flagged. + +.. rubric:: Example + +.. code-block:: ada + :emphasize-lines: 4 if I > 0 then delay until Current_Time + Big_Delay; @@ -8039,8 +7564,6 @@ This rule has no parameters. Flag renaming declarations. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -8054,7 +7577,7 @@ This rule has no parameters. .. _Representation_Specifications: ``Representation_Specifications`` ----------------------------------- +--------------------------------- .. index:: Representation_Specifications @@ -8089,146 +7612,6 @@ options files: -.. _Quantified_Expressions: - -``Quantified_Expressions`` --------------------------- - -.. index:: Quantified_Expressions - -Flag use of quantified expression. - -This rule has the following (optional) parameter for the ``+R`` option and -for LKQL rule options files: - -*Except_Assertions: bool* - If ``true``, do not flag a conditional expression if it is a subcomponent - of the following constructs: - -*argument of the following pragmas* - -*Language-defined* - -* - ``Assert`` - -*GNAT-specific* - -* - ``Assert_And_Cut`` - -* - ``Assume`` - -* - ``Contract_Cases`` - -* - ``Debug`` - -* - ``Invariant`` - -* - ``Loop_Invariant`` - -* - ``Loop_Variant`` - -* - ``Postcondition`` - -* - ``Precondition`` - -* - ``Predicate`` - -* - ``Refined_Post`` - -*definition of the following aspects* - -*Language-defined* - -* - ``Static_Predicate`` - -* - ``Dynamic_Predicate`` - -* - ``Pre`` - -* - ``Pre'Class`` - -* - ``Post`` - -* - ``Post'Class`` - -* - ``Type_Invariant`` - -* - ``Type_Invariant'Class`` - -*GNAT-specific* - -* - ``Contract_Cases`` - -* - ``Invariant`` - -* - ``Invariant'Class`` - -* - ``Predicate`` - -* - ``Refined_Post`` - -.. rubric:: Example - -.. code-block:: ada - :emphasize-lines: 5, 6 - - subtype Ind is Integer range 1 .. 10; - type Matrix is array (Ind, Ind) of Integer; - - function Check_Matrix (M : Matrix) return Boolean is - (for some I in Ind => -- FLAG - (for all J in Ind => M (I, J) = 0)); -- FLAG - - - -.. _Raising_Predefined_Exceptions: - -``Raising_Predefined_Exceptions`` ---------------------------------- - -.. index:: Raising_Predefined_Exceptions - -Flag each ``raise`` statement that raises a predefined exception -(i.e., one of the exceptions ``Constraint_Error``, ``Numeric_Error``, -``Program_Error``, ``Storage_Error``, or ``Tasking_Error``). - -This rule has no parameters. - -.. rubric:: Example - -.. code-block:: ada - :emphasize-lines: 2 - - begin - raise Constraint_Error; -- FLAG - - - .. _Separates: ``Separates`` @@ -8238,8 +7621,6 @@ This rule has no parameters. Flags subunits. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -8270,8 +7651,6 @@ This rule has no parameters. Flags simple loop statements (loop statements that do not have iteration schemes). -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -8299,8 +7678,6 @@ Flag all constructs that belong to access_to_subprogram_definition syntax category, and all access definitions that define access to subprogram. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -8314,37 +7691,6 @@ This rule has no parameters. -.. _Suspicious_Equalities: - -``Suspicious_Equalities`` -------------------------- - -.. index:: Suspicious_Equalities - -Flag 'or' expressions whose left and right operands are unequalities -referencing the same entity and a literal and 'and' expressions whose left and -right operands are equalities referencing the same entity and a literal. - -This rule has no parameters. - -.. rubric:: Example - -.. code-block:: ada - :emphasize-lines: 4, 7 - - procedure tmp is - X : Integer := 0; - begin - if X /= 1 or x /= 2 then -- FLAG - null; - end; - if x = 1 and then X = 2 then -- Flag - null; - end; - end; - - - .. _Too_Many_Dependencies: ``Too_Many_Dependencies`` @@ -8437,6 +7783,34 @@ options files: +.. _Unconditional_Exits: + +``Unconditional_Exits`` +----------------------- + +.. index:: Unconditional_Exits + +Flag unconditional ``exit`` statements. + +.. rubric:: Example + +.. code-block:: ada + :emphasize-lines: 8 + + procedure Find_A (S : String; Idx : out Natural) is + begin + Idx := 0; + + for J in S'Range loop + if S (J) = 'A' then + Idx := J; + exit; -- FLAG + end if; + end loop; + end Find_A; + + + .. _Unconstrained_Array_Returns: ``Unconstrained_Array_Returns`` @@ -8484,8 +7858,6 @@ for LKQL rule options files: Unconstrained array definitions are flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -8498,10 +7870,58 @@ This rule has no parameters. -Metrics-Related Rules -===================== +.. _USE_Clauses: + +``USE_Clauses`` +--------------- + +.. index:: USE_Clauses + +Flag names mentioned in use clauses. Use type clauses and names mentioned +in them are not flagged. + +This rule has the following optional parameter for the ``+R`` option and for +LKQL rule options files: + +*Exempt_Operator_Packages: bool* + If ``true``, do not flag a package name in a package use clause if it refers + to a package that only declares operators in its visible part. + +.. note:: + This rule has another parameter, only available when using an LKQL rule + options file: ``allowed``. It is a list of Ada names describing packages + to exempt from begin flagged when used in "use" clauses. Strings in this + list are case insensitive. Example: + + .. code-block:: lkql + + val rules = @{ + Use_Clauses: {Allowed: ["Ada.Strings.Unbounded", "Other.Package"]} + } + +.. rubric:: Example + +.. code-block:: ada + :emphasize-lines: 10, 11 + + package Pack is + I : Integer; + end Pack; + + package Operator_Pack is + function "+" (L, R : Character) return Character; + end Operator_Pack; + + with Pack, Operator_Pack; + use Pack; -- FLAG if "Pack" is not in Allowed + use Operator_Pack; -- FLAG only if Exempt_Operator_Packages is false + + -.. index:: Metrics-related rules +``Metrics-Related Rules`` +========================= + +.. index:: Metrics-Related_Rules The rules in this section can be used to enforce compliance with specific code metrics, by checking that the metrics computed for a program @@ -8539,91 +7959,91 @@ use the following option: -.. _Metrics_Essential_Complexity: +.. _Metrics_Cyclomatic_Complexity: -``Metrics_Essential_Complexity`` --------------------------------- +``Metrics_Cyclomatic_Complexity`` +--------------------------------- -.. index:: Metrics_Essential_Complexity +.. index:: Metrics_Cyclomatic_Complexity -The ``Metrics_Essential_Complexity`` rule takes a positive integer as +The ``Metrics_Cyclomatic_Complexity`` rule takes a positive integer as upper bound. A program unit that is an executable body exceeding this limit will be flagged. -The Ada essential complexity metric is a McCabe cyclomatic complexity metric counted -for the code that is reduced by excluding all the pure structural Ada control statements. +This rule has the following optional parameter for the ``+R`` option and for +LKQL rule options files: + +*Exempt_Case_Statements: bool* + Whether to count the complexity introduced by ``case`` statement or ``case`` + expression as 1. + +The McCabe cyclomatic complexity metric is defined +in `http://www.mccabe.com/pdf/mccabe-nist235r.pdf `_ +The goal of cyclomatic complexity metric is to estimate the number +of independent paths in the control flow graph that in turn gives the number +of tests needed to satisfy paths coverage testing completeness criterion. .. rubric:: Example .. code-block:: ada :emphasize-lines: 2 - -- if the rule parameter is 3 or less + -- if the rule parameter is 6 or less procedure Proc (I : in out Integer; S : String) is -- FLAG begin if I in 1 .. 10 then for J in S'Range loop if S (J) = ' ' then - if I > 10 then - exit; - else + if I < 10 then I := 10; end if; end if; I := I + Character'Pos (S (J)); end loop; + elsif S = "abs" then + if I > 0 then + I := I + 1; + end if; end if; end Proc; -.. _Metrics_Cyclomatic_Complexity: +.. _Metrics_Essential_Complexity: -``Metrics_Cyclomatic_Complexity`` ---------------------------------- +``Metrics_Essential_Complexity`` +-------------------------------- -.. index:: Metrics_Cyclomatic_Complexity +.. index:: Metrics_Essential_Complexity -The ``Metrics_Cyclomatic_Complexity`` rule takes a positive integer as +The ``Metrics_Essential_Complexity`` rule takes a positive integer as upper bound. A program unit that is an executable body exceeding this limit will be flagged. -This rule has the following optional parameter for the ``+R`` option and for -LKQL rule options files: - -*Exempt_Case_Statements: bool* - Whether to count the complexity introduced by ``case`` statement or ``case`` - expression as 1. - -The McCabe cyclomatic complexity metric is defined -in `http://www.mccabe.com/pdf/mccabe-nist235r.pdf `_ -The goal of cyclomatic complexity metric is to estimate the number -of independent paths in the control flow graph that in turn gives the number -of tests needed to satisfy paths coverage testing completeness criterion. +The Ada essential complexity metric is a McCabe cyclomatic complexity metric counted +for the code that is reduced by excluding all the pure structural Ada control statements. .. rubric:: Example .. code-block:: ada :emphasize-lines: 2 - -- if the rule parameter is 6 or less + -- if the rule parameter is 3 or less procedure Proc (I : in out Integer; S : String) is -- FLAG begin if I in 1 .. 10 then for J in S'Range loop if S (J) = ' ' then - if I < 10 then + if I > 10 then + exit; + else I := 10; end if; end if; I := I + Character'Pos (S (J)); end loop; - elsif S = "abs" then - if I > 0 then - I := I + 1; - end if; end if; end Proc; @@ -8669,10 +8089,10 @@ LKQL rule options files: -SPARK 2005 Rules -================ +``SPARK-Related Rules`` +======================= -.. index:: SPARK related rules +.. index:: SPARK-Related_Rules The rules in this section can be used to enforce compliance with the Ada subset allowed by the SPARK 2005 language. @@ -8778,8 +8198,6 @@ with these designators, and uses of operators that are renamings of the predefined relational operators for ``Standard.Boolean``, are likewise not detected. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -8800,8 +8218,6 @@ This rule has no parameters. Flag all expanded loop names in ``exit`` statements. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -8880,8 +8296,6 @@ any other attribute is flagged. * ``'Val`` * ``'Valid`` -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -8903,8 +8317,6 @@ This rule has no parameters. Flag all derived type declarations that do not have a record extension part. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -8928,8 +8340,6 @@ This rule has no parameters. Flag each ``exit`` statement containing a loop name that is not the name of the immediately enclosing ``loop`` statement. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -8958,8 +8368,6 @@ A function body or an expression function is checked only if it does not have a separate spec. Formal functions are also checked. For a renaming declaration, only renaming-as-declaration is checked. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -8983,8 +8391,6 @@ This rule has no parameters. Flag all uses of array slicing -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -9009,8 +8415,6 @@ are both of type *universal_integer*. Ranges that have at least one bound of a specific type (such as ``1 .. N``, where ``N`` is a variable or an expression of non-universal type) are not flagged. -This rule has no parameters. - .. rubric:: Example .. code-block:: ada @@ -9020,3 +8424,6 @@ This rule has no parameters. S1 : String (L .. 10); S2 : String (1 .. 10); -- FLAG + + + diff --git a/lkql_checker/doc/gnatcheck_rm.rst b/lkql_checker/doc/gnatcheck_rm.rst index b861064c9..ec6618493 100644 --- a/lkql_checker/doc/gnatcheck_rm.rst +++ b/lkql_checker/doc/gnatcheck_rm.rst @@ -22,7 +22,7 @@ A copy of the license is included in the section entitled gnatcheck_rm/getting_started gnatcheck_rm/using_gnatcheck - gnatcheck_rm/predefined_rules + generated/predefined_rules gnatcheck_rm/writing_your_own_rules gnatcheck_rm/lkql_language_reference @@ -33,5 +33,5 @@ A copy of the license is included in the section entitled .. toctree:: :maxdepth: 2 - gnatcheck_rm/list_of_rules + generated/list_of_rules share/gnu_free_documentation_license diff --git a/lkql_checker/doc/stubs/restrictions.lkql b/lkql_checker/doc/stubs/restrictions.lkql new file mode 100644 index 000000000..9c1ae9968 --- /dev/null +++ b/lkql_checker/doc/stubs/restrictions.lkql @@ -0,0 +1,58 @@ +@stub_check(category="Style", subcategory="Programming Practice") +fun restrictions() = + |" Flags violations of Ada predefined and GNAT-specific restrictions + |" according to the rule parameter(s) specified. + |" + |" ``gnatcheck`` does not check Ada or GNAT restrictions itself, instead + |" it compiles an argument source with a configuration file that + |" defines restrictions of interest, + |" analyses the style warnings generated by the GNAT compiler and + |" includes the information about restriction violations detected into + |" the ``gnatcheck`` messages. + |" + |" This rule allows parametric rule exemptions, the parameters + |" that are allowed in the definition of exemption sections are + |" the names of the restrictions except for the case when a restriction + |" requires a non-numeric parameter, in this case the parameter should be + |" the name of the restriction with the parameter, as it is given for the + |" rule. + |" + |" The rule should have a parameter, the format of the rule parameter is the + |" same as the parameter of + |" the pragma ``Restrictions`` or ``Restriction_Warnings``. + |" + |" .. note:: + |" In LKQL rule options files, this rule should have an ``Arg`` named parameter + |" associated to a list of strings. Each element of this list should be a + |" restriction parameter, for example: + |" + |" .. code-block:: lkql + |" + |" val rules = @{ + |" Restrictions: {Arg: ["Max_Task_Entries=>2", "No_Access_Subprograms"]} + |" } + |" + |" If your code contains pragmas ``Warnings`` with parameter ``Off``, this may + |" result in false negatives for this rule, because the corresponding warnings + |" generated during compilation will be suppressed. The workaround is to + |" use for ``gnatcheck`` call a configuration file that + |" contains ``pragma Ignore_Pragma (Warnings);``. + |" + |" .. warning:: Note, that some restriction checks cannot be performed by gnatcheck + |" because they are either dynamic or require information from the code + |" generation phase. For such restrictions gnatcheck generates the + |" corresponding warnings and disables the ``Restrictions`` rules. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1,6 + |" + |" with Ada.Finalization; -- FLAG (+RRestrictions:No_Dependence=>Ada.Finalization) + |" procedure Proc is + |" type Access_Integer is access Integer; + |" Var : Access_Integer; + |" begin + |" Var := new Integer'(1); -- FLAG (+RRestrictions:No_Allocators) + |" end Proc; + () diff --git a/lkql_checker/doc/stubs/style_checks.lkql b/lkql_checker/doc/stubs/style_checks.lkql new file mode 100644 index 000000000..1f786400e --- /dev/null +++ b/lkql_checker/doc/stubs/style_checks.lkql @@ -0,0 +1,57 @@ +@stub_check(category="Style", subcategory="Readability") +fun style_checks() = + |" Flags violations of the source code presentation and formatting rules + |" specified in the `Style Checking `_ + |" section of the ``GNAT User's Guide`` according to the rule parameter(s) + |" specified. + |" + |" ``gnatcheck`` does not check GNAT style rules itself, instead it compiles + |" an argument source with the needed style check compilation options, + |" analyses the style messages generated by the GNAT compiler and + |" includes the information about style violations detected into + |" the ``gnatcheck`` messages. + |" + |" This rule takes a parameter in one of the following forms: + |" + |" * *All_Checks*, which enables the standard style checks corresponding + |" to the ``-gnatyy`` GNAT style check option, + |" + |" * A string with the same + |" structure and semantics as the ``string_LITERAL`` parameter of the + |" GNAT pragma ``Style_Checks`` + |" (see ``Pragma Style_Checks`` in the GNAT Reference Manual). + |" + |" For instance, the ``+RStyle_Checks:O`` rule option activates + |" the compiler style check that corresponds to ``-gnatyO`` style check option. + |" + |" .. note:: + |" In LKQL rule options files, this rule should have an ``Arg`` named parameter + |" associated to a string corresponding to the wanted GNAT style checks + |" switches. Example: + |" + |" .. code-block:: lkql + |" + |" val rules = @{ Style_Checks: {Arg: "xz"} } + |" + |" You can also use the shortcut argument format by associating a simple string + |" to the rule name: + |" + |" .. code-block:: lkql + |" + |" val rules = @{ + |" Style_Checks: "xz" + |" } + |" + |" This rule allows parametric rule exemptions, the parameters + |" that are allowed in the definition of exemption sections are the + |" same as the parameters of the rule itself. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" package Pack is + |" I : Integer; + |" end; -- FLAG (for +RStyle_Checks:e) + () diff --git a/lkql_checker/doc/stubs/warnings.lkql b/lkql_checker/doc/stubs/warnings.lkql new file mode 100644 index 000000000..ced795ab1 --- /dev/null +++ b/lkql_checker/doc/stubs/warnings.lkql @@ -0,0 +1,67 @@ +@stub_check(category="Style", subcategory="Programming Practice") +fun warnings() = + |" Flags construct that would result in issuing a GNAT warning if an argument + |" source would be compiled with warning options corresponding to the rule + |" parameter(s) specified. For GNAT warnings and corresponding warning control + |" options see the `Warning Message Control `_ section of the GNAT User's Guide. + |" + |" ``gnatcheck`` does not check itself if this or that construct would result + |" in issuing a warning, instead it compiles the project sources with the + |" needed warning control compilation options combined with the ``-gnatc`` + |" switch, analyses the warnings generated by GNAT and adds the relevant + |" information to the ``gnatcheck`` messages. + |" + |" The rule should have a parameter, the format of the parameter should + |" be a valid ``static_string_expression`` listing GNAT warnings switches + |" (the letter following ``-gnatw`` in the `Warning Message Control` section + |" mentioned above). + |" + |" .. note:: + |" In LKQL rule options files, this rule should have an ``Arg`` named parameter + |" associated to a string corresponding to the wanted GNAT warning switches. + |" Example: + |" + |" .. code-block:: lkql + |" + |" val rules = @{ Warnings: {Arg: "u"} } + |" + |" You can also use the shortcut argument format by associating a simple string + |" to the rule name: + |" + |" .. code-block:: lkql + |" + |" val rules = @{ + |" Warnings: "u" + |" } + |" + |" Note that ``s`` and ``e`` parameters, corresponding respectively to GNAT + |" ``-gnatws`` and ``-gnatwe`` options, are not allowed for the ``Warnings`` + |" GNATcheck rule since they may have side effects on other rules. + |" + |" Note also that some GNAT warnings are only emitted when generating code, + |" these warnings will not be generated by this rule. In other words, this + |" rule will only generate warnings that are enabled when using ``-gnatc``. + |" + |" If your code contains pragmas ``Warnings`` with parameter ``Off``, this may + |" result in false negatives for this rule, because the corresponding warnings + |" generated during compilation will be suppressed. The workaround is to + |" use a configuration file that contains ``pragma Ignore_Pragma (Warnings);`` + |" when running ``gnatcheck``. + |" + |" This rule allows parametric rule exemptions, the parameters + |" that are allowed in the definition of exemption sections are the + |" same as the parameters of the rule itself. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1,4 + |" + |" with Ada.Text_IO; -- FLAG (+RWarnings:u) + |" procedure Proc (I : in out Integer) is + |" begin + |" pragma Unrecognized; -- FLAG (+RWarnings:g) + |" + |" I := I + 1; + |" end Proc; + () diff --git a/lkql_checker/share/lkql/abort_statements.lkql b/lkql_checker/share/lkql/abort_statements.lkql index 0d62eb4d4..a19aba304 100644 --- a/lkql_checker/share/lkql/abort_statements.lkql +++ b/lkql_checker/share/lkql/abort_statements.lkql @@ -1,4 +1,13 @@ -# Flag abort statements. - @check(message="abort statement", category="Feature") -fun abort_statements(node) = node is AbortStmt +fun abort_statements(node) = + |" Flag abort statements. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" if Flag then + |" abort T; -- FLAG + |" end if; + node is AbortStmt diff --git a/lkql_checker/share/lkql/abstract_type_declarations.lkql b/lkql_checker/share/lkql/abstract_type_declarations.lkql index 281893ace..dd725188d 100644 --- a/lkql_checker/share/lkql/abstract_type_declarations.lkql +++ b/lkql_checker/share/lkql/abstract_type_declarations.lkql @@ -1,9 +1,21 @@ -# Flag all declarations of abstract types, including generic formal types. For -# an abstract private type, the full type declarations is flagged only if it is -# itself declared as abstract. Interface types are not flagged. - @check(message="declaration of abstract type", help="abstract types", category="Feature") fun abstract_type_declarations(node) = + |" Flag all declarations of abstract types, including generic formal types. + |" For an abstract private type, the full type declarations is flagged + |" only if it is itself declared as abstract. Interface types are not + |" flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2, 5 + |" + |" package Foo is + |" type Figure is abstract tagged private; -- FLAG + |" procedure Move (X : in out Figure) is abstract; + |" private + |" type Figure is abstract tagged null record; -- FLAG + |" end Foo; node is (RecordTypeDef | DerivedTypeDef | PrivateTypeDef) when node.f_has_abstract.p_as_bool() diff --git a/lkql_checker/share/lkql/access_to_local_objects.lkql b/lkql_checker/share/lkql/access_to_local_objects.lkql index 9955b293b..9634966d0 100644 --- a/lkql_checker/share/lkql/access_to_local_objects.lkql +++ b/lkql_checker/share/lkql/access_to_local_objects.lkql @@ -1,15 +1,3 @@ -# Flag any `'Access' attribute reference if its prefix denotes an -# identifier defined by a local object declaration or a subcomponent -# thereof. -# -# An object declaration is considered as local if it is located -# anywhere except library-level packages or bodies of library-level -# packages (including packages nested in those). Here both package -# declarations and package instantiations are considered as packages. -# -# If the attribute prefix is a dereference or a subcomponent thereof, the -# attribute reference is not flagged. - import stdlib fun has_access_type(n) = @@ -46,6 +34,24 @@ fun denotes_local_object(n) = { @check(message="access attribute for local objects", category="Style", subcategory="Programming Practice") fun access_to_local_objects(node) = + |" Flag any ``'Access`` attribute reference if its prefix denotes an identifier + |" defined by a local object declaration or a subcomponent thereof. An object + |" declaration is considered as local if it is located anywhere except library-level + |" packages or bodies of library-level packages (including packages nested + |" in those). Here both package declarations and package instantiations are + |" considered as packages. If the attribute prefix is a dereference or + |" a subcomponent thereof, the attribute reference is not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5 + |" + |" package body Pack + |" procedure Proc is + |" type Int_A is access all Integer; + |" Var1 : aliased Integer; + |" Var2 : Int_A := Var1'Access; -- FLAG node is AttributeRef when node.f_attribute.p_name_is("Access") and denotes_local_object(node.f_prefix) diff --git a/lkql_checker/share/lkql/actual_parameters.lkql b/lkql_checker/share/lkql/actual_parameters.lkql index ea179618f..12f7acb7a 100644 --- a/lkql_checker/share/lkql/actual_parameters.lkql +++ b/lkql_checker/share/lkql/actual_parameters.lkql @@ -1,15 +1,3 @@ -# Given a list of (Entity, Formal, Actual), flag each occurrence of -# association lists coming from a subprogram call where Actual is used as -# Formal parameter on Entity. -# Actual is a fully qualified name and denotes an object or subprogram, ignoring -# any parens, type conversion or type qualification. -# (internal LKQL only) If Actual starts with "|" then the rest of the string -# is used as a regular expression as defined in s-regpat.ads with a case -# insensitive match. -# For GNATcheck: if Actual is within quotes ("") then the string is used as a -# regular expression as defined in s-regpat.ads with a case insensitive match. -# Entity, Formal and Actual are compared in a case insensitive manner. - fun strip(node) = match node # Strip parenthesis @@ -35,6 +23,80 @@ fun check_actual(name, expected) = @check(message="actual parameter mismatch", category="Style", subcategory="Programming Practice") fun actual_parameters(node, forbidden=[]) = + |" Flag situations when a specific actual parameter is passed for a specific formal + |" parameter in the call to a specific subprogram. Subprograms, formal parameters and + |" actual parameters to check are specified by the rule parameters. + |" + |" The rule has an optional parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Forbidden: list[string]* + |" A list of strings formatted as following: ``subprogram:formal:actual`` where + |" ``subprogram`` should be a full expanded Ada name of a subprogram, ``formal`` + |" should be an identifier, it is treated as the name of a formal parameter of + |" the ``subprogram`` and ``actual`` should be a full expanded Ada name of a + |" function or a data object declared by object declaration, number declaration, + |" parameter specification, generic object declaration or object renaming + |" declaration. + |" + |" .. note:: + |" In LKQL rule options files, the ``Forbidden`` parameter should be a list + |" of three-elements tuples. Mapping ``subprogram:formal:actual`` to + |" ``(, , )``. For example: + |" + |" .. code-block:: lkql + |" + |" val rules = @{ + |" Actual_Parameters: {Forbidden: [("P.SubP", "Param", "Value")]} + |" } + |" + |" For all the calls to ``subprogram`` the rule checks if the called subprogram + |" has a formal parameter named as ``formal``, and if it does, it checks + |" if the actual for this parameter is either a call to a function denoted by + |" ``actual`` or a reference to the data object denoted by ``actual`` + |" or one of the above in parenthesis, or a type conversion or a qualified + |" expression applied to one of the above. References to object components or + |" explicit dereferences are not checked. + |" + |" Be aware that the rule does not follow renamings. The rule checks only calls that + |" use the ``subprogram`` part of the rule parameter as a called name, and if this + |" name is declared by a subprogram renaming, the rule does not pay attention to + |" the calls that use subprogram name being renamed. When looking for the parameter + |" to check, the rule assumes that a formal parameter denoted by the ``formal`` + |" part of the rule parameter is declared as a part of the declaration of + |" ``subprogram``. The same for the ``actual`` part of the rule parameter - only + |" those actual parameters that use ``actual`` as the name of a called function + |" are considered. This is a user responsibility to provide as the rule + |" parameters all needed combinations of subprogram name and formal parameter name for + |" the subprogram of interest in case if renamings are used for the subprogram, + |" and all possible aliases if renaming is used for a function of interest if + |" its calls may be used as actuals. + |" + |" Note also, that the rule does not make any overload resolution, so it will consider + |" all possible subprograms denoted by the ``subprogram`` part of the rule parameter, + |" and all possible function denoted by the ``actual`` part. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 16 + |" + |" -- Suppose the rule parameter is P.Proc:Par2:Q.Var + |" package P is + |" procedure Proc (B : Boolean; I : Integer); + |" procedure Proc (Par1 : Character; Par2 : Integer); + |" end P; + |" + |" package Q is + |" Var : Integer; + |" end Q; + |" + |" with P; use P; + |" with Q; use Q; + |" procedure Main is + |" begin + |" Proc (True, Var); -- NO FLAG + |" Proc (1, Var); -- FLAG node is AssocList(parent: call@CallExpr(p_is_call(): true)) when { val n = call.f_name.p_referenced_decl() diff --git a/lkql_checker/share/lkql/ada05_formal_packages.lkql b/lkql_checker/share/lkql/ada05_formal_packages.lkql index aed382c66..5f2276fa2 100644 --- a/lkql_checker/share/lkql/ada05_formal_packages.lkql +++ b/lkql_checker/share/lkql/ada05_formal_packages.lkql @@ -1,11 +1,18 @@ -# Flag each occurrence of a formal_package_declaration which is not allowed in -# Ada 95. -# In other words, each formal_package_declaration when the box symbol (<>) is -# used except when used alone with no designator and no other parameter. - @check(message="Ada 2005 formal package declaration", category="Style", subcategory="Programming Practice") fun ada05_formal_packages(node) = + |" Flag formal package declarations that are not allowed in Ada 95. Ada 95 allows + |" the box symbol ``(<>)`` to be used alone as a whole formal package actual + |" part only. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" generic + |" with package NP is new P (T => <>); -- FLAG + |" package Pack_G is node is GenericPackageInstantiation(parent: GenericFormalPackage) when { val num_box = [p for p in node.f_params.children diff --git a/lkql_checker/share/lkql/ada_2022_in_ghost_code.lkql b/lkql_checker/share/lkql/ada_2022_in_ghost_code.lkql index 009bedaac..76422050c 100644 --- a/lkql_checker/share/lkql/ada_2022_in_ghost_code.lkql +++ b/lkql_checker/share/lkql/ada_2022_in_ghost_code.lkql @@ -46,5 +46,43 @@ fun is_in_ghost_code(node) = category="Style", subcategory="Programming Practice", follow_generic_instantiations=true) fun ada_2022_in_ghost_code(node) = - |" Check that no Ada 2022 construct is used outside of ghost code + |" Flag usages of Ada 2022 specific constructions used outside of Ghost code and + |" Assertion code. + |" + |" This check is meant to allow users to use the new standard in code that is not + |" shipped with the final executable version of their application. + |" + |" You can check this page + |" https://learn.adacore.com/courses/whats-new-in-ada-2022/index.html for a quick + |" overview of the new features of Ada 2022. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" + |" procedure Test_Ghost_Code is + |" A : String := "hello"; + |" + |" B : String := A'Image; -- FLAG + |" + |" procedure Foo + |" with Pre => A'Image = "hello"; -- NOFLAG + |" + |" B : String := A'Image with Ghost; -- NOFLAG + |" + |" function Bar return String is (A'Image) with Ghost; -- NOFLAG + |" + |" package P with Ghost is + |" B : String := A'Image; -- NOFLAG + |" end P; + |" + |" generic + |" package Gen_Pkg is + |" B : String := A'Image; -- FLAG (via instantiation line 23) + |" end Gen_Pkg; + |" + |" package Inst is new Gen_Pkg; + |" begin + |" null; + |" end Test_Ghost_Code; not stdlib.in_generic_template(node) and is_ada_2022(node) and not is_in_ghost_code(node) diff --git a/lkql_checker/share/lkql/address_attribute_for_non_volatile_objects.lkql b/lkql_checker/share/lkql/address_attribute_for_non_volatile_objects.lkql index 4b2dc0ebc..feefa13c4 100644 --- a/lkql_checker/share/lkql/address_attribute_for_non_volatile_objects.lkql +++ b/lkql_checker/share/lkql/address_attribute_for_non_volatile_objects.lkql @@ -1,10 +1,3 @@ -# Flag any 'Address attribute reference if its prefix denotes a data -# object defined by a variable object declaration and this object is not -# marked as Volatile. -# -# An entity is considered as being marked volatile if it has an aspect Volatile, -# Atomic or Shared declared for it. - import stdlib fun is_non_volatile_object(o) = @@ -16,6 +9,21 @@ fun is_non_volatile_object(o) = @check(message="address attribute for non-volatile object", category="Style", subcategory="Programming Practice") fun address_attribute_for_non_volatile_objects(node) = + |" Flag any 'Address attribute reference if its prefix denotes a data + |" object defined by a variable object declaration and this object is not + |" marked as Volatile. An entity is considered as being marked volatile + |" if it has an aspect Volatile, Atomic or Shared declared for it. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5 + |" + |" Var1 : Integer with Volatile; + |" Var2 : Integer; + |" + |" X : Integer with Address => Var1'Address; + |" Y : Integer with Address => Var2'Address; -- FLAG node is AttributeRef when node.f_attribute?.p_name_is("Address") and (not (node.parent is AttributeDefClause diff --git a/lkql_checker/share/lkql/address_specifications_for_initialized_objects.lkql b/lkql_checker/share/lkql/address_specifications_for_initialized_objects.lkql index c21ee21a6..19fed4043 100644 --- a/lkql_checker/share/lkql/address_specifications_for_initialized_objects.lkql +++ b/lkql_checker/share/lkql/address_specifications_for_initialized_objects.lkql @@ -1,9 +1,19 @@ -# Flag address clauses and address aspect definitions if they are applied -# to object declarations with explicit initializations. - @check(message="address specification for initialized object", category="Style", subcategory="Programming Practice") fun address_specifications_for_initialized_objects(node) = + |" Flag address clauses and address aspect definitions if they are applied + |" to object declarations with explicit initializations. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5 + |" + |" I : Integer := 0; + |" Var0 : Integer with Address => I'Address; + |" + |" Var1 : Integer := 10; + |" for Var1'Address use Var0'Address; -- FLAG # for X'Address use ... node is (a@AttributeDefClause( f_attribute_expr: AttributeRef( diff --git a/lkql_checker/share/lkql/address_specifications_for_local_objects.lkql b/lkql_checker/share/lkql/address_specifications_for_local_objects.lkql index 275697560..f9c729467 100644 --- a/lkql_checker/share/lkql/address_specifications_for_local_objects.lkql +++ b/lkql_checker/share/lkql/address_specifications_for_local_objects.lkql @@ -1,10 +1,26 @@ -# Flag address clauses and address aspect definitions if they are applied -# to data objects declared in local subprogram bodies. Data objects -# declared in library subprogram bodies are not flagged. - @check(message="address specification for local object", category="Style", subcategory="Programming Practice") fun address_specifications_for_local_objects(node) = + |" Flag address clauses and address aspect definitions if they are applied + |" to data objects declared in local subprogram bodies. Data objects + |" declared in library subprogram bodies are not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 7 + |" + |" package Pack is + |" Var : Integer; + |" procedure Proc (I : in out Integer); + |" end Pack; + |" package body Pack is + |" procedure Proc (I : in out Integer) is + |" Tmp : Integer with Address => Pack.Var'Address; -- FLAG + |" begin + |" I := Tmp; + |" end Proc; + |" end Pack; node is ObjectDecl (any parent: s@SubpBody when not s.parent is LibraryItem) when node.p_has_aspect("Address") diff --git a/lkql_checker/share/lkql/annotated_comments.lkql b/lkql_checker/share/lkql/annotated_comments.lkql index 5865f0858..059a32799 100644 --- a/lkql_checker/share/lkql/annotated_comments.lkql +++ b/lkql_checker/share/lkql/annotated_comments.lkql @@ -1,18 +1,83 @@ -# Flags comments that are used as annotations or as special sentinels/markers. -# Such comments have the following structure: -# -- * - import stdlib @unit_check(help="use of comment annotations", remediation="EASY", category="SPARK") -fun annotated_comments(unit, s=[]) = if not s then [] else [ - {message: "annotated comment", loc: tok} - for tok in unit.tokens - if tok.kind == "comment" and - [str for str in s if - tok.text.starts_with("--" & str.substring(1, 1)) and - tok.text - .substring(stdlib.first_non_blank(tok.text, 4), tok.text.length) - .starts_with(str.substring(2, str.length))] -] +fun annotated_comments(unit, s=[]) = + |" Flags comments that are used as annotations or as + |" special sentinels/markers. Such comments have the following + |" structure:: + |" + |" -- + |" + |" where + |" + |" ** is a character (such as '#', '$', '|' etc.) + |" indicating that the comment is used for a specific purpose + |" + |" ** is a word identifying the annotation or special usage + |" (word here is any sequence of characters except white space) + |" + |" There may be any amount of white space (including none at all) between + |" ```` and ````, but no white space + |" is permitted between ``'--'`` and ````. (A + |" white space here is either a space character or horizontal tabulation) + |" + |" ```` must not contain any white space. + |" + |" ```` may be empty, in which case the rule + |" flags each comment that starts with ``--`` and + |" that does not contain any other character except white space + |" + |" The rule has the following mandatory parameter for the ``+R`` option and for + |" LKQL rule options files: + |" + |" *S: list[string]* + |" List of string with the following interpretation: the first character + |" is the special comment character, and the rest is the comment marker. + |" Items must not contain any white space. + |" + |" The rule is case-sensitive. + |" + |" Example: + |" + |" The rule + |" + |" :: + |" + |" +RAnnotated_Comments:#hide + |" + |" will flag the following comment lines + |" + |" .. code-block:: ada + |" + |" --#hide + |" --# hide + |" --# hide + |" + |" I := I + 1; --# hide + |" + |" But the line + |" + |" .. code-block:: ada + |" + |" -- # hide + |" + |" will not be flagged, because of the space between '--' and '#'. + |" + |" The line + |" + |" .. code-block:: ada + |" + |" --#Hide + |" + |" will not be flagged, because the string parameter is case sensitive. + if not s then [] else [ + {message: "annotated comment", loc: tok} + for tok in unit.tokens + if tok.kind == "comment" and + [str for str in s if + tok.text.starts_with("--" & str.substring(1, 1)) and + tok.text + .substring(stdlib.first_non_blank(tok.text, 4), tok.text.length) + .starts_with(str.substring(2, str.length))] + ] diff --git a/lkql_checker/share/lkql/anonymous_access.lkql b/lkql_checker/share/lkql/anonymous_access.lkql index 9b2bf8ef7..af2135ef0 100644 --- a/lkql_checker/share/lkql/anonymous_access.lkql +++ b/lkql_checker/share/lkql/anonymous_access.lkql @@ -1,6 +1,26 @@ -# Flag all objects and components of an anonymous access type. - @check(message="anonymous access type", category="Feature") fun anonymous_access(node) = + |" Flag object declarations, formal object declarations and component declarations with + |" anonymous access type definitions. Discriminant specifications and parameter + |" specifications are not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 10, 13 + |" + |" procedure Anon (X : access Some_Type) is -- NO FLAG + |" type Square + |" (Location : access Coordinate) -- NO FLAG + |" is record + |" null; + |" end record; + |" + |" type Cell is record + |" Some_Data : Integer; + |" Next : access Cell; -- FLAG + |" end record; + |" + |" Link : access Cell; -- FLAG node is AnonymousTypeDecl(any parent: ObjectDecl | ComponentDecl, f_type_def: TypeAccessDef) diff --git a/lkql_checker/share/lkql/anonymous_arrays.lkql b/lkql_checker/share/lkql/anonymous_arrays.lkql index 680855fb3..b4055642e 100644 --- a/lkql_checker/share/lkql/anonymous_arrays.lkql +++ b/lkql_checker/share/lkql/anonymous_arrays.lkql @@ -1,8 +1,16 @@ -# Flag all anonymous array type definitions (by Ada semantics these can -# only occur in object declarations). - @check(message="anonymous array type", category="Style", subcategory="Programming Practice") fun anonymous_arrays(node) = + |" Flag all anonymous array type definitions (by Ada semantics these can only + |" occur in object declarations). + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" type Arr is array (1 .. 10) of Integer; + |" Var1 : Arr; + |" Var2 : array (1 .. 10) of Integer; -- FLAG node is AnonymousTypeDecl(any parent: ObjectDecl, f_type_def: ArrayTypeDef) diff --git a/lkql_checker/share/lkql/anonymous_subtypes.lkql b/lkql_checker/share/lkql/anonymous_subtypes.lkql index e36fb14a2..08e20058c 100644 --- a/lkql_checker/share/lkql/anonymous_subtypes.lkql +++ b/lkql_checker/share/lkql/anonymous_subtypes.lkql @@ -1,22 +1,3 @@ -# Flag all uses of anonymous subtypes except for the following: -# - when the subtype indication depends on a discriminant, this includes the -# cases of a record component definitions when a component depends on a -# discriminant, and using the discriminant of the derived type to constrain -# the parent type; -# - when a self-referenced data structure is defined, and a discriminant is -# constrained by the reference to the current instance of a type; -# -# A use of an anonymous subtype is any instance of a subtype indication -# with a constraint, other than one that occurs immediately within a -# subtype declaration (that is, a Range or DiscriminantConstraint of a -# SubtypeDecl). Any use of a range other than as a constraint used -# immediately within a subtype declaration is considered as an anonymous -# subtype. -# -# The rule does not flag ranges in the component clauses from a record -# representation clause, because the language rules do not allow to use -# subtype names there. - # Any part of the tree is a discriminant of the enclosing type decl fun is_using_discriminant(node, type_decl) = type_decl and @@ -39,6 +20,45 @@ fun is_self_referencing(expr, type_decl) = @check(message="anonymous subtype", category="Feature") fun anonymous_subtypes(node) = + |" Flag all uses of anonymous subtypes except for the following: + |" + |" * when the subtype indication depends on a discriminant, this includes the + |" cases of a record component definitions when a component depends on a + |" discriminant, and using the discriminant of the derived type to + |" constraint the parent type; + |" * when a self-referenced data structure is defined, and a discriminant + |" is constrained by the reference to the current instance of a type; + |" + |" A use of an anonymous subtype is + |" any instance of a subtype indication with a constraint, other than one + |" that occurs immediately within a subtype declaration. Any use of a range + |" other than as a constraint used immediately within a subtype declaration + |" is considered as an anonymous subtype. + |" + |" The rule does not flag ranges in the component clauses from a record + |" representation clause, because the language rules do not allow to use + |" subtype names there. + |" + |" An effect of this rule is that ``for`` loops such as the following are + |" flagged (since ``1..N`` is formally a 'range') + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" for I in 1 .. N loop -- FLAG + |" ... + |" end loop; + |" + |" Declaring an explicit subtype solves the problem: + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" subtype S is Integer range 1..N; + |" ... + |" for I in S loop -- NO FLAG + |" ... + |" end loop; node is ((SubtypeIndication(f_constraint: constraint@Constraint) when (not (constraint is CompositeConstraint(p_is_discriminant_constraint(): true) diff --git a/lkql_checker/share/lkql/at_representation_clauses.lkql b/lkql_checker/share/lkql/at_representation_clauses.lkql index d23fa7573..cb8fc7479 100644 --- a/lkql_checker/share/lkql/at_representation_clauses.lkql +++ b/lkql_checker/share/lkql/at_representation_clauses.lkql @@ -1,5 +1,21 @@ -# Flag each Ada 83 representation clauses "use at" and "at mod". - @check(message="AT representation clause", category="Feature") fun at_representation_clauses(node) = + |" Flag at clauses and mod clauses (treated as obsolescent features in + |" the Ada Standard). + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2, 9 + |" + |" Id : Integer; + |" for Id use at Var'Address; -- FLAG + |" + |" type Rec is record + |" Field : Integer; + |" end record; + |" + |" for Rec use + |" record at mod 2; -- FLAG + |" end record; node is (AtClause | RecordRepClause(f_at_expr: not null)) diff --git a/lkql_checker/share/lkql/binary_case_statements.lkql b/lkql_checker/share/lkql/binary_case_statements.lkql index c752b3e4f..00e6641f0 100644 --- a/lkql_checker/share/lkql/binary_case_statements.lkql +++ b/lkql_checker/share/lkql/binary_case_statements.lkql @@ -1,12 +1,28 @@ -# Flag a case statement if this statement has only two alternatives, one -# containing exactly one choice, the other containing exactly one choice -# or the `OTHERS' choice. -# This rule has an optional parameter Except_Enums: exclude case statements on -# enumerated types. - @check(message="CASE statement can be replaced with IF statement", category="Style", subcategory="Programming Practice") fun binary_case_statements(node, except_enums = false) = + |" Flag a case statement if this statement has only two alternatives, one + |" containing exactly one choice, the other containing exactly one choice + |" or the ``others`` choice. + |" + |" The rule has an optional parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Except_Enums: bool* + |" If ``true``, do not flag case statements whose selecting expression is of an + |" enumeration type. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" case Var is -- FLAG + |" when 1 => + |" Var := Var + 1; + |" when others => + |" null; + |" end case; node is CaseStmt( f_alternatives: CaseStmtAlternativeList( all children(depth=1): a@CaseStmtAlternative diff --git a/lkql_checker/share/lkql/bit_records_without_layout_definition.lkql b/lkql_checker/share/lkql/bit_records_without_layout_definition.lkql index 11b009cfa..d0fa46783 100644 --- a/lkql_checker/share/lkql/bit_records_without_layout_definition.lkql +++ b/lkql_checker/share/lkql/bit_records_without_layout_definition.lkql @@ -1,7 +1,3 @@ -# Flag record type declarations if a record has a component of a modular type -# and the record type is packed but does not have a record representation -# clause applied to it. - # TODO: move this function to libadalang fun lal_is_mod_type(n) = n.f_type_expr.p_designated_type_decl().f_type_def is ModIntTypeDef @@ -9,6 +5,23 @@ fun lal_is_mod_type(n) = @check(message="bit record without layout definition", category="Style", subcategory="Portability") fun bit_records_without_layout_definition(node) = + |" Flag record type declarations if a record has a component of a modular + |" type and the record type is packed but does not have a record representation clause + |" applied to it. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4 + |" + |" package Pack is + |" type My_Mod is mod 8; + |" + |" type My_Rec is record -- FLAG + |" I : My_Mod; + |" end record; + |" pragma Pack (My_Rec); + |" end Pack; node is TypeDecl when node.f_type_def is (RecordTypeDef | DerivedTypeDef) and node.p_has_aspect("Pack") diff --git a/lkql_checker/share/lkql/blocks.lkql b/lkql_checker/share/lkql/blocks.lkql index 59aa3b9bf..2a7f87d8a 100644 --- a/lkql_checker/share/lkql/blocks.lkql +++ b/lkql_checker/share/lkql/blocks.lkql @@ -1,4 +1,19 @@ -# Flag each block statement. - @check(message="block statement", category="Feature") -fun blocks(node) = node is BlockStmt +fun blocks(node) = + |" Flag each block statement. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" if I /= J then + |" declare -- FLAG + |" Tmp : Integer; + |" begin + |" TMP := I; + |" I := J; + |" J := Tmp; + |" end; + |" end if; + node is BlockStmt diff --git a/lkql_checker/share/lkql/boolean_negations.lkql b/lkql_checker/share/lkql/boolean_negations.lkql index 4b2e87f96..714cced49 100644 --- a/lkql_checker/share/lkql/boolean_negations.lkql +++ b/lkql_checker/share/lkql/boolean_negations.lkql @@ -1,8 +1,3 @@ -# Flag any infix call to the predefined NOT operator for the predefined -# Boolean type if its argument is an infix call to a predefined relation -# operator or another call to the predefined NOT operator. Calls to NOT -# operators for the types derived from Standard.Boolean are not flagged. - import stdlib fun strip_parentheses(node) = @@ -12,6 +7,19 @@ fun strip_parentheses(node) = @check(message="negation of boolean operator", category="Style", subcategory="Programming Practice") fun boolean_negations(node) = + |" Flag any infix call to the predefined ``NOT`` operator for the predefined + |" Boolean type if its argument is an infix call to a predefined relation + |" operator or another call to the predefined ``NOT`` operator. Such expressions + |" can be simplified by excluding the outer call to the predefined ``NOT`` + |" operator. Calls to ``NOT`` operators for the types derived from + |" Standard.Boolean are not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" Is_Data_Available := not (Buffer_Length = 0); -- FLAG node is UnOp(f_op: op@OpNot when stdlib.is_predefined_op(op)) when stdlib.is_standard_boolean(node) and strip_parentheses(node.f_expr) is diff --git a/lkql_checker/share/lkql/boolean_relational_operators.lkql b/lkql_checker/share/lkql/boolean_relational_operators.lkql index e9cf6e77c..0d479e3b9 100644 --- a/lkql_checker/share/lkql/boolean_relational_operators.lkql +++ b/lkql_checker/share/lkql/boolean_relational_operators.lkql @@ -1,10 +1,3 @@ -# Flag each call to a predefined relational operator for the predefined Boolean -# type. -# Calls to predefined relational operators of any type derived from -# Standard.Boolean are not detected. Calls to user-defined functions with these -# designators, and uses of operators that are renamings of the predefined -# relational operators for Standard.Boolean, are likewise not detected. - import stdlib fun is_predefined_boolean(n) = @@ -14,6 +7,24 @@ fun is_predefined_boolean(n) = @check(message="comparison of Boolean values", category="SPARK") fun boolean_relational_operators(node) = + |" Flag each call to a predefined relational operator ('<', '>', '<=', + |" '>=', '=' and '/=') for the predefined Boolean type. + |" (This rule is useful in enforcing the SPARK language restrictions.) + |" + |" Calls to predefined relational operators of any type derived from + |" ``Standard.Boolean`` are not detected. Calls to user-defined functions + |" with these designators, and uses of operators that are renamings + |" of the predefined relational operators for ``Standard.Boolean``, + |" are likewise not detected. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" procedure Proc (Flag_1 : Boolean; Flag_2 : Boolean; I : in out Integer) is + |" begin + |" if Flag_1 >= Flag_2 then -- FLAG (node is RelationOp when stdlib.is_predefined_op(node.f_op) and is_predefined_boolean(node) diff --git a/lkql_checker/share/lkql/calls_in_exception_handlers.lkql b/lkql_checker/share/lkql/calls_in_exception_handlers.lkql index c260466ba..17a15453f 100644 --- a/lkql_checker/share/lkql/calls_in_exception_handlers.lkql +++ b/lkql_checker/share/lkql/calls_in_exception_handlers.lkql @@ -1,9 +1,52 @@ -# Flag each occurrence of an exception handler with at least one call to a -# given list of subprograms (from parameter subprograms). - @check(message="exception handler with forbidden calls", category="Style", subcategory="Programming Practice") fun calls_in_exception_handlers(node, subprograms=[]) = + |" Flag an exception handler if its sequence of statements contains a call to one of + |" the subprograms specified as a rule parameter. + |" + |" The rule has an optional parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Subprograms: list[string]* + |" A list of full expanded Ada name of subprograms. + |" + |" Note that if a rule parameter does not denote the name of an existing + |" subprogram, the parameter itself is (silently) ignored and does not have any + |" effect except for turning the rule ON. + |" + |" Be aware that the rule does not follow renamings. So if a subprogram name specified + |" as a rule parameter denotes the name declared by subprogram renaming, the + |" rule will flag only exception handlers that calls this subprogram using this + |" name and does not respect and will pay no attention to the calls that use + |" original subprogram name, and the other way around. This is a user responsibility + |" to provide as the rule parameters all needed subprogram names the subprogram + |" of interest in case if renamings are used for this subprogram. + |" + |" Note also, that the rule does not make any overload resolution, so if a rule + |" parameter refers to more than one overloaded subprograms, the rule will treat + |" calls to all these subprograms as the calls to the same subprogram. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 14 + |" + |" -- Suppose the rule parameter is P.Unsafe + |" package P is + |" procedure Safe; + |" procedure Unsafe; + |" end P; + |" + |" with P; use P; + |" procedure Proc is + |" begin + |" ... + |" exception + |" when Constraint_Error => -- NO FLAG + |" Safe; + |" when others => -- FLAG + |" Unsafe; + |" end Proc; node is ExceptionHandler when (from node.f_stmts select first id@BaseId(p_is_call(): true) when { diff --git a/lkql_checker/share/lkql/calls_outside_elaboration.lkql b/lkql_checker/share/lkql/calls_outside_elaboration.lkql index 4d0243ef5..e31e1c014 100644 --- a/lkql_checker/share/lkql/calls_outside_elaboration.lkql +++ b/lkql_checker/share/lkql/calls_outside_elaboration.lkql @@ -1,12 +1,46 @@ -# Flag each occurrence of call (as given by parameter `forbidden`) performed -# outside library level package elaboration. Note that function renamings are -# not followed by this rule. - import stdlib @check(message="call performed outside elaboration", category="Style", subcategory="Programming Practice") fun calls_outside_elaboration(node, forbidden=[]) = + |" Flag subprogram calls outside library package elaboration code. Only calls to + |" the subprograms specified as a rule parameter are considered, renamings are + |" not followed. + |" + |" The rule has an optional parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Forbidden: list[string]* + |" A list of full expanded Ada name of subprograms. + |" + |" Note that if a rule parameter does not denote the name of an existing + |" subprogram, the parameter itself is (silently) ignored and does not have any + |" effect except for turning the rule ON. + |" + |" Note also, that the rule does not make any overload resolution, so if a rule + |" parameter refers to more than one overloaded subprograms, the rule will treat + |" calls to all these subprograms as the calls to the same subprogram. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 12 + |" + |" -- Suppose the rule is activated as +RCalls_Outside_Elaboration:P.Fun; + |" package P is + |" I : Integer := Fun (1); -- NO FLAG + |" J : Integer; + |" + |" procedure Proc (I : in out Integer); + |" end P; + |" + |" package body P is + |" procedure Proc (I : in out Integer) is + |" begin + |" I := Another_Fun (Fun (1)); -- FLAG + |" end Proc; + |" begin + |" J := Fun (I); -- NO FLAG node is BaseId(p_is_call(): true, any stdlib.semantic_parent: BasicSubpDecl | SubpBody | TaskBody | ExprFunction | EntryBody | ProtectedBody) diff --git a/lkql_checker/share/lkql/complex_inlined_subprograms.lkql b/lkql_checker/share/lkql/complex_inlined_subprograms.lkql index fb8424bde..13072c0ef 100644 --- a/lkql_checker/share/lkql/complex_inlined_subprograms.lkql +++ b/lkql_checker/share/lkql/complex_inlined_subprograms.lkql @@ -1,14 +1,3 @@ -# Flag a subprogram (or generic subprogram, or instantiation of a subprogram) -# if pragma Inline is applied to it and at least one of the following -# conditions is met: -# - it contains at least one complex declaration such as a subprogram body, -# package, task, protected declaration, or a generic instantiation (except -# instantiation of Ada.Unchecked_Conversion); -# - it contains at least one complex statement such as a loop, a case or an if -# statement; -# - the number of statements exceeds a value specified by the N rule parameter; -# Subprogram renamings are also considered. - import stdlib @memoized @@ -34,20 +23,64 @@ fun is_complex_subp(node, n) = [s for s in node?.f_stmts?.f_stmts?.children if s is Stmt].length > n) @unit_check(help="complex inlined subprograms", category="Feature") -fun complex_inlined_subprograms(unit, n : int = 5) = [ - {message: match complex_declaration(stdlib.get_subp_body(nod)?.f_decls) - | decl@AdaNode => ( - "complex declaration in inlined subprogram (line " & - img(decl?.token_start().start_line) & ")" - ) - | * => ( - match complex_statement(stdlib.get_subp_body(nod)?.f_stmts) - | stmt@Stmt => "branching in inlined subprogram (line " & - img(stmt?.token_start().start_line) & ")" - | * => "too many statements in inlined subprogram" - ), - loc: if nod is SubpRenamingDecl then stdlib.get_subp_body(nod) else nod} - for nod in from unit.root - select node@(SubpBody | GenericSubpInstantiation | SubpRenamingDecl) - when node.p_has_aspect("Inline") - and is_complex_subp(stdlib.get_subp_body(node), n)] +fun complex_inlined_subprograms(unit, n : int = 5) = + |" Flag a subprogram (or generic subprogram, or instantiation of a subprogram) if + |" pragma Inline is applied to it and at least one of the following + |" conditions is met: + |" + |" * it contains at least one complex declaration such as a subprogram body, + |" package, task, protected declaration, or a generic instantiation + |" (except instantiation of ``Ada.Unchecked_Conversion``); + |" * it contains at least one complex statement such as a loop, a case + |" or an if statement; + |" * the number of statements exceeds + |" a value specified by the *N* rule parameter; + |" + |" Subprogram renamings are also considered. + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Positive integer specifying the maximum allowed total number of statements + |" in the subprogram body. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" procedure Swap (I, J : in out Integer) with Inline => True; + |" + |" procedure Swap (I, J : in out Integer) is -- FLAG + |" begin + |" + |" if I /= J then + |" declare + |" Tmp : Integer; + |" begin + |" TMP := I; + |" I := J; + |" J := Tmp; + |" end; + |" end if; + |" + |" end Swap; + [ + {message: match complex_declaration(stdlib.get_subp_body(nod)?.f_decls) + | decl@AdaNode => ( + "complex declaration in inlined subprogram (line " & + img(decl?.token_start().start_line) & ")" + ) + | * => ( + match complex_statement(stdlib.get_subp_body(nod)?.f_stmts) + | stmt@Stmt => "branching in inlined subprogram (line " & + img(stmt?.token_start().start_line) & ")" + | * => "too many statements in inlined subprogram" + ), + loc: if nod is SubpRenamingDecl then stdlib.get_subp_body(nod) else nod} + for nod in from unit.root + select node@(SubpBody | GenericSubpInstantiation | SubpRenamingDecl) + when node.p_has_aspect("Inline") + and is_complex_subp(stdlib.get_subp_body(node), n) + ] diff --git a/lkql_checker/share/lkql/concurrent_interfaces.lkql b/lkql_checker/share/lkql/concurrent_interfaces.lkql index e083bc6aa..0ba1e54d0 100644 --- a/lkql_checker/share/lkql/concurrent_interfaces.lkql +++ b/lkql_checker/share/lkql/concurrent_interfaces.lkql @@ -1,8 +1,17 @@ -# Flag each occurrence of synchronized, task, and protected interfaces - @check(message="concurrent interface", category="Style", subcategory="Programming Practice") fun concurrent_interfaces(node) = + |" Flag synchronized, task, and protected interfaces. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2-4 + |" + |" type Queue is limited interface; -- NO FLAG + |" type Synchronized_Queue is synchronized interface and Queue; -- FLAG + |" type Synchronized_Task is task interface; -- FLAG + |" type Synchronized_Protected is protected interface; -- FLAG node is (InterfaceKindSynchronized | InterfaceKindTask | InterfaceKindProtected) diff --git a/lkql_checker/share/lkql/conditional_expressions.lkql b/lkql_checker/share/lkql/conditional_expressions.lkql index c12924168..9098d4b8e 100644 --- a/lkql_checker/share/lkql/conditional_expressions.lkql +++ b/lkql_checker/share/lkql/conditional_expressions.lkql @@ -1,10 +1,63 @@ -# Flag use of conditional expression. -# This rule has the parameter Except_Assertions: Do not flag a conditional -# expression if it is a subcomponent of the following constructs[...] - import stdlib @check(message="conditional expression", category="Feature") fun conditional_expressions(node, except_assertions=false) = + |" Flag use of conditional expression. + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *Except_Assertions: bool* + |" If ``true``, do not flag a conditional expression if it is a subcomponent + |" of the following constructs: + |" + |" *argument of the following pragmas* + |" + |" *Language-defined* + |" + |" * ``Assert`` + |" + |" *GNAT-specific* + |" + |" * ``Assert_And_Cut`` + |" * ``Assume`` + |" * ``Contract_Cases`` + |" * ``Debug`` + |" * ``Invariant`` + |" * ``Loop_Invariant`` + |" * ``Loop_Variant`` + |" * ``Postcondition`` + |" * ``Precondition`` + |" * ``Predicate`` + |" * ``Refined_Post`` + |" + |" *definition of the following aspects* + |" + |" *Language-defined* + |" + |" * ``Static_Predicate`` + |" * ``Dynamic_Predicate`` + |" * ``Pre`` + |" * ``Pre'Class`` + |" * ``Post`` + |" * ``Post'Class`` + |" * ``Type_Invariant`` + |" * ``Type_Invariant'Class`` + |" + |" *GNAT-specific* + |" + |" * ``Contract_Cases`` + |" * ``Invariant`` + |" * ``Invariant'Class`` + |" * ``Predicate`` + |" * ``Refined_Post`` + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" Var1 : Integer := (if I > J then 1 else 0); -- FLAG + |" Var2 : Integer := I + J; node is CondExpr when not (except_assertions and stdlib.within_assert(node)) diff --git a/lkql_checker/share/lkql/constant_overlays.lkql b/lkql_checker/share/lkql/constant_overlays.lkql index e3c7f6564..f7a9f4d97 100644 --- a/lkql_checker/share/lkql/constant_overlays.lkql +++ b/lkql_checker/share/lkql/constant_overlays.lkql @@ -1,11 +1,3 @@ -# Flag an overlay definition that has a form of an attribute definition clause -# for Overlaying'Address use Overlaid'Address; or a form of aspect definition -# Address => Overlaid'Address, and Overlaid is a data object defined by a -# constant declaration or a formal or generic formal parameter of mode IN if at -# least one of the following is true: -# - the overlaying object is not a constant object; -# - overlaying object or overlaid object is marked as Volatile; - import stdlib fun check_overlay(decl, overlaid) = @@ -29,12 +21,30 @@ fun check_overlay(decl, overlaid) = @check(message="non-constant object overlays a constant", category="Style", subcategory="Programming Practice") -fun constant_overlays(node) = match node - | AspectAssoc(f_id: id@Identifier, any parent(depth=3): o@ObjectDecl - when id.p_name_is("address") - and check_overlay (o, node.f_expr)) => true - | AttributeDefClause(f_attribute_expr: at@AttributeRef - when at.f_attribute.p_name_is("address") - and check_overlay(at.f_prefix.p_referenced_decl(), - node.f_expr)) => true - | * => false +fun constant_overlays(node) = + |" Flag an overlay definition that has a form of an attribute definition + |" clause ``for Overlaying'Address use Overlaid'Address;`` or a form of aspect definition + |" ``Address => Overlaid'Address``, and ``Overlaid`` is a data object defined by a constant + |" declaration or a formal or generic formal parameter of mode ``IN`` if + |" at least one of the following is true: + |" + |" * the overlaying object is not a constant object; + |" * overlaying object or overlaid object is marked as Volatile; + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" C : constant Integer := 1; + |" V : Integer; + |" for V'Address use C'Address; -- FLAG + match node + | AspectAssoc(f_id: id@Identifier, any parent(depth=3): o@ObjectDecl + when id.p_name_is("address") + and check_overlay (o, node.f_expr)) => true + | AttributeDefClause(f_attribute_expr: at@AttributeRef + when at.f_attribute.p_name_is("address") + and check_overlay(at.f_prefix.p_referenced_decl(), + node.f_expr)) => true + | * => false diff --git a/lkql_checker/share/lkql/constructors.lkql b/lkql_checker/share/lkql/constructors.lkql index f974f695c..22d0c8625 100644 --- a/lkql_checker/share/lkql/constructors.lkql +++ b/lkql_checker/share/lkql/constructors.lkql @@ -1,12 +1,24 @@ -# Flag any declaration of a primitive function of a tagged type that has a -# controlling result and no controlling parameter. If a declaration is a -# completion of another declaration then it is not flagged. - import stdlib @check(message="declaration of constructor function", category="Style", subcategory="Object Orientation") fun constructors(node) = + |" Flag any declaration of a primitive function of a tagged type that has a + |" controlling result and no controlling parameter. If a declaration is a + |" completion of another declaration then it is not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5-7 + |" + |" type T is tagged record + |" I : Integer; + |" end record; + |" + |" function Fun (I : Integer) return T; -- FLAG + |" function Bar (J : Integer) return T renames Fun; -- FLAG + |" function Foo (K : Integer) return T is ((I => K)); -- FLAG node is (BasicSubpDecl | BaseSubpBody(p_previous_part(): null) | SubpBodyStub(p_previous_part(): null)) diff --git a/lkql_checker/share/lkql/controlled_type_declarations.lkql b/lkql_checker/share/lkql/controlled_type_declarations.lkql index 168a53e31..23d7ca9a4 100644 --- a/lkql_checker/share/lkql/controlled_type_declarations.lkql +++ b/lkql_checker/share/lkql/controlled_type_declarations.lkql @@ -1,13 +1,3 @@ -# Flag all declarations of controlled types. -# -# * A declaration of a private type is flagged if its full declaration -# declares a controlled type. -# * A declaration of a derived type is flagged if its ancestor type is -# controlled. Subtype declarations are not checked. -# * A declaration of a type that itself is not a descendant of a type -# declared in `Ada.Finalization' but has a controlled component is not -# checked. - import stdlib fun canonical_fully_qualified_name(t) = @@ -15,6 +5,21 @@ fun canonical_fully_qualified_name(t) = @check(message="declaration of controlled type", category="Feature") fun controlled_type_declarations(node) = + |" Flag all declarations of controlled types. A declaration of a private type + |" is flagged if its full declaration declares a controlled type. A declaration + |" of a derived type is flagged if its ancestor type is controlled. Subtype + |" declarations are not checked. A declaration of a type that itself is not a + |" descendant of a type declared in ``Ada.Finalization`` but has a controlled + |" component is not checked. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" with Ada.Finalization; + |" package Foo is + |" type Resource is new Ada.Finalization.Controlled with private; -- FLAG node is TypeDecl ( any stdlib.complete_super_types: b when canonical_fully_qualified_name(b) == "ada.finalization.controlled" diff --git a/lkql_checker/share/lkql/declarations_in_blocks.lkql b/lkql_checker/share/lkql/declarations_in_blocks.lkql index 14f0f2eae..1f8d180a4 100644 --- a/lkql_checker/share/lkql/declarations_in_blocks.lkql +++ b/lkql_checker/share/lkql/declarations_in_blocks.lkql @@ -1,9 +1,23 @@ -# Flag all block statements containing local declarations. A `declare' -# block with an empty `declarative_part' or with a `declarative part' -# containing only pragmas and/or `use' clauses is not flagged. - @check(message="block statement with local declaration", category="Feature") fun declarations_in_blocks(node) = + |" Flag all block statements containing local declarations. A ``declare`` + |" block with an empty *declarative_part* or with a *declarative part* + |" containing only pragmas and/or ``use`` clauses is not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" if I /= J then + |" declare -- FLAG + |" Tmp : Integer; + |" begin + |" TMP := I; + |" I := J; + |" J := Tmp; + |" end; + |" end if; node is DeclBlock (any children(depth=1): DeclarativePart (f_decls: AdaNodeList(all children(depth=2): not diff --git a/lkql_checker/share/lkql/deep_inheritance_hierarchies.lkql b/lkql_checker/share/lkql/deep_inheritance_hierarchies.lkql index 88311d0c7..85b20bf4c 100644 --- a/lkql_checker/share/lkql/deep_inheritance_hierarchies.lkql +++ b/lkql_checker/share/lkql/deep_inheritance_hierarchies.lkql @@ -1,13 +1,3 @@ -# Flags a tagged derived type declaration or an interface type declaration if -# its depth (in its inheritance hierarchy) exceeds the value specified by the N -# rule parameter. Types in generic instantiations which violate this rule are -# also flagged; generic formal types are not flagged. This rule also does not -# flag private extension declarations. In the case of a private extension, the -# corresponding full declaration is checked. -# This rule has the parameter n: Integer not less than -1 specifying the -# maximal allowed depth of any inheritance hierarchy. If the rule parameter is -# set to -1, the rule flags all the declarations of tagged and interface types. - fun deep_inheritance(type, n) = if n == 0 then true else [t for t in type.p_base_types() if deep_inheritance(t, n-1)] @@ -16,6 +6,49 @@ fun deep_inheritance(type, n) = follow_generic_instantiations=true, category="Style", subcategory="Object Orientation") fun deep_inheritance_hierarchies(node, n: int = 2) = + |" Flags a tagged derived type declaration or an interface type declaration if + |" its depth (in its inheritance hierarchy) exceeds the value specified by the + |" *N* rule parameter. Types in generic instantiations which violate this + |" rule are also flagged; generic formal types are not flagged. This rule also + |" does not flag private extension declarations. In the case of a private + |" extension, the corresponding full declaration is checked. + |" + |" In most cases, the inheritance depth of a tagged type or interface type is + |" defined as 0 for a type with no parent and no progenitor, and otherwise as 1 + + |" max of the depths of the immediate parent and immediate progenitors. If the + |" declaration of a formal derived type has no progenitor, or if the declaration + |" of a formal interface type has exactly one progenitor, then the inheritance + |" depth of such a formal derived/interface type is equal to the inheritance + |" depth of its parent/progenitor type, otherwise the general rule is applied. + |" + |" If the rule flags a type declaration inside the generic unit, this means that + |" this type declaration will be flagged in any instantiation of the generic + |" unit. But if a type is derived from a format type or has a formal progenitor + |" and it is not flagged at the place where it is defined in a generic unit, it + |" may or may not be flagged in instantiation, this depends of the inheritance + |" depth of the actual parameters. + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Integer not less than -1 specifying the maximal allowed depth of any + |" inheritance hierarchy. If the rule parameter is set to -1, the rule + |" flags all the declarations of tagged and interface types. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 8 + |" + |" type I0 is interface; + |" type I1 is interface and I0; + |" type I2 is interface and I1; + |" + |" type T0 is tagged null record; + |" type T1 is new T0 and I0 with null record; + |" type T2 is new T0 and I1 with null record; + |" type T3 is new T0 and I2 with null record; -- FLAG (if rule parameter is 2) node is TypeDecl(parent: not GenericFormalTypeDecl, f_type_def: not DerivedTypeDef(f_has_with_private: WithPrivatePresent), diff --git a/lkql_checker/share/lkql/deep_library_hierarchy.lkql b/lkql_checker/share/lkql/deep_library_hierarchy.lkql index 20aa6a15e..d6982210a 100644 --- a/lkql_checker/share/lkql/deep_library_hierarchy.lkql +++ b/lkql_checker/share/lkql/deep_library_hierarchy.lkql @@ -1,14 +1,27 @@ -# Flag any library package declaration, library generic package declaration or -# library package instantiation that has more than depth parents and -# grandparents (that is, the name of such a library unit contains more than -# depth dots). Child subprograms, generic subprograms subprogram instantiations -# and package bodies are not flagged. -# This rule has the parameter N: Positive integer specifying the maximal -# number of ancestors when the unit is not flagged. - @check(message="unit has too many ancestors", category="Style", subcategory="Program Structure") fun deep_library_hierarchy(node, n: int = 3) = + |" Flag any library package declaration, library generic package + |" declaration or library package instantiation that has more than N + |" parents and grandparents (that is, the name of such a library unit + |" contains more than N dots). Child subprograms, generic subprograms + |" subprogram instantiations and package bodies are not flagged. + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Positive integer specifying the maximal number of ancestors when + |" the unit is not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" package Parent.Child1.Child2 is -- FLAG (if rule parameter is 1) + |" I : Integer; + |" end; node is (BasePackageDecl(f_package_name: DefiningName(any children(depth=n+2): Name)) | GenericPackageInstantiation(f_name: diff --git a/lkql_checker/share/lkql/deeply_nested_generics.lkql b/lkql_checker/share/lkql/deeply_nested_generics.lkql index a31557bac..cd830dcc9 100644 --- a/lkql_checker/share/lkql/deeply_nested_generics.lkql +++ b/lkql_checker/share/lkql/deeply_nested_generics.lkql @@ -1,12 +1,3 @@ -# Flag a generic declaration nested in another generic declaration if the -# nesting level of the inner generic exceeds the value specified by the -# `n' rule parameter. -# -# The nesting level is the number of generic declarations that enclose the -# given (generic) declaration. -# -# Formal packages are not flagged by this rule. - @memoized fun generic_nesting(node) = |" Return the number of GenericDecl found in parents of node @@ -14,8 +5,42 @@ fun generic_nesting(node) = @unit_check(message="deeply nested generic", category="Style", subcategory="Program Structure") -fun deeply_nested_generics(unit, n: int = 5) = [ - {message: "deeply nested generic (" & img(generic_nesting(node)) & ")", - loc: node.p_defining_name()} - for node in from unit.root select decl@GenericDecl - when generic_nesting(decl) > n] +fun deeply_nested_generics(unit, n: int = 5) = + |" Flag a generic declaration nested in another generic declaration if + |" the nesting level of the inner generic exceeds + |" the value specified by the *N* rule parameter. + |" The nesting level is the number of generic declarations that enclose the given + |" (generic) declaration. Formal packages are not flagged by this rule. + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Non-negative integer specifying the maximum nesting level for a generic + |" declaration. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 7 + |" + |" package Foo is + |" + |" generic + |" package P_G_0 is + |" generic + |" package P_G_1 is + |" generic -- FLAG (if rule parameter is 1) + |" package P_G_2 is + |" I : Integer; + |" end; + |" end; + |" end; + |" + |" end Foo; + [ + {message: "deeply nested generic (" & img(generic_nesting(node)) & ")", + loc: node.p_defining_name()} + for node in from unit.root select decl@GenericDecl + when generic_nesting(decl) > n + ] diff --git a/lkql_checker/share/lkql/deeply_nested_inlining.lkql b/lkql_checker/share/lkql/deeply_nested_inlining.lkql index a707f9b6d..c7a9350c7 100644 --- a/lkql_checker/share/lkql/deeply_nested_inlining.lkql +++ b/lkql_checker/share/lkql/deeply_nested_inlining.lkql @@ -1,8 +1,3 @@ -# Flag a subprogram (or generic subprogram) if pragma Inline has been applied -# to it, and it calls another subprogram to which pragma Inline applies, -# resulting in potential nested inlining, with a nesting depth exceeding the -# value specified by the N rule parameter. - import stdlib # Given a name, return the body of the decl referenced by the name if it is @@ -32,6 +27,56 @@ fun check_inlining(node, n: int) = @check(help="deeply nested inlining (global analysis required)", message="deeply nested inlining", category="Feature") fun deeply_nested_inlining(node, n: int = 3) = + |" Flag a subprogram (or generic subprogram) if pragma Inline has been applied + |" to it, and it calls another subprogram to which pragma Inline applies, + |" resulting in potential nested inlining, with a nesting depth exceeding the + |" value specified by the *N* rule parameter. + |" + |" This rule requires the global analysis of all the compilation units that + |" are ``gnatcheck`` arguments; such analysis may affect the tool's + |" performance. If gnatcheck generates warnings saying that "*body is not + |" analyzed for ...*", this means that such an analysis is incomplete, this + |" may result in rule false negatives. + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Positive integer specifying the maximum level of nested calls to + |" subprograms to which pragma Inline has been applied. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" procedure P1 (I : in out integer) with Inline => True; -- FLAG + |" procedure P2 (I : in out integer) with Inline => True; + |" procedure P3 (I : in out integer) with Inline => True; + |" procedure P4 (I : in out integer) with Inline => True; + |" + |" procedure P1 (I : in out integer) is + |" begin + |" I := I + 1; + |" P2 (I); + |" end; + |" + |" procedure P2 (I : in out integer) is + |" begin + |" I := I + 1; + |" P3 (I); + |" end; + |" + |" procedure P3 (I : in out integer) is + |" begin + |" I := I + 1; + |" P4 (I); + |" end; + |" + |" procedure P4 (I : in out integer) is + |" begin + |" I := I + 1; + |" end; match node | ClassicSubpDecl => node.p_has_aspect("Inline") and check_inlining(node.p_body_part(), n + 1) diff --git a/lkql_checker/share/lkql/deeply_nested_instantiations.lkql b/lkql_checker/share/lkql/deeply_nested_instantiations.lkql index 9becdae5a..60a0dfe9b 100644 --- a/lkql_checker/share/lkql/deeply_nested_instantiations.lkql +++ b/lkql_checker/share/lkql/deeply_nested_instantiations.lkql @@ -1,7 +1,3 @@ -# Flag each generic instantiation containing a chain of nested generic -# instantiations in the specification part exceeding the threshold specified -# by the `n` rule parameter. - fun check_instantiations(node, n : int) = |" Return true if node has a chain of at least n instantiations n == 0 or @@ -19,4 +15,48 @@ fun check_instantiations(node, n : int) = @check(message="deeply nested instantiation", category="Style", subcategory="Program Structure") fun deeply_nested_instantiations(node, n : int = 3) = + |" Flag a generic package instantiation if it contains another instantiation + |" in its specification and this nested instantiation also contains another + |" instantiation in its specification and so on, and the length of these + |" nested instantiations is more than N where N is a rule parameter. + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Non-negative integer specifying the maximum nesting level for instantiations. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 27 + |" + |" procedure Proc is + |" + |" generic + |" procedure D; + |" + |" procedure D is + |" begin + |" null; + |" end D; + |" + |" generic + |" package C is + |" procedure Inst is new D; + |" end C; + |" + |" generic + |" package B is + |" package Inst is new C; + |" end B; + |" + |" generic + |" package A is + |" package Inst is new B; + |" end A; + |" + |" package P is + |" package Inst is new A; -- FLAG + |" end P; node is GenericInstantiation when check_instantiations(node, n) diff --git a/lkql_checker/share/lkql/default_parameters.lkql b/lkql_checker/share/lkql/default_parameters.lkql index a2a2dc23c..49056eead 100644 --- a/lkql_checker/share/lkql/default_parameters.lkql +++ b/lkql_checker/share/lkql/default_parameters.lkql @@ -1,12 +1,30 @@ -# Flag formal part (in subprogram specifications and entry declarations) -# with more than N parameters with a default value. - # The `ignore` parameter is just there to allow using default_parameters with # default values (all other rules with a single integer require setting a # value for the `n` parameter). - @check(message="too many parameters with default value", category="Feature") fun default_parameters(node, n: int = 0, ignore = false) = + |" Flag formal part (in subprogram specifications and entry declarations) + |" if it defines more than N parameters with default values, when N is a + |" rule parameter. If no parameter is provided for the rule then all the + |" formal parts with defaulted parameters are flagged. + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Integer not less than 0 specifying the minimal allowed number of + |" defaulted parameters. + |" + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3,4 + |" + |" procedure P (I : in out Integer; J : Integer := 0); -- No FLAG (if parameter is 1) + |" procedure Q (I : in out Integer; J : Integer); + |" procedure R (I, J : Integer := 0; K : Integer := 0); -- FLAG (if parameter is 2 or less) + |" procedure S (I : Integer; J, K : Integer := 0); -- FLAG (if parameter is 2 or less) node is Params when (from (from node.f_params select ParamSpec(f_default_expr: Expr)) select DefiningName).length > n diff --git a/lkql_checker/share/lkql/default_values_for_record_components.lkql b/lkql_checker/share/lkql/default_values_for_record_components.lkql index 8a936e5d5..881d068f7 100644 --- a/lkql_checker/share/lkql/default_values_for_record_components.lkql +++ b/lkql_checker/share/lkql/default_values_for_record_components.lkql @@ -1,11 +1,26 @@ -# Flag a record component declaration if it contains a default expression. -# -# Do not flag record component declarations in protected definitions. -# Do not flag discriminant specifications. - @check(message="default value for record component", category="Style", subcategory="Programming Practice") fun default_values_for_record_components(node) = - node is ComponentDecl - when node.f_default_expr - and not node is *(any parent: ProtectedDef) + |" Flag a record component declaration if it contains a default expression. + |" Do not flag record component declarations in protected definitions. + |" Do not flag discriminant specifications. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2, 7 + |" + |" type Rec (D : Natural := 0) is record + |" I : Integer := 0; -- FLAG + |" B : Boolean; + |" + |" case D is + |" when 0 => + |" C : Character := 'A'; -- FLAG + |" when others => + |" F : Float; + |" end case; + |" end record; + node is ComponentDecl + when node.f_default_expr + and not node is *(any parent: ProtectedDef) diff --git a/lkql_checker/share/lkql/deriving_from_predefined_type.lkql b/lkql_checker/share/lkql/deriving_from_predefined_type.lkql index f3b8b041c..92494bb43 100644 --- a/lkql_checker/share/lkql/deriving_from_predefined_type.lkql +++ b/lkql_checker/share/lkql/deriving_from_predefined_type.lkql @@ -1,13 +1,24 @@ -# Flag derived type declaration if the ultimate ancestor type is a predefined -# Ada type. Do not flag record extensions and private extensions. The rule is -# checked inside expanded generics. - import stdlib @check(message="deriving from predefined type", follow_generic_instantiations=true, category="Style", subcategory="Programming Practice") fun deriving_from_predefined_type(node) = + |" Flag derived type declaration if the ultimate ancestor type is a + |" predefined Ada type. Do not flag record extensions and private + |" extensions. The rule is checked inside expanded generics. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3, 5 + |" + |" package Foo is + |" type T is private; + |" type My_String is new String; -- FLAG + |" private + |" type T is new Integer; -- FLAG + |" end Foo; node is DerivedTypeDef(f_has_with_private: WithPrivateAbsent, f_record_extension: null) when stdlib.is_predefined_type(node.f_subtype_indication.f_name) diff --git a/lkql_checker/share/lkql/direct_calls_to_primitives.lkql b/lkql_checker/share/lkql/direct_calls_to_primitives.lkql index 9bea7fcd2..fbceeb38c 100644 --- a/lkql_checker/share/lkql/direct_calls_to_primitives.lkql +++ b/lkql_checker/share/lkql/direct_calls_to_primitives.lkql @@ -1,13 +1,3 @@ -# Flag any non-dispatching call to a dispatching primitive operation, except -# for: -# - a call to the corresponding primitive of the parent type. -# - a call to a primitive of an untagged private type, even though the full -# type may be tagged, when the call is made at a place where the view of the -# type is untagged. -# This rule has the parameter Except_Constructors: Do not flag non-dispatching -# calls to functions if the function has a controlling result and no -# controlling parameters (aka constructors). - import stdlib # TODO: move to LAL @@ -23,13 +13,73 @@ fun is_parent_primitive(body, decl, parent_type) = @check(message="non-dispatching call to primitive operation", category="Style", subcategory="Object Orientation") -fun direct_calls_to_primitives(node, except_constructors=false) = node is - BaseId(p_is_static_call(): true) - when stdlib.ultimate_subprogram_alias(node.p_referenced_decl()) is - decl@BasicDecl(p_subp_spec_or_null(): - spec@BaseSubpSpec(p_primitive_subp_tagged_type(): - t@BaseTypeDecl)) - when t.p_most_visible_part(node).p_is_tagged_type() - and (not (except_constructors and stdlib.is_constructor(spec))) - and not is_parent_primitive(stdlib.enclosing_body(node), decl, t) - +fun direct_calls_to_primitives(node, except_constructors=false) = + |" Flag any non-dispatching call to a dispatching primitive operation, except for: + |" + |" * a call to the corresponding primitive of the parent type. (This + |" occurs in the common idiom where a primitive subprogram for a tagged type + |" directly calls the same primitive subprogram of the parent type.) + |" * a call to a primitive of an untagged private type, even though the full type + |" may be tagged, when the call is made at a place where the view of the type is + |" untagged. + |" + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *Except_Constructors: bool* + |" If ``true``, do not flag non-dispatching calls to functions if the function + |" has a controlling result and no controlling parameters (in a traditional OO + |" sense such functions may be considered as constructors). + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 28, 29 + |" + |" package Root is + |" type T_Root is tagged private; + |" + |" procedure Primitive_1 (X : in out T_Root); + |" procedure Primitive_2 (X : in out T_Root); + |" private + |" type T_Root is tagged record + |" Comp : Integer; + |" end record; + |" end Root; + |" + |" package Root.Child is + |" type T_Child is new T_Root with private; + |" + |" procedure Primitive_1 (X : in out T_Child); + |" procedure Primitive_2 (X : in out T_Child); + |" private + |" type T_Child is new T_Root with record + |" B : Boolean; + |" end record; + |" end Root.Child; + |" + |" package body Root.Child is + |" + |" procedure Primitive_1 (X : in out T_Child) is + |" begin + |" Primitive_1 (T_Root (X)); -- NO FLAG + |" Primitive_2 (T_Root (X)); -- FLAG + |" Primitive_2 (X); -- FLAG + |" end Primitive_1; + |" + |" procedure Primitive_2 (X : in out T_Child) is + |" begin + |" X.Comp := X.Comp + 1; + |" end Primitive_2; + |" + |" end Root.Child; + node is + BaseId(p_is_static_call(): true) + when stdlib.ultimate_subprogram_alias(node.p_referenced_decl()) is + decl@BasicDecl(p_subp_spec_or_null(): + spec@BaseSubpSpec(p_primitive_subp_tagged_type(): + t@BaseTypeDecl)) + when t.p_most_visible_part(node).p_is_tagged_type() + and (not (except_constructors and stdlib.is_constructor(spec))) + and not is_parent_primitive(stdlib.enclosing_body(node), decl, t) diff --git a/lkql_checker/share/lkql/direct_equalities.lkql b/lkql_checker/share/lkql/direct_equalities.lkql index 8f41e587f..b48250841 100644 --- a/lkql_checker/share/lkql/direct_equalities.lkql +++ b/lkql_checker/share/lkql/direct_equalities.lkql @@ -1,10 +1,3 @@ -# Flag infix calls to the predefined "=" and "/=" operators when one of -# the operands is the name of a data object provided as a rule parameter. -# Rule parameters should be full expanded Ada names of data objects -# declared by object declaration, number declaration, parameter -# specification, generic object declaration or object renaming -# declaration. Any other parameter does not have any effect. - import stdlib fun match_name(name, actuals) = @@ -18,6 +11,41 @@ fun match_name(name, actuals) = @check(message="direct (in)equality", category="Style", subcategory="Programming Practice") fun direct_equalities(node, actuals = []) = + |" Flag infix calls to the predefined ``=`` and ``/=`` operators when one of the + |" operands is a name of a data object provided as a rule parameter. + |" + |" The rule has an optional parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Actuals: list[string]* + |" A list of full expanded Ada name of a data objects declared by object + |" declaration, number declaration, parameter specification, generic object + |" declaration or object renaming declaration. Any other parameter does not + |" have any effect except of turning the rule ON. + |" + |" Be aware that the rule does not follow renamings. It checks if an operand of + |" an (un)equality operator is exactly the name provided as rule parameter + |" (the short name is checked in case of expanded name given as (un)equality + |" operator), and that this name is given on its own, but not as a component + |" of some other expression or as a call parameter. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 9 + |" + |" -- suppose the rule parameter is P.Var + |" package P is + |" Var : Integer; + |" end P; + |" + |" with P; use P; + |" procedure Proc (I : in out Integer) is + |" begin + |" if Var = I then -- FLAG + |" I := 0; + |" end if; + |" end Proc; node is BinOp(f_op: op@(OpEq | OpNeq)) when stdlib.is_predefined_op(op) and match_name(node.f_left, actuals) or match_name(node.f_right, actuals) diff --git a/lkql_checker/share/lkql/discriminated_records.lkql b/lkql_checker/share/lkql/discriminated_records.lkql index 140bc6ccf..2c6c50e03 100644 --- a/lkql_checker/share/lkql/discriminated_records.lkql +++ b/lkql_checker/share/lkql/discriminated_records.lkql @@ -1,14 +1,3 @@ -# Flag all declarations of record types with discriminants. Only the -# declarations of record and record extension types are checked. -# -# Incomplete, formal, private and private extension type -# declarations are not checked. -# -# Task and protected type declarations also are not checked. -# -# Derived type declaration are flagged if they are not using -# the discriminant in the type derivation. - # Check wether the given Identifier or string is present as a # BaseId in the list elements. # @@ -42,10 +31,35 @@ fun is_using_discriminant_in_declaration(type_decl) = @check(message="declaration of discriminated record", category="Feature") fun discriminated_records(node) = - node is TypeDecl( - any children(depth=2): DiscriminantSpecList - when not ( - node.f_type_def is PrivateTypeDef - or is_using_discriminant_in_declaration(node) - ) - ) + |" Flag all declarations of record types with discriminants. Only the + |" declarations of record and record extension types are checked. Incomplete, + |" formal, private, derived and private extension type declarations are not + |" checked. Task and protected type declarations also are not checked. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5, 9 + |" + |" type Idx is range 1 .. 100; + |" type Arr is array (Idx range <>) of Integer; + |" subtype Arr_10 is Arr (1 .. 10); + |" + |" type Rec_1 (D : Idx) is record -- FLAG + |" A : Arr (1 .. D); + |" end record; + |" + |" type Rec_2 (D : Idx) is record -- FLAG + |" B : Boolean; + |" end record; + |" + |" type Rec_3 is record + |" B : Boolean; + |" end record; + node is TypeDecl( + any children(depth=2): DiscriminantSpecList + when not ( + node.f_type_def is PrivateTypeDef + or is_using_discriminant_in_declaration(node) + ) + ) diff --git a/lkql_checker/share/lkql/downward_view_conversions.lkql b/lkql_checker/share/lkql/downward_view_conversions.lkql index 88f381776..0c58661e9 100644 --- a/lkql_checker/share/lkql/downward_view_conversions.lkql +++ b/lkql_checker/share/lkql/downward_view_conversions.lkql @@ -1,6 +1,3 @@ -# Flag downward view conversions. -# This rule will also flag downward view conversions done through access types. - fun is_downward_conv(expr_type, t) = |" Whether converting from `expr_type` to `t` is a downward view conversion |" of tagged types @@ -21,7 +18,46 @@ fun is_tagged(typ) = @check(message="downward view conversion", category="Style", subcategory="Object Orientation") fun downward_view_conversions(node) = - + |" Flag downward view conversions. + |" + |" This rule will also flag downward view conversions done through access types. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 19, 21 + |" + |" package Foo is + |" type T1 is tagged private; + |" procedure Proc1 (X : in out T1'Class); + |" + |" type T2 is new T1 with private; + |" procedure Proc2 (X : in out T2'Class); + |" + |" private + |" type T1 is tagged record + |" C : Integer := 0; + |" end record; + |" + |" type T2 is new T1 with null record; + |" end Foo; + |" + |" package body Foo is + |" + |" procedure Proc1 (X : in out T1'Class) is + |" Var : T2 := T2 (X); -- FLAG + |" X_Acc : T1_Access := X'Unrestricted_Access; + |" Var_2 : T2_Access := T2_Access (X_Acc); -- FLAG + |" begin + |" Proc2 (T2'Class (X)); -- FLAG + |" end Proc1; + |" + |" procedure Proc2 (X : in out T2'Class) is + |" begin + |" X.C := X.C + 1; + |" end Proc2; + |" + |" end Foo; node is CallExpr( # Select type conversions p_referenced_decl(): BaseTypeDecl( diff --git a/lkql_checker/share/lkql/duplicate_branches.lkql b/lkql_checker/share/lkql/duplicate_branches.lkql index fd0266919..28541c9b1 100644 --- a/lkql_checker/share/lkql/duplicate_branches.lkql +++ b/lkql_checker/share/lkql/duplicate_branches.lkql @@ -1,12 +1,3 @@ -# Flag syntactically equivalent branch bodies in a common 'case' or -# 'if' construct. -# The optional parameters min_size and min_stmt provide a way to -# parametrize a threshold to decide when two branches are worth reporting. -# min_size represents the minimum number of tokens to consider (SingleTokNode -# in Libadalang terms). -# min_stmt represents the minimum number of statements to consider. -# If any of the parameters match, the branch is considered. - fun check_size(n, min_size, min_stmt) = (from n select Stmt).length >= min_stmt or (from n select SingleTokNode).length >= min_size @@ -41,9 +32,61 @@ fun message(node, min_size, min_stmt) = { @unit_check(help="duplicate branch", category="Style", subcategory="Programming Practice") -fun duplicate_branches(unit, min_size: int = 14, min_stmt: int = 4) = [ - message(n, min_size, min_stmt) - for n in from unit.root - select node@(IfStmt | IfExpr | CaseStmt | CaseExpr) - when check_list(gather_stmts(node), min_size, min_stmt) -] +fun duplicate_branches(unit, min_size: int = 14, min_stmt: int = 4) = + |" Flag a sequence of statements that is a component of an ``if`` statement + |" or of a ``case`` statement alternative, if the same ``if`` or ``case`` + |" statement contains another sequence of statements as its component + |" (or a component of its ``case`` statement alternative) that is + |" syntactically equivalent to the sequence of statements in question. + |" The check for syntactical equivalence of operands ignores line breaks, + |" white spaces and comments. + |" + |" Small sequences of statements are not flagged by this rule. The rule has + |" two optional parameters that allow to specify the maximal size of statement + |" sequences that are not flagged: + |" + |" * *min_stmt: int* + |" An integer literal. All statement sequences that contain more than *min_stmt* + |" statements (`Stmt` as defined in Libadalang) as subcomponents are flagged; + |" + |" * *min_size: int* + |" An integer literal. All statement sequences that contain more than *min_size* + |" lexical elements (`SingleTokNode` in Libadalang terms) are flagged. + |" + |" You have to use the ``param_name=value`` formatting to pass arguments through + |" the ``+R`` options. Example: ``+RDuplicate_Branches:min_stmt=20,min_size=42``. + |" + |" If at least one of the two thresholds specified by the rule parameters is + |" exceeded, a statement sequence is flagged. The following defaults are used: + |" ``min_stmt=4,min_size=14``. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2, 11 + |" + |" if X > 0 then + |" declare -- FLAG: code duplicated at line 11 + |" A : Integer := X; + |" B : Integer := A + 1; + |" C : Integer := B + 1; + |" D : Integer := C + 1; + |" begin + |" return D; + |" end; + |" else + |" declare + |" A : Integer := X; + |" B : Integer := A + 1; + |" C : Integer := B + 1; + |" D : Integer := C + 1; + |" begin + |" return D; + |" end; + |" end if; + [ + message(n, min_size, min_stmt) + for n in from unit.root + select node@(IfStmt | IfExpr | CaseStmt | CaseExpr) + when check_list(gather_stmts(node), min_size, min_stmt) + ] diff --git a/lkql_checker/share/lkql/end_of_line_comments.lkql b/lkql_checker/share/lkql/end_of_line_comments.lkql index 7b899691a..c4be48441 100644 --- a/lkql_checker/share/lkql/end_of_line_comments.lkql +++ b/lkql_checker/share/lkql/end_of_line_comments.lkql @@ -1,12 +1,23 @@ -# Flags comments that are not on their own line - import stdlib @unit_check(help="end of line comments", remediation="EASY", category="Style", subcategory="Readability") -fun end_of_line_comments(unit) = [ - {message: "end of line comment", loc: tok} - for tok in unit.tokens - if tok.kind == "comment" and - stdlib.previous_non_blank_token_line(tok) == tok.start_line -] +fun end_of_line_comments(unit) = + |" Flags comments that are located in the source lines that + |" contains Ada code. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3,4 + |" + |" package A is + |" -- NO FLAG + |" I : Integer; -- FLAG + |" end A; -- FLAG + [ + {message: "end of line comment", loc: tok} + for tok in unit.tokens + if tok.kind == "comment" and + stdlib.previous_non_blank_token_line(tok) == tok.start_line + ] diff --git a/lkql_checker/share/lkql/enumeration_ranges_in_case_statements.lkql b/lkql_checker/share/lkql/enumeration_ranges_in_case_statements.lkql index d73ee987c..757bb3ad2 100644 --- a/lkql_checker/share/lkql/enumeration_ranges_in_case_statements.lkql +++ b/lkql_checker/share/lkql/enumeration_ranges_in_case_statements.lkql @@ -1,21 +1,37 @@ -# Flag each use of a range of enumeration literals as a choice in a -# `case' statement. -# -# All forms for 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 helps prevent maintenance problems arising from adding an -# enumeration value to a type and having it implicitly handled by an -# existing `case' statement with an enumeration range that includes the -# new literal. - @check(message="enumeration range as a choice in a case statement", + rule_name="Enumeration_Ranges_In_CASE_Statements", category="Style", subcategory="Programming Practice") fun enumeration_ranges_in_case_statements(node) = + |" Flag each use of a range of enumeration literals as a choice in a + |" ``case`` statement. + |" All forms for 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 helps prevent maintenance problems arising from adding an + |" enumeration value to a type and having it implicitly handled by an existing + |" ``case`` statement with an enumeration range that includes the new literal. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 8, 10 + |" + |" procedure Bar (I : in out Integer) is + |" type Enum is (A, B, C, D, E); + |" type Arr is array (A .. C) of Integer; + |" + |" function F (J : Integer) return Enum is separate; + |" begin + |" case F (I) is + |" when Arr'Range => -- FLAG + |" I := I + 1; + |" when D .. E => -- FLAG + |" null; + |" end case; + |" end Bar; node is AlternativesList( any parent(depth=3): CaseStmt( # case statement over enumeration diff --git a/lkql_checker/share/lkql/enumeration_representation_clauses.lkql b/lkql_checker/share/lkql/enumeration_representation_clauses.lkql index d0fb8ed9b..b563f73ab 100644 --- a/lkql_checker/share/lkql/enumeration_representation_clauses.lkql +++ b/lkql_checker/share/lkql/enumeration_representation_clauses.lkql @@ -1,5 +1,12 @@ -# Flag enumeration representation clauses. - @check(message="enumeration representation clause", category="Feature") fun enumeration_representation_clauses(node) = - node is EnumRepClause + |" Flag enumeration representation clauses. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" type Enum1 is (A1, B1, C1); + |" for Enum1 use (A1 => 1, B1 => 11, C1 => 111); -- FLAG + node is EnumRepClause diff --git a/lkql_checker/share/lkql/exception_propagation_from_callbacks.lkql b/lkql_checker/share/lkql/exception_propagation_from_callbacks.lkql index f3d97df0d..18cde787e 100644 --- a/lkql_checker/share/lkql/exception_propagation_from_callbacks.lkql +++ b/lkql_checker/share/lkql/exception_propagation_from_callbacks.lkql @@ -1,16 +1,3 @@ -# Flag each 'Address or 'Access reference to a subprogram whose body may -# propagate an exception, when this reference is part of one the -# given subprogram calls and formal parameter name as specified by the -# parameters. -# For LKQL: Callbacks is a list of -# ("fully qualified subprogram name", "parameter name"). -# For gnatcheck: each parameter is of the form -# "fully.qualified.subprogram.parameter_name". -# A subprogram is considered as not propagating if: -# - it has an exception handler with a "when others" choice; -# - no exception handler contains a raise statement, nor any call to -# Ada.Exception.Raise_Exception or Ada.Exception.Reraise_Occurrence. - import stdlib fun get_uninstantiated_subp(subp) = @@ -22,41 +9,121 @@ fun get_uninstantiated_subp(subp) = | AdaNode => subp.p_get_uninstantiated_node() | * => null - @check(help="callback may propagate exceptions (global analysis required)", message="callback may propagate exceptions", category="Style", subcategory="Programming Practice") fun exception_propagation_from_callbacks(node, callbacks=[]) = - # Select 'Access or 'Address on subprograms in a subprogram call - node is AttributeRef( - f_attribute: id@Identifier - when id.p_name_is("Address") or id.p_name_is("Access")) - when node.f_prefix.p_referenced_decl() is - subp@(SubpBody | SubpDecl | SubpBodyStub | GenericSubpInstantiation) - when (from node through parent - select first CallExpr(p_is_call(): true)) is call@CallExpr - when { - val uninst_subp_name = get_uninstantiated_subp( - call.f_name.p_referenced_decl() - )?.p_canonical_fully_qualified_name?(); + |" Flag an ``'Address`` or ``'Access`` attribute if: + |" + |" * this attribute is a reference to a subprogram; + |" * this subprogram may propagate an exception; + |" * this attribute is an actual parameter of a subprogram call, and both the + |" subprogram called and the corresponding formal parameter are specified by a + |" rule parameter. + |" + |" A subprogram is considered as not propagating an exception if: + |" + |" * its body has an exception handler with ``others`` exception choice; + |" * no exception handler in the body contains a raise statement nor a call to + |" ``Ada.Exception.Raise_Exception`` or ``Ada.Exception.Reraise_Occurrence``. + |" + |" The rule has an optional parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Callbacks: list[string]* + |" A list of strings which should have the following structure + |" ``subprogram_name.parameter``. ``subprogram_name`` should be a full expanded + |" Ada name of a subprogram. ``parameter`` should be a simple name of a + |" parameter of a subprogram defined by the ``subprogram_name`` part of the + |" rule parameter. For such a rule parameter for calls to all the subprograms + |" named as ``subprogram_name`` the rule checks if a reference to a subprogram + |" that may propagate an exception is passed as an actual for parameter named + |" ``parameter``. + |" + |" .. note:: + |" In LKQL rule options files, the ``Callbacks`` parameter should be a list + |" of two-elements tuples. Mapping ``subprogram_name.parameter`` to + |" ``(, )``. For example: + |" + |" .. code-block:: lkql + |" + |" val rules = @{ + |" Exception_Propagation_From_Callbacks: {Forbidden: [("P.SubP", "Param")]} + |" } + |" + |" Note that if a rule parameter does not denote the name of an existing + |" subprogram or if its ``parameter`` part does not correspond to any formal + |" parameter of any subprogram defined by ``subprogram_name`` part, the + |" parameter itself is (silently) ignored and does not have any effect except for + |" turning the rule ON. + |" + |" Be aware that ``subprogram_name`` is the name used in subprogram calls to look + |" for callback parameters that may raise an exception, and ``parameter`` is the + |" name of a formal parameter that is defined in the declaration that defines + |" ``subprogram_name``. This is a user responsibility to provide as the rule + |" parameters all needed combinations of subprogram name and parameter name for + |" the subprogram of interest in case if renamings are used for this subprogram. + |" + |" Note also, that the rule does not make any overload resolution, so calls to + |" all the subprograms corresponding to ``subprogram_name`` are checked. + |" + |" .. note:: Note that you can use both fully qualified names to + |" instantiated or non-instantiated generic subprograms, depending on the + |" granularity you wish for. However **you cannot use a mix of the two**, so + |" the names need to be either fully instantiated or fully uninstantiated. + |" + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 14 + |" + |" -- Suppose the rule parameter is P.Take_CB.Param1 + |" package P is + |" procedure Good_CB; -- does not propagate an exception + |" procedure Bad_CB; -- may propagate an exception + |" procedure Take_CB + |" (I : Integer; + |" Param1 : access procedure; + |" Param2 : access procedure); + |" end P; + |" + |" with P; use P; + |" procedure Proc is + |" begin + |" Take_CB (1, Bad_CB'Access, Good_CB'Access); -- FLAG + |" Take_CB (1, Good_CB'Access, Bad_CB'Access); -- NO FLAG + |" end Proc; + # Select 'Access or 'Address on subprograms in a subprogram call + node is AttributeRef( + f_attribute: id@Identifier + when id.p_name_is("Address") or id.p_name_is("Access")) + when node.f_prefix.p_referenced_decl() is + subp@(SubpBody | SubpDecl | SubpBodyStub | GenericSubpInstantiation) + when (from node through parent + select first CallExpr(p_is_call(): true)) is call@CallExpr + when { + val uninst_subp_name = get_uninstantiated_subp( + call.f_name.p_referenced_decl() + )?.p_canonical_fully_qualified_name?(); - val subp_name = call.f_name.p_referenced_decl() - ?.p_canonical_fully_qualified_name?(); + val subp_name = call.f_name.p_referenced_decl() + ?.p_canonical_fully_qualified_name?(); - val params = [ - c[2] for c in callbacks - if c[1] == uninst_subp_name - or c[1] == subp_name - ].to_list; + val params = [ + c[2] for c in callbacks + if c[1] == uninst_subp_name + or c[1] == subp_name + ].to_list; - params.length != 0 and - [p for p in call.p_call_params() - if p.actual == node and [param for param in params - if p.param.p_name_is(param)]] and - stdlib.propagate_exceptions( - match subp - | SubpBody => subp - | GenericSubpInstantiation => - subp.p_designated_subp().p_body_part_for_decl() - | * => subp.p_body_part_for_decl()) - } + params.length != 0 and + [p for p in call.p_call_params() + if p.actual == node and [param for param in params + if p.param.p_name_is(param)]] and + stdlib.propagate_exceptions( + match subp + | SubpBody => subp + | GenericSubpInstantiation => + subp.p_designated_subp().p_body_part_for_decl() + | * => subp.p_body_part_for_decl()) + } diff --git a/lkql_checker/share/lkql/exception_propagation_from_export.lkql b/lkql_checker/share/lkql/exception_propagation_from_export.lkql index 0b41a1a2e..780a2b009 100644 --- a/lkql_checker/share/lkql/exception_propagation_from_export.lkql +++ b/lkql_checker/share/lkql/exception_propagation_from_export.lkql @@ -1,10 +1,3 @@ -# Flag each subprogram body with an Export or Convention aspect that may -# propagate an exception. -# A subprogram is considered as not propagating if: -# - it has an exception handler with a "when others" choice; -# - and no exception handler contains a raise statement, nor any call to -# Ada.Exception.Raise_Exception or Ada.Exception.Reraise_Occurrence. - import stdlib fun is_exported(body) = { @@ -18,5 +11,29 @@ fun is_exported(body) = { @check(message="exception may propagate out of exported subprogram", category="Style", subcategory="Programming Practice") fun exception_propagation_from_export(node) = + |" Flag a subprogram body if aspect or pragma ``Export`` or ``Convention`` is + |" applied to this subprogram and this subprogram may propagate an exception. + |" + |" A subprogram is considered as not propagating an exception if: + |" + |" * its body has an exception handler with ``others`` exception choice; + |" * no exception handler in the body contains a raise statement nor a call to + |" ``Ada.Exception.Raise_Exception`` or ``Ada.Exception.Reraise_Occurrence``. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 6 + |" + |" package P is + |" procedure Proc (I : in out Integer) with Export; + |" end P; + |" + |" package body P is + |" procedure Proc (I : in out Integer) is -- FLAG + |" begin + |" I := I + 10; + |" end Proc; + |" end P; node is SubpBody when is_exported(node) and stdlib.propagate_exceptions(node) diff --git a/lkql_checker/share/lkql/exception_propagation_from_tasks.lkql b/lkql_checker/share/lkql/exception_propagation_from_tasks.lkql index f0ba96872..bd0ef2997 100644 --- a/lkql_checker/share/lkql/exception_propagation_from_tasks.lkql +++ b/lkql_checker/share/lkql/exception_propagation_from_tasks.lkql @@ -1,10 +1,24 @@ -# Flag each occurrence of task body with no "others" exception handler -# or with an exception handler containing a raise statement, or a call to -# Ada.Exception.Raise_Exception or Ada.Exception.Reraise_Occurrence. - import stdlib @check(message="exceptions may propagate out of task body", category="Style", subcategory="Programming Practice") fun exception_propagation_from_tasks(node) = + |" Flag a task body if it does not contain and exception handler with ``others`` + |" exception choice or if it contains an exception handler with a raise statement or + |" a call to ``Ada.Exception.Raise_Exception`` or + |" ``Ada.Exception.Reraise_Occurrence``. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" task T; + |" + |" task body T is -- FLAG + |" begin + |" ... + |" exception + |" when Constraint_Error => null; + |" end T; node is TaskBody when stdlib.propagate_exceptions(node) diff --git a/lkql_checker/share/lkql/exceptions_as_control_flow.lkql b/lkql_checker/share/lkql/exceptions_as_control_flow.lkql index 58ab26d1a..2abb392b9 100644 --- a/lkql_checker/share/lkql/exceptions_as_control_flow.lkql +++ b/lkql_checker/share/lkql/exceptions_as_control_flow.lkql @@ -1,7 +1,3 @@ -# Flag each place where an exception is explicitly raised and handled in the -# same subprogram body. A raise statement in an exception handler, package -# body, task body or entry body is not flagged. - import stdlib fun canonical_exception(name) = { @@ -18,25 +14,46 @@ fun canonical_exception(name) = { @check(message="this exception will be handled in the same body", category="Style", subcategory="Programming Practice") fun exceptions_as_control_flow(node) = - # Select raise statements that are directly part of a subprogram body - node is r@RaiseStmt(f_exception_name: exc@Name) - when stdlib.enclosing_body(r) is BaseSubpBody( - any children: exc_handler@ExceptionHandler when { - val exc_block = exc_handler.parent; - val stmt_block = exc_block?.parent; - val canonical_exc = canonical_exception(exc); - - # Where there is a handler that handles this same exception (either - # via an others clause, or a direct name handling) - exc_handler.f_handled_exceptions is *( - any children: OthersDesignator | - i@Identifier(p_referenced_decl(): ExceptionDecl) - when canonical_exception(i) == canonical_exc) - - # And the handler belongs to a block that encloses this raise statement - and r is *(any parent: p when p.parent == stmt_block) - - # But the raise statement is not directly part of the handler - and not r is *(any parent: p when p.parent == exc_block) - } - ) + |" Flag each place where an exception is explicitly raised and handled in the + |" same subprogram body. A ``raise`` statement in an exception handler, + |" package body, task body or entry body is not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5 + |" + |" procedure Bar (I : in out Integer) is + |" + |" begin + |" if I = Integer'Last then + |" raise Constraint_Error; -- FLAG + |" else + |" I := I - 1; + |" end if; + |" exception + |" when Constraint_Error => + |" I := Integer'First; + |" end Bar; + # Select raise statements that are directly part of a subprogram body + node is r@RaiseStmt(f_exception_name: exc@Name) + when stdlib.enclosing_body(r) is BaseSubpBody( + any children: exc_handler@ExceptionHandler when { + val exc_block = exc_handler.parent; + val stmt_block = exc_block?.parent; + val canonical_exc = canonical_exception(exc); + + # Where there is a handler that handles this same exception (either + # via an others clause, or a direct name handling) + exc_handler.f_handled_exceptions is *( + any children: OthersDesignator | + i@Identifier(p_referenced_decl(): ExceptionDecl) + when canonical_exception(i) == canonical_exc) + + # And the handler belongs to a block that encloses this raise statement + and r is *(any parent: p when p.parent == stmt_block) + + # But the raise statement is not directly part of the handler + and not r is *(any parent: p when p.parent == exc_block) + } + ) diff --git a/lkql_checker/share/lkql/exit_statements_with_no_loop_name.lkql b/lkql_checker/share/lkql/exit_statements_with_no_loop_name.lkql index 7eb61f5a6..6dbf10dbd 100644 --- a/lkql_checker/share/lkql/exit_statements_with_no_loop_name.lkql +++ b/lkql_checker/share/lkql/exit_statements_with_no_loop_name.lkql @@ -1,12 +1,3 @@ -# Flag each exit statement that does not specify the name of the loop being -# exited. -# -# This rule has the following (optional) parameter: -# -# Nested_Only -# Flag only those exit statements with no loop name that exit from nested -# loops. - import stdlib # Return whether the node passed as argument is within a nested loop @@ -17,9 +8,33 @@ fun is_in_nested_loop(n) = { } @check(message="exit statement with no loop name", + rule_name="EXIT_Statements_With_No_Loop_Name", category="Style", subcategory="Programming Practice") fun exit_statements_with_no_loop_name(node, nested_only=false) = - if nested_only then - node is e@ExitStmt(f_loop_name: null) when is_in_nested_loop(e) - else - node is ExitStmt(f_loop_name: null) + |" Flag each ``exit`` statement that does not specify the name of the loop + |" being exited. + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *Nested_Only: bool* + |" If ``true``, flag only those exit statements with no loop name that exit from + |" nested loops. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4 + |" + |" procedure Bar (I, J : in out Integer) is + |" begin + |" loop + |" exit when I < J; -- FLAG + |" I := I - 1; + |" J := J + 1; + |" end loop; + |" end Bar; + if nested_only then + node is e@ExitStmt(f_loop_name: null) when is_in_nested_loop(e) + else + node is ExitStmt(f_loop_name: null) diff --git a/lkql_checker/share/lkql/exits_from_conditional_loops.lkql b/lkql_checker/share/lkql/exits_from_conditional_loops.lkql index df4ca15ee..ba8a84864 100644 --- a/lkql_checker/share/lkql/exits_from_conditional_loops.lkql +++ b/lkql_checker/share/lkql/exits_from_conditional_loops.lkql @@ -1,11 +1,27 @@ -# Flag any exit statement if it transfers the control out of a for loop or a -# while loop. This includes cases when the exit statement applies to a FOR or -# while loop, and cases when it is enclosed in some for or while loop, but -# transfers the control from some outer (unconditional) loop statement. - @check(message="exit from conditional loop", category="Style", subcategory="Programming Practice") fun exits_from_conditional_loops(node) = + |" Flag any exit statement if it transfers the control out of a ``for`` loop + |" or a ``while`` loop. This includes cases when the ``exit`` statement + |" applies to a ``for`` or ``while`` loop, and cases when it is enclosed + |" in some ``for`` or ``while`` loop, but transfers the control from some + |" outer (unconditional) ``loop`` statement. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5 + |" + |" function Bar (S : String) return Natural is + |" Result : Natural := 0; + |" begin + |" for J in S'Range loop + |" exit when S (J) = '@'; -- FLAG + |" Result := Result + J; + |" end loop; + |" + |" return 0; + |" end Bar; node is ExitStmt when [l for l in node.parents(include_self=false) if l is BaseLoopStmt][1] is (ForLoopStmt | WhileLoopStmt) diff --git a/lkql_checker/share/lkql/expanded_loop_exit_names.lkql b/lkql_checker/share/lkql/expanded_loop_exit_names.lkql index 398582b6f..1666f8e62 100644 --- a/lkql_checker/share/lkql/expanded_loop_exit_names.lkql +++ b/lkql_checker/share/lkql/expanded_loop_exit_names.lkql @@ -1,5 +1,19 @@ -# Flag all expanded loop names in `exit' statements. - @check(message="expanded loop name in exit statement", category="SPARK") fun expanded_loop_exit_names(node) = + |" Flag all expanded loop names in ``exit`` statements. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 6 + |" + |" procedure Proc (S : in out String) is + |" begin + |" Search : for J in S'Range loop + |" if S (J) = ' ' then + |" S (J) := '_'; + |" exit Proc.Search; -- FLAG + |" end if; + |" end loop Search; + |" end Proc; node is ExitStmt(f_loop_name: DottedName) diff --git a/lkql_checker/share/lkql/explicit_full_discrete_ranges.lkql b/lkql_checker/share/lkql/explicit_full_discrete_ranges.lkql index 48888230b..95663e2b8 100644 --- a/lkql_checker/share/lkql/explicit_full_discrete_ranges.lkql +++ b/lkql_checker/share/lkql/explicit_full_discrete_ranges.lkql @@ -1,5 +1,3 @@ -# Flag each discrete range that has the form `A'First .. A'Last'. - fun full_range(l, r) = l is AttributeRef and r is AttributeRef and l.f_attribute.p_name_is("First") and r.f_attribute.p_name_is("Last") @@ -10,4 +8,20 @@ fun full_range(l, r) = @check(message="range could be replaced by subtype mark or 'Range", category="Feature") fun explicit_full_discrete_ranges(node) = - node is BinOp(f_op: OpDoubleDot) when full_range(node.f_left, node.f_right) + |" Flag each discrete range that has the form ``A'First .. A'Last``. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" subtype Idx is Integer range 1 .. 100; + |" begin + |" for J in Idx'First .. Idx'Last loop -- FLAG + |" K := K + J; + |" end loop; + |" + |" for J in Idx loop + |" L := L + J; + |" end loop; + node is BinOp(f_op: OpDoubleDot) when full_range(node.f_left, node.f_right) diff --git a/lkql_checker/share/lkql/explicit_inlining.lkql b/lkql_checker/share/lkql/explicit_inlining.lkql index 379fc815e..f4d7cc868 100644 --- a/lkql_checker/share/lkql/explicit_inlining.lkql +++ b/lkql_checker/share/lkql/explicit_inlining.lkql @@ -1,8 +1,21 @@ -# Flag a subprogram (or generic subprogram, or instantiation of a subprogram) -# with an Inline aspect. - @check(message="subprogram marked inline", category="Feature") fun explicit_inlining(node) = + |" Flag a subprogram declaration, a generic subprogram declaration or + |" a subprogram instantiation if this declaration has an Inline aspect specified + |" or an Inline pragma applied to it. If a generic subprogram declaration + |" has an Inline aspect specified or pragma Inline applied, then only + |" generic subprogram declaration is flagged but not its instantiations. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1, 4 + |" + |" procedure Swap (I, J : in out Integer); -- FLAG + |" pragma Inline (Swap); + |" + |" function Increment (I : Integer) return Integer is (I + 1) -- FLAG + |" with Inline; node is (SubpBody | GenericSubpInstantiation | ExprFunction | SubpBodyStub | BasicSubpDecl) when node.p_has_aspect("Inline") diff --git a/lkql_checker/share/lkql/expression_functions.lkql b/lkql_checker/share/lkql/expression_functions.lkql index a7dedf589..da1cd2af1 100644 --- a/lkql_checker/share/lkql/expression_functions.lkql +++ b/lkql_checker/share/lkql/expression_functions.lkql @@ -1,8 +1,18 @@ -# Flag each expression function declared in a package specification (including -# specification of local packages and generic package specifications). - @check(message="expression function", category="Feature") fun expression_functions(node) = + |" Flag each expression function declared in a package specification + |" (including specification of local packages and generic package + |" specifications). + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" package Foo is + |" + |" function F (I : Integer) return Integer is -- FLAG + |" (if I > 0 then I - 1 else I + 1); node is ExprFunction when node.p_semantic_parent() is BasePackageDecl or (node.p_semantic_parent() is PrivatePart and diff --git a/lkql_checker/share/lkql/final_package.lkql b/lkql_checker/share/lkql/final_package.lkql index 85a1bcd41..3fde51bda 100644 --- a/lkql_checker/share/lkql/final_package.lkql +++ b/lkql_checker/share/lkql/final_package.lkql @@ -23,18 +23,18 @@ fun final_package(node) = |" .. note:: We don't do a transitive check, so grandchild packages won't |" be flagged. We consider this is not necessary, because the child |" package will be flagged anyway. - |" + |" |" Here is an example: |" |" .. code-block:: ada |" |" package Pkg with Annotate => (GNATcheck, Final) is |" end Pkg; - |" - |" package Pkg.Child is -- FLAGGED + |" + |" package Pkg.Child is -- FLAG |" end Pkg.Child; - |" - |" package Pkg.Child.Grandchild is -- NOT FLAGGED + |" + |" package Pkg.Child.Grandchild is -- NOFLAG |" end Pkg.Child.Grandchild; node is BasePackageDecl(parent: LibraryItem) when is_final_pkg(node.p_semantic_parent()) diff --git a/lkql_checker/share/lkql/fixed_equality_checks.lkql b/lkql_checker/share/lkql/fixed_equality_checks.lkql index bc8783f15..959514a15 100644 --- a/lkql_checker/share/lkql/fixed_equality_checks.lkql +++ b/lkql_checker/share/lkql/fixed_equality_checks.lkql @@ -1,13 +1,30 @@ -# Flag all explicit calls to the predefined equality operations for fixed-point -# types. Both '=' and '/=' operations are checked. User-defined equality -# operations are not flagged, nor are uses of operators that are renamings of -# the predefined equality operations. Also, the '=' and '/=' operations for -# floating-point types are not flagged. - import stdlib @check(message="use of equality operation for fixed values", category="Feature") fun fixed_equality_checks(node) = + |" Flag all explicit calls to the predefined equality operations for fixed-point + |" types. Both '``=``' and '``/=``' operations are checked. + |" User-defined equality operations are not flagged, nor are uses of operators + |" that are renamings of the predefined equality operations. + |" Also, the '``=``' and '``/=``' operations for floating-point types + |" are not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 11 + |" + |" package Pack is + |" type Speed is delta 0.01 range 0.0 .. 10_000.0; + |" function Get_Speed return Speed; + |" end Pack; + |" + |" with Pack; use Pack; + |" procedure Process is + |" Speed1 : Speed := Get_Speed; + |" Speed2 : Speed := Get_Speed; + |" + |" Flag : Boolean := Speed1 = Speed2; -- FLAG node is ((RelationOp(f_op: op@(OpEq | OpNeq)) when stdlib.is_predefined_op(op) and node.f_left.p_expression_type() is diff --git a/lkql_checker/share/lkql/float_equality_checks.lkql b/lkql_checker/share/lkql/float_equality_checks.lkql index 0961a39ff..eb38b5049 100644 --- a/lkql_checker/share/lkql/float_equality_checks.lkql +++ b/lkql_checker/share/lkql/float_equality_checks.lkql @@ -1,10 +1,3 @@ -# Flag all explicit calls to the predefined equality operations for -# floating-point types and private types whose completions are floating-point -# types. Both '=' and '/=' operations are checked. User-defined equality -# operations are not flagged. Also, the '=' and '/=' operations for fixed-point -# types are not flagged. Uses of operators that are renamings of the predefined -# equality operations will be flagged if `follow_renamings` is true. - import stdlib fun is_float(n) = @@ -13,6 +6,36 @@ fun is_float(n) = @check(message="use of equality operation for float values", category="Feature") fun float_equality_checks(node, follow_renamings=false) = + |" Flag all explicit calls to the predefined equality operations for + |" floating-point types and private types whose completions are floating-point + |" types. Both '=' and '/=' operations are checked. User-defined equality + |" operations are not flagged. Also, the '=' and '/=' operations for fixed-point + |" types are not flagged. Uses of operators that are renamings of the predefined + |" equality operations will be flagged if `Follow_Renamings` is true. + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *Follow_Renamings: bool* + |" Whether to take renamings of predefined equality operations into account. + |" + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 11 + |" + |" package Pack is + |" type Speed is digits 0.01 range 0.0 .. 10_000.0; + |" function Get_Speed return Speed; + |" end Pack; + |" + |" with Pack; use Pack; + |" procedure Process is + |" Speed1 : Speed := Get_Speed; + |" Speed2 : Speed := Get_Speed; + |" + |" Flag : Boolean := Speed1 = Speed2; -- FLAG node is (( RelationOp(f_op: op@(OpEq | OpNeq)) when stdlib.is_predefined_op(op, follow_renamings) and is_float(node.f_left) diff --git a/lkql_checker/share/lkql/forbidden_aspects.lkql b/lkql_checker/share/lkql/forbidden_aspects.lkql index c9d2a8ac1..549b2eed1 100644 --- a/lkql_checker/share/lkql/forbidden_aspects.lkql +++ b/lkql_checker/share/lkql/forbidden_aspects.lkql @@ -1,16 +1,83 @@ -# Flag each use of the specified aspects. The aspects to be detected are named -# in the parameter ``forbidden``. If the ``all`` parameter is true, all aspects -# by default are flagged, except the aspects listed in the ``allowed`` -# parameter. - @unit_check(help="usage of specified aspects", parametric_exemption=true, category="Style", subcategory="Portability") -fun forbidden_aspects(unit, all=false, forbidden=[], allowed=[]) = [ - {message: "use of aspect " & node.f_id.text, loc: node} - for node in from unit.root select AspectAssoc(f_id: id@Name) - # Note that p_name_is doesn't work on e.g. AttributeRef, so compare strings - # directly instead. - when { - val str = id.text.to_lower_case; - (all or [p for p in forbidden if str == p.to_lower_case]) - and not [p for p in allowed if str == p.to_lower_case]}] +fun forbidden_aspects(unit, all=false, forbidden=[], allowed=[]) = + |" Flag each use of the specified aspects. The aspects to be detected are + |" named in the rule's parameters. + |" + |" This rule has the following parameters for the ``+R`` option and for LKQL + |" rule options file: + |" + |" *Forbidden: list[string]* + |" Adds the specified aspects to the set of aspects to be detected and sets + |" the detection checks for all the specified attributes ON. Note that if some + |" aspect exists also as class-wide aspect, the rule treats its normal + |" and class-wide versions separately. (If you specify ``Pre`` as the rule parameter, + |" the rule will not flag the ``Pre'Class`` aspect, and the other way around - + |" specifying ``Pre'Class`` as the rule parameter does not mean that the rule + |" will flag the ``Pre`` aspect). + |" + |" *Allowed: string* + |" A semi-colon separated list of aspects to remove from the set of aspects to + |" be detected. You have to use the named parameter formatting to specify it. + |" + |" *All: bool* + |" If ``true``, all aspects are detected; this sets the rule ON. + |" + |" Parameters are case insensitive. If an element of *Forbidden* or *Allowed* + |" does not have the syntax of an Ada identifier, it is (silently) ignored, but + |" if such a parameter is given for the ``+R`` option, this turns the rule ON. + |" + |" The ``+R`` option with no parameters doesn't create any instance for the rule, + |" thus, it has no effect. + |" + |" .. note:: + |" In LKQL rule options files, the ``Allowed`` parameter should be a list of + |" strings: + |" + |" .. code-block:: lkql + |" + |" val rules = @{ + |" Forbidden_Aspects: {Forbidden: ["one", "two"], Allowed: ["two"]} + |" } + |" + |" The rule allows parametric exemption, the parameters that are allowed in the + |" definition of exemption sections are *Forbidden*. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3, 8, 23 + |" + |" -- if the rule is activated as +RForbidden_Aspects:Pack,Pre + |" package Foo is + |" type Arr is array (1 .. 10) of Integer with Pack; -- FLAG + |" + |" type T is tagged private; + |" + |" procedure Proc1 (X : in out T) + |" with Pre => Predicate1; -- FLAG + |" + |" procedure Proc2 (X : in out T) + |" with Pre'Class => Predicate2; -- NO FLAG + |" + |" -- if the rule is activated as +RForbidden_Aspects:ALL,Allowed=Pack;Pre + |" package Foo is + |" type Arr is array (1 .. 10) of Integer with Pack; -- NOFLAG (because of 'Allowed' rule arg) + |" + |" type T is tagged private; + |" + |" procedure Proc1 (X : in out T) + |" with Pre => Predicate1; -- NOFLAG (because of 'Allowed' rule arg) + |" + |" procedure Proc2 (X : in out T) + |" with Pre'Class => Predicate2; -- FLAG + [ + {message: "use of aspect " & node.f_id.text, loc: node} + for node in from unit.root select AspectAssoc(f_id: id@Name) + # Note that p_name_is doesn't work on e.g. AttributeRef, so compare strings + # directly instead. + when { + val str = id.text.to_lower_case; + (all or [p for p in forbidden if str == p.to_lower_case]) + and not [p for p in allowed if str == p.to_lower_case]} + ] diff --git a/lkql_checker/share/lkql/forbidden_attributes.lkql b/lkql_checker/share/lkql/forbidden_attributes.lkql index 4916840b8..b43a15cf2 100644 --- a/lkql_checker/share/lkql/forbidden_attributes.lkql +++ b/lkql_checker/share/lkql/forbidden_attributes.lkql @@ -1,12 +1,82 @@ -# Flag each use of the specified attributes. The attributes to be detected are -# named in the parameter ``forbidden``. If the ``all`` parameter is true, -# all pragmas by default are flagged, except the pragmas listed in the -# ``allowed`` parameter. - @unit_check(help="usage of specified attributes", parametric_exemption=true, category="Style", subcategory="Portability") -fun forbidden_attributes(unit, all=false, forbidden=[], allowed=[]) = [ - {message: "use of attribute " & node.f_attribute.text, loc: node} - for node in from unit.root select AttributeRef(f_attribute: id@Identifier) - when (all or [p for p in forbidden if id.p_name_is(p)]) - and not [p for p in allowed if id.p_name_is(p)]] +fun forbidden_attributes(unit, all=false, forbidden=[], allowed=[]) = + |" Flag each use of the specified attributes. The attributes to be detected are + |" named in the rule's parameters. + |" + |" This rule has the following parameters for the ``+R`` option and for LKQL + |" rule options file: + |" + |" *Forbidden: list[string]* + |" Adds the specified attributes to the set of attributes to be detected and sets + |" the detection checks for all the specified attributes ON. + |" If an element does not denote any attribute defined in the Ada standard + |" or in the GNAT Reference Manual, it is treated as the name of unknown + |" attribute. + |" If an element is equal to ``GNAT`` (case insensitive), then all GNAT-specific + |" attributes are added to the set of attributes to be detected. + |" + |" *Allowed: string* + |" A semi-colon separated list of attributes to remove from the set of attributes + |" to be detected. You have to use the named parameter formatting to specify it. + |" + |" *All: bool* + |" If ``true``, all attributes are detected; this sets the rule ON. + |" + |" Parameters are not case sensitive. If an element of *Forbidden* or *Allowed* + |" does not have the syntax of an Ada identifier and therefore can not be + |" considered as a (part of an) attribute designator, a diagnostic message is + |" generated and the corresponding parameter is ignored. (If an attribute allows a + |" static expression to be a part of the attribute designator, this expression is + |" ignored by this rule.) + |" + |" The ``+R`` option with no parameters doesn't create any instance for the rule, + |" thus, it has no effect. + |" + |" .. note:: + |" In LKQL rule options files, the ``Allowed`` parameter should be a list of + |" strings: + |" + |" .. code-block:: lkql + |" + |" val rules = @{ + |" Forbidden_Attributes: {Forbidden: ["X", "Y", "GNAT"], Allowed: ["Z"]} + |" } + |" + |" The rule allows parametric exemption, the parameters that are allowed in the + |" definition of exemption sections are *Attribute_Designators*. Each + |" *Attribute_Designator* used as a rule exemption parameter should denote + |" a predefined or GNAT-specific attribute. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 6, 9, 20 + |" + |" -- if the rule is activated as +RForbidden_Attributes:Range,First,Last + |" procedure Foo is + |" type Arr is array (1 .. 10) of Integer; + |" Arr_Var : Arr; + |" + |" subtype Ind is Integer range Arr'First .. Arr'Last; -- FLAG (twice) + |" begin + |" + |" for J in Arr'Range loop -- FLAG + |" Arr_Var (J) := Integer'Succ (J); + |" + |" -- if the rule is activated as +RForbidden_Attributes:ALL,Allowed=First,Last + |" procedure Foo is + |" type Arr is array (1 .. 10) of Integer; + |" Arr_Var : Arr; + |" + |" subtype Ind is Integer range Arr'First .. Arr'Last; -- NOFLAG (because of 'Allowed' rule arg) + |" begin + |" + |" for J in Arr'Range loop -- FLAG + |" Arr_Var (J) := Integer'Succ (J); + [ + {message: "use of attribute " & node.f_attribute.text, loc: node} + for node in from unit.root select AttributeRef(f_attribute: id@Identifier) + when (all or [p for p in forbidden if id.p_name_is(p)]) + and not [p for p in allowed if id.p_name_is(p)] + ] diff --git a/lkql_checker/share/lkql/forbidden_pragmas.lkql b/lkql_checker/share/lkql/forbidden_pragmas.lkql index 22c1ae85a..609a87087 100644 --- a/lkql_checker/share/lkql/forbidden_pragmas.lkql +++ b/lkql_checker/share/lkql/forbidden_pragmas.lkql @@ -1,12 +1,78 @@ -# Flag each use of the specified pragmas. The pragmas to be detected are named -# in the parameter ``forbidden``. If the ``all`` parameter is true, all pragmas -# by default are flagged, except the pragmas listed in the ``allowed`` -# parameter. - @unit_check(help="usage of specified pragmas", parametric_exemption=true, category="Style", subcategory="Portability") -fun forbidden_pragmas(unit, all=false, forbidden=[], allowed=[]) = [ - {message: "use of pragma " & node.f_id.text, loc: node} - for node in from unit.root select PragmaNode(f_id: id@Identifier) - when (all or [p for p in forbidden if id.p_name_is(p)]) - and not [p for p in allowed if id.p_name_is(p)]] +fun forbidden_pragmas(unit, all=false, forbidden=[], allowed=[]) = + |" Flag each use of the specified pragmas. The pragmas to be detected + |" are named in the rule's parameters. + |" + |" This rule has the following parameters for the ``+R`` option and for LKQL + |" rule options file: + |" + |" *Forbidden: list[string]* + |" Adds the specified pragmas to the set of pragmas to be checked and sets + |" the checks for all the specified pragmas ON. An element of this list + |" is treated as a name of a pragma. If it does not correspond to any pragma name + |" defined in the Ada standard or to the name of a GNAT-specific pragma defined + |" in the GNAT Reference Manual, it is treated as the name of unknown pragma. + |" If an element is equal to ``GNAT`` (case insensitive), then all GNAT-specific + |" pragmas are added to the set of attributes to be detected. + |" + |" *Allowed: string* + |" A semi-colon separated list of pragmas to remove from the set of pragmas to + |" be detected. You have to use the named parameter formatting to specify it. + |" + |" *All: bool* + |" If ``true``, all pragmas are detected; this sets the rule ON. + |" + |" Parameters are not case sensitive. If an element of *Forbidden* or *Allowed* + |" does not have the syntax of an Ada identifier and therefore can not be + |" considered as a pragma name, a diagnostic message is generated and the + |" corresponding parameter is ignored. + |" + |" The ``+R`` option with no parameters doesn't create any instance for the rule, + |" thus, it has no effect. + |" + |" Note that in case when the rule is enabled with *All* parameter, then + |" the rule will flag also pragmas ``Annotate`` used to exempt rules, see + |" :ref:`Rule_exemption`. Even if you exempt this *Forbidden_Pragmas* rule + |" then the pragma ``Annotate`` that closes the exemption section will be + |" flagged as non-exempted. To avoid this, remove the pragma ``Annotate`` + |" from the "to be flagged" list by using ``+RForbidden_Pragmas:ALL,Allowed=Annotate`` + |" rule option. + |" + |" .. note:: + |" In LKQL rule options files, you can specify a named ``Allowed`` parameter + |" as a list of strings. This way you can exempt some pragmas from being + |" flagged. Example: + |" + |" .. code-block:: lkql + |" + |" val rules = @{ + |" Forbidden_Pragmas: {Forbidden: ["gnat"], Allowed: ["Annotate"]} + |" } + |" + |" The rule allows parametric exemption, the parameters that are allowed in the + |" definition of exemption sections are pragma names. Each + |" name used as a rule exemption parameter should denote + |" a predefined or GNAT-specific pragma. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5 + |" + |" -- if the rule is activated as +RForbidden_Pragmas:Pack + |" package Foo is + |" + |" type Arr is array (1 .. 8) of Boolean; + |" pragma Pack (Arr); -- FLAG + |" + |" I : Integer; + |" pragma Atomic (I); + |" + |" end Foo; + [ + {message: "use of pragma " & node.f_id.text, loc: node} + for node in from unit.root select PragmaNode(f_id: id@Identifier) + when (all or [p for p in forbidden if id.p_name_is(p)]) + and not [p for p in allowed if id.p_name_is(p)] + ] diff --git a/lkql_checker/share/lkql/function_style_procedures.lkql b/lkql_checker/share/lkql/function_style_procedures.lkql index 7daf3db9f..1d763048c 100644 --- a/lkql_checker/share/lkql/function_style_procedures.lkql +++ b/lkql_checker/share/lkql/function_style_procedures.lkql @@ -1,15 +1,3 @@ -# Flag each procedure that can be rewritten as a function. A procedure can be -# converted into a function if it has exactly one parameter of mode out, no -# parameters of mode in out and no Global aspect or an explicit Global => null. -# Procedure declarations, formal procedure declarations, and generic procedure -# declarations are always checked. -# 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 a -# limited type, it is not flagged. -# Protected procedures are not flagged. Null procedures also are not flagged. - fun in_out_params(s) = [p for p in s.p_params() if p.f_mode is ModeInOut] @@ -18,6 +6,29 @@ fun params_out(s) = @check(message="procedure can be rewritten as function", category="Feature") fun function_style_procedures(node) = + |" Flag each procedure that can be rewritten as a function. A procedure can be + |" converted into a function if it has exactly one parameter of mode ``out`` + |" and no parameters of mode ``in out``, with no ``Global`` aspect + |" specified or with explicit specification that its ``Global`` aspect is set to + |" ``null`` (either by aspect specification or by pragma Global). Procedure + |" declarations, formal procedure declarations, and generic procedure declarations + |" are always checked. 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 a limited type, it is not flagged. + |" + |" Protected procedures are not flagged. Null procedures also are not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" procedure Cannot_be_a_function (A, B : out Boolean); + |" procedure Can_be_a_function (A : out Boolean); -- FLAG node is (SubpBody | SubpBodyStub | ClassicSubpDecl | GenericSubpInternal) when (node is (ClassicSubpDecl | GenericSubpInternal) or not node.p_previous_part()) diff --git a/lkql_checker/share/lkql/generic_in_out_objects.lkql b/lkql_checker/share/lkql/generic_in_out_objects.lkql index 6e541560a..78a230197 100644 --- a/lkql_checker/share/lkql/generic_in_out_objects.lkql +++ b/lkql_checker/share/lkql/generic_in_out_objects.lkql @@ -1,5 +1,16 @@ -# Flag declarations of generic formal objects of mode IN OUT. - -@check(message="generic IN OUT object", category="Feature") +@check(message="generic IN OUT object", category="Feature", + rule_name="Generic_IN_OUT_Objects") fun generic_in_out_objects(node) = + |" Flag declarations of generic formal objects of mode IN OUT. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4 + |" + |" generic + |" I : Integer; + |" J : in Integer; + |" K : in out Integer; -- FLAG + |" package Pack_G is node is GenericFormalObjDecl(f_decl: ObjectDecl(f_mode: ModeInOut)) diff --git a/lkql_checker/share/lkql/generics_in_subprograms.lkql b/lkql_checker/share/lkql/generics_in_subprograms.lkql index def964eca..2f5f8ba42 100644 --- a/lkql_checker/share/lkql/generics_in_subprograms.lkql +++ b/lkql_checker/share/lkql/generics_in_subprograms.lkql @@ -1,10 +1,21 @@ -# Flag each declaration of a generic unit in a subprogram. Generic declarations -# in the bodies of generic subprograms are also flagged. A generic unit nested -# in another generic unit is not flagged. If a generic unit is declared in a -# local package that is declared in a subprogram body, the generic unit is -# flagged. - @check(message="generic definition in subprogram body", category="Feature") fun generics_in_subprograms(node) = + |" Flag each declaration of a generic unit in a subprogram. Generic + |" declarations in the bodies of generic subprograms are also flagged. + |" A generic unit nested in another generic unit is not flagged. + |" If a generic unit is + |" declared in a local package that is declared in a subprogram body, the + |" generic unit is flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" procedure Proc is + |" + |" generic -- FLAG + |" type FT is range <>; + |" function F_G (I : FT) return FT; node is GenericDecl(any parent: BaseSubpBody, all parent: not GenericPackageDecl) diff --git a/lkql_checker/share/lkql/global_variables.lkql b/lkql_checker/share/lkql/global_variables.lkql index b503e042f..4495770b3 100644 --- a/lkql_checker/share/lkql/global_variables.lkql +++ b/lkql_checker/share/lkql/global_variables.lkql @@ -1,13 +1,29 @@ -# Flag any variable declaration that appears immediately within the -# specification of a library package or library generic package. Variable -# declarations in nested packages and inside package instantiations are not -# flagged. -# This rule has parameter Only_Public: Do not flag variable declarations in -# private library (generic) packages and in package private parts. - @check(message="declaration of global variable", category="Style", subcategory="Programming Practice") fun global_variables(node, only_public=false) = + |" Flag any variable declaration that appears immediately within the + |" specification of a library package or library generic package. Variable + |" declarations in nested packages and inside package instantiations are + |" not flagged. + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *Only_Public: bool* + |" If ``true``, do not flag variable declarations in private library (generic) + |" packages and in package private parts. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2, 5 + |" + |" package Foo is + |" Var1 : Integer; -- FLAG + |" procedure Proc; + |" private + |" Var2 : Boolean; -- FLAG + |" end Foo; node is ObjectDecl(p_is_constant_object(): false, p_semantic_parent(): s when { diff --git a/lkql_checker/share/lkql/goto_statements.lkql b/lkql_checker/share/lkql/goto_statements.lkql index 1b8b2551b..3a317089b 100644 --- a/lkql_checker/share/lkql/goto_statements.lkql +++ b/lkql_checker/share/lkql/goto_statements.lkql @@ -1,10 +1,34 @@ -# Flag each occurrence of a goto statement. - -@check(message="goto statement", +@check(message="goto statement", rule_name="GOTO_Statements", category="Style", subcategory="Programming Practice") fun goto_statements(node, only_unconditional=false) = - node is GotoStmt - # If unconditional option is true, only flag unconditional goto statements - when not only_unconditional - or not node.parent.parent - is (IfStmt | CaseStmtAlternative | ElsePart | ElsifStmtPart) + |" Flag each occurrence of a ``goto`` statement. + |" + |" This rule has the following optional parameter for the ``+R`` option and for + |" LKQL rule options files: + |" + |" *Only_Unconditional: bool* + |" If ``true``, Only flag unconditional goto statements, that is, goto statements + |" that are not directly enclosed in an if or a case statement. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" for K in 1 .. 10 loop + |" if K = 6 then + |" goto Quit; -- FLAG only if Only_Unconditional is false + |" end if; + |" null; + |" end loop; + |" goto Next; -- FLAG in any case + |" <> + |" + |" <> + |" null; + |" return; + node is GotoStmt + # If unconditional option is true, only flag unconditional goto statements + when not only_unconditional + or not node.parent.parent + is (IfStmt | CaseStmtAlternative | ElsePart | ElsifStmtPart) diff --git a/lkql_checker/share/lkql/headers.lkql b/lkql_checker/share/lkql/headers.lkql index 0a135ad00..783087b3c 100644 --- a/lkql_checker/share/lkql/headers.lkql +++ b/lkql_checker/share/lkql/headers.lkql @@ -1,10 +1,20 @@ -# Flag each compilation unit not starting with the given `header`. -# For gnatcheck: the Header parameter is the name of a file containing the -# expected header. - @unit_check(help="compilation unit does not start with header", category="Style", subcategory="Readability") fun headers(unit, header = "") = + |" Check that the source text of a compilation unit starts from + |" the text fragment specified as a rule parameter. + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *Header: string* + |" The name of a header file. + |" + |" A header file is a plain text file. The rule checks that + |" the beginning of the compilation unit source text is literally + |" the same as the content of the header file. Blank lines and trailing + |" spaces are not ignored and are taken into account, casing is important. + |" The format of the line breaks (DOS or UNIX) is not important. if unit.text.starts_with(header) then [] else [{message: "compilation unit does not start with header", diff --git a/lkql_checker/share/lkql/identifier_casing.lkql b/lkql_checker/share/lkql/identifier_casing.lkql index c0fb4799a..a1f94026e 100644 --- a/lkql_checker/share/lkql/identifier_casing.lkql +++ b/lkql_checker/share/lkql/identifier_casing.lkql @@ -1,32 +1,3 @@ -# Flag each defining identifier that does not have a casing corresponding to -# the kind of entity being declared. All defining names are checked. -# The rule may have the following parameters: -# - Type=casing_scheme -# Specifies casing for names from type and subtype declarations. -# - Enum=casing_scheme -# Specifies the casing of defining enumeration literals and for the defining -# names in a function renaming declarations if the renamed entity is an -# enumeration literal. -# - Constant=casing_scheme -# Specifies the casing for defining names from constants and named number -# declarations, 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 defining names for which no special casing -# scheme is specified. If this parameter is not set, the casing for the -# entities that do not correspond to the specified parameters is not checked. -# - Exclude -# Specifies a list of full identifier casing exceptions. -# -# Where: casing_scheme ::= upper|lower|mixed -# upper means that the defining identifier should be upper-case. lower means -# that the defining identifier should be lower-case mixed means that the first -# defining identifier letter and the first letter after each underscore should -# be upper-case, and all the other letters should be lower-case. - import stdlib fun wrong_casing(str, scheme) = @@ -101,68 +72,219 @@ fun check_casing(id, scheme, exclude) = category="Style", subcategory="Readability") fun identifier_casing(unit, type="", enum="", constant="", exception="", others="", - exclude=[]) = [ - {message: n.text & " does not have casing specified " & - ({ - fun msg(str, scheme) = - if wrong_casing(n.text, scheme) - then str & scheme & ")" else "in the dictionary"; - - match n.parent - | (t@BaseTypeDecl when t is (not SingleTaskTypeDecl | - p@TaskBody when p.p_previous_part() is not SingleTaskDecl)) - when type != "" => msg("for subtype names (", type) - | EnumLiteralDecl when enum != "" - => msg("for enumeration literals (", enum) - - | p => - match p.parent - | (ObjectDecl(p_is_constant_object(): true) | - NumberDecl) when constant != "" - => msg("for constant names (", constant) - - | SubpRenamingDecl when enum != "" + exclude=[]) = + |" Flag each defining identifier that does not have a casing corresponding to the + |" kind of entity being declared. All 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 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 for ``+R`` option and for LKQL rule + |" options files: + |" + |" *Type: casing_scheme* + |" Specifies casing for names from type and subtype declarations. + |" + |" *Enum: casing_scheme* + |" Specifies the casing of defining enumeration literals and for the + |" defining names in a function renaming declarations if the renamed + |" entity is an enumeration literal. + |" + |" *Constant: casing_scheme* + |" Specifies the casing for defining names from constants and named number + |" declarations, 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 defining names for which no special casing + |" scheme is specified. If this parameter is not set, the casing for the + |" entities that do not correspond to the specified parameters is not checked. + |" + |" *Exclude: string* + |" The name of a dictionary file to specify casing exceptions. The name of the + |" file may contain references to environment variables (e.g. + |" $REPOSITORY_ROOT/my_dict.txt), they are replaced by the values of these + |" variables. + |" + |" Where *casing_scheme* is a string and: + |" :: + |" + |" casing_scheme ::= upper|lower|mixed + |" + |" *upper* means that the defining identifier should be upper-case. + |" *lower* means that the defining identifier should be lower-case + |" *mixed* means that the first defining identifier letter and the first + |" letter after each underscore should be upper-case, and all the other + |" letters should be lower-case + |" + |" You have to use the ``param_name=value`` formatting to pass arguments through + |" the ``+R`` options. Example: ``+RIdentifier_Casing:Type=mixed,Others=lower``. + |" + |" If a defining identifier is from a declaration for which 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. + |" + |" *Exclude* is the name of the text file that contains casing exceptions. The way + |" how this rule is using the casing exception dictionary file is consistent with + |" using the casing exception dictionary in the GNAT pretty-printer *gnatpp*, see + |" GNAT User's Guide. + |" + |" There are two kinds of exceptions: + |" + |" *identifier* + |" If a dictionary file contains an identifier, then each occurrence of that + |" (defining) identifier in the checked source should use the casing specified + |" included in *dictionary_file* + |" + |" *wildcard* + |" A wildcard has the following syntax + |" + |" :: + |" + |" wildcard ::= *simple_identifier* | + |" *simple_identifier | + |" simple_identifier* + |" simple_identifier ::= letter{letter_or_digit} + |" + |" ``simple_identifier`` specifies the casing of subwords (the term 'subword' + |" is used below to denote the part of a name which is delimited by '_' or by + |" the beginning or end of the word and which does not contain any '_' inside). + |" A wildcard of the form ``simple_identifier*`` defines the casing of the + |" first subword of a defining name to check, the wildcard of the form + |" ``*simple_identifier`` specifies the casing of the last subword, and + |" the wildcard of the form ``*simple_identifier*`` specifies the casing of + |" any subword. + |" + |" If for a defining identifier some of its subwords can be mapped onto + |" wildcards, but some other cannot, the casing of the identifier subwords + |" that are not mapped onto wildcards from casing exception dictionary + |" is checked against the casing scheme defined for the corresponding + |" entity. + |" + |" If some identifier is included in the exception dictionary both as a whole + |" identifier and can be mapped onto some wildcard from the + |" dictionary, then it is the identifier and not the wildcard that 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(s) has a higher priority than checks + |" against the casing scheme specified for a given entity/declaration kind. + |" + |" The rule activation option should contain at least one parameter. + |" + |" The rule allows parametric exemption, the parameters that are allowed in + |" the definition of exemption sections are: + |" + |" *Type* + |" Exempts check for type and subtype name casing + |" + |" *Enum* + |" Exempts check for enumeration literal name casing + |" + |" *Constant* + |" Exempts check for constant name casing + |" + |" *Exception* + |" Exempts check for exception name casing + |" + |" *Others* + |" Exempts check for defining names for which no special casing scheme is specified. + |" + |" *Exclude* + |" Exempts check for defining names for which casing schemes are specified in exception + |" dictionaries + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4, 7 + |" + |" -- if the rule is activated as '+RIdentifier_Casing:Type=upper,Others=mixed' + |" package Foo is + |" type ENUM_1 is (A1, B1, C1); + |" type Enum_2 is (A2, B2, C2); -- FLAG + |" + |" Var1 : Enum_1 := A1; + |" VAR2 : ENUM_2 := A2; -- FLAG + |" end Foo; + [ + {message: n.text & " does not have casing specified " & + ({ + fun msg(str, scheme) = + if wrong_casing(n.text, scheme) + then str & scheme & ")" else "in the dictionary"; + + match n.parent + | (t@BaseTypeDecl when t is (not SingleTaskTypeDecl | + p@TaskBody when p.p_previous_part() is not SingleTaskDecl)) + when type != "" => msg("for subtype names (", type) + | EnumLiteralDecl when enum != "" => msg("for enumeration literals (", enum) - | ExceptionDecl when exception != "" - => msg("for exception names (", exception) - - | * => msg("(", others) - }), - loc: n} - for n in from unit.root - select node@DefiningName(f_name: id@Identifier) - when match node.parent - # Task objects - | (SingleTaskDecl | SingleTaskTypeDecl) - => check_casing(id, others, exclude) - - # Types and subtypes, including TaskBody when the spec is a task type - | (BaseTypeDecl | - p@TaskBody when p.p_previous_part() is not SingleTaskDecl) - when type != "" => check_casing(id, type, exclude) - - # Enums - | EnumLiteralDecl when enum != "" => check_casing(id, enum, exclude) - - # Look one level up for remaining cases - | p => match p.parent - - # Constants - | (ObjectDecl(p_is_constant_object(): true) | - NumberDecl) when constant != "" - => - check_casing(id, constant, exclude) - - # Function renaming an enum literal - | r@SubpRenamingDecl - when r.f_renames.f_renamed_object.p_referenced_decl() is - EnumLiteralDecl and enum != "" => check_casing(id, enum, exclude) - - # Exceptions - | ExceptionDecl when exception != "" - => check_casing(id, exception, exclude) - - # Other cases - | * => check_casing(id, others, exclude) -] + | p => + match p.parent + | (ObjectDecl(p_is_constant_object(): true) | + NumberDecl) when constant != "" + => msg("for constant names (", constant) + + | SubpRenamingDecl when enum != "" + => msg("for enumeration literals (", enum) + + | ExceptionDecl when exception != "" + => msg("for exception names (", exception) + + | * => msg("(", others) + }), + loc: n} + for n in from unit.root + select node@DefiningName(f_name: id@Identifier) + when match node.parent + # Task objects + | (SingleTaskDecl | SingleTaskTypeDecl) + => check_casing(id, others, exclude) + + # Types and subtypes, including TaskBody when the spec is a task type + | (BaseTypeDecl | + p@TaskBody when p.p_previous_part() is not SingleTaskDecl) + when type != "" => check_casing(id, type, exclude) + + # Enums + | EnumLiteralDecl when enum != "" => check_casing(id, enum, exclude) + + # Look one level up for remaining cases + | p => match p.parent + + # Constants + | (ObjectDecl(p_is_constant_object(): true) | + NumberDecl) when constant != "" + => + check_casing(id, constant, exclude) + + # Function renaming an enum literal + | r@SubpRenamingDecl + when r.f_renames.f_renamed_object.p_referenced_decl() is + EnumLiteralDecl and enum != "" => check_casing(id, enum, exclude) + + # Exceptions + | ExceptionDecl when exception != "" + => check_casing(id, exception, exclude) + + # Other cases + | * => check_casing(id, others, exclude) + ] diff --git a/lkql_checker/share/lkql/identifier_prefixes.lkql b/lkql_checker/share/lkql/identifier_prefixes.lkql index ad0fca064..7cf5aeb7f 100644 --- a/lkql_checker/share/lkql/identifier_prefixes.lkql +++ b/lkql_checker/share/lkql/identifier_prefixes.lkql @@ -1,77 +1,3 @@ -# 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 specifications (not including character literals) and -# function renaming declarations if the renaming entity is an enumeration -# literal; -# - exception declarations and exception renaming declarations; -# - constant and 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 subprogram renaming-as-body declaration is never -# flagged. -# For a deferred constant, the defining name in the corresponding full constant -# 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. -# -# 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: -# - 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_Access=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=[list of string1:string2] -# Specifies the prefixes for types that are directly derived from a given type -# or from a subtype thereof. string1 should be a full expanded Ada name of -# an ancestor type (starting from the full expanded compilation unit name), -# string2 defines the prefix to check. If this parameter is set, it overrides -# for types that are directly derived from the given type the prefix set by -# the Type parameter. -# - Constant=string -# Specifies the prefix for defining names from constants and named number -# declarations, including the object renaming declaration if the renamed -# object is a constant -# - Enum=string -# Specifies the prefix for defining enumeration literals and for the defining -# names in a function renaming declarations if the renamed entity is an -# enumeration literal. -# - Exception=string -# Specifies the prefix for defining names from exception declarations and -# exception renaming declarations. -# - Exclusive -# Check that only those kinds of names for which specific prefix is defined -# have that prefix (e.g., only type/subtype names have prefix T_, but not -# variable or package names), and flag all defining names that have any of -# the specified prefixes but do not belong to the kind of entities this -# prefix is defined for. -# -# All checks for name prefixes are case-sensitive - import stdlib fun get_derived(t, derived) = { @@ -95,177 +21,335 @@ fun identifier_prefixes(unit, constant="-", exception="-", enum="-", - exclusive=true) = { - fun check_exclusive(str, exclusive, - type_exclusive=true, concurrent_exclusive=true, - access_exclusive=true, class_access_exclusive=true, - subprogram_access_exclusive=true, - constant_exclusive=true, exception_exclusive=true, - enum_exclusive=true) = - exclusive and - ((type_exclusive and str.starts_with(type)) or - (concurrent_exclusive and str.starts_with(concurrent)) or - (access_exclusive and str.starts_with(access)) or - (class_access_exclusive and str.starts_with(class_access)) or - (subprogram_access_exclusive and str.starts_with(subprogram_access)) or - (constant_exclusive and str.starts_with(constant)) or - (exception_exclusive and str.starts_with(exception)) or - (enum_exclusive and str.starts_with(enum))); + exclusive=true) = + |" 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 specifications (not including character literals) + |" and function renaming declarations if the renaming entity is an + |" enumeration literal; + |" * exception declarations and exception renaming declarations; + |" * constant and 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 subprogram renaming-as-body declaration is + |" never flagged. + |" + |" For a deferred constant, the defining name in the corresponding full + |" constant 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. + |" + |" 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 for the ``+R`` option and for LKQL + |" rule options files: + |" + |" *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_Access: 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: string* + |" Specifies the prefix for a type that is directly derived from a given type or + |" from a subtype thereof. The parameter must have the ``string1:string2`` format + |" where *string1* should be a full expanded Ada name of the ancestor type + |" (starting from the full expanded compilation unit name) and *string2* defines + |" the prefix to check. If this parameter is set, it overrides for types that + |" are directly derived from the given type the prefix set by the ``Type`` + |" parameter. + |" + |" *Constant: string* + |" Specifies the prefix for defining names from constants and named number + |" declarations, including the object renaming declaration if the + |" renamed object is a constant + |" + |" *Enum: string* + |" Specifies the prefix for defining enumeration literals and for the + |" defining names in a function renaming declarations if the renamed + |" entity is an enumeration literal. + |" + |" *Exception: string* + |" Specifies the prefix for defining names from exception declarations + |" and exception renaming declarations. + |" + |" *Exclusive: bool* + |" If ``true``, check that only those kinds of names for which specific prefix + |" is defined have that prefix (e.g., only type/subtype names have prefix *T_*, + |" but not variable or package names), and flag all defining names that have any + |" of the specified prefixes but do not belong to the kind of entities this + |" prefix is defined for. By default the exclusive check mode is ON. + |" + |" You have to use the ``param_name=value`` formatting to pass arguments through + |" the ``+R`` options. Example: ``+RIdentifier_Prefixes:Type=Type_,Enum=Enum_``. + |" + |" The ``+RIdentifier_Prefixes`` option (with no parameter) does not create a new + |" instance for the rule; thus, it has no effect on the current GNATcheck run. + |" + |" There is no default prefix setting for this rule. All checks for + |" name prefixes are case-sensitive + |" + |" If any error is detected in a rule parameter, that parameter is ignored. + |" In such a case the options that are set for the rule are not specified. + |" + |" The rule allows parametric exemption, the parameters that are allowed in + |" the definition of exemption sections are: + |" + |" *Type* + |" Exempts check for type and subtype name prefixes + |" + |" *Concurrent* + |" Exempts check for task and protected type/subtype name prefixes + |" + |" *Access* + |" Exempts check for access type/subtype name prefixes + |" + |" *Class_Access* + |" Exempts check for names of access types/subtypes that point to + |" some class-wide types + |" + |" *Subprogram_Access* + |" Exempts check for names of access types/subtypes that point to + |" subprograms + |" + |" *Derived* + |" Exempts check for derived type name prefixes + |" + |" + |" *Constant* + |" Exempts check for constant and number name prefixes + |" + |" *Exception* + |" Exempts check for exception name prefixes + |" + |" *Enum* + |" Exempts check for enumeration literal name prefixes + |" + |" *Exclusive* + |" Exempts check that only names of specific kinds of entities have prefixes + |" specified for these kinds + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4, 7, 10 + |" + |" -- if the rule is activated as '+RIdentifier_Prefixes:Type=Type_,Constant=Const_,ExceptioN=X_' + |" package Foo is + |" type Type_Enum_1 is (A1, B1, C1); + |" type Enum_2 is (A2, B2, C2); -- FLAG + |" + |" Const_C1 : constant Type_Enum_1 := A1; + |" Const2 : constant Enum_2 := A2; -- FLAG + |" + |" X_Exc_1 : exception; + |" Exc_2 : exception; -- FLAG + |" end Foo; + { + fun check_exclusive(str, exclusive, + type_exclusive=true, concurrent_exclusive=true, + access_exclusive=true, class_access_exclusive=true, + subprogram_access_exclusive=true, + constant_exclusive=true, exception_exclusive=true, + enum_exclusive=true) = + exclusive and + ((type_exclusive and str.starts_with(type)) or + (concurrent_exclusive and str.starts_with(concurrent)) or + (access_exclusive and str.starts_with(access)) or + (class_access_exclusive and str.starts_with(class_access)) or + (subprogram_access_exclusive and str.starts_with(subprogram_access)) or + (constant_exclusive and str.starts_with(constant)) or + (exception_exclusive and str.starts_with(exception)) or + (enum_exclusive and str.starts_with(enum))); - fun check_enum(str) = - (enum != "-" and not str.starts_with(enum)) or - check_exclusive(str, exclusive=exclusive, enum_exclusive=false); + fun check_enum(str) = + (enum != "-" and not str.starts_with(enum)) or + check_exclusive(str, exclusive=exclusive, enum_exclusive=false); - val str_prefix = " does not start with "; + val str_prefix = " does not start with "; - [{message: n.text & - (match n.parent - | p@(TaskTypeDecl | ProtectedTypeDecl | - SubtypeDecl(p_canonical_type(): TaskTypeDecl | ProtectedTypeDecl)) - when p is not SingleTaskTypeDecl and concurrent != "-" - => str_prefix & "concurrent prefix " & concurrent - | (TypeDecl(f_type_def: TypeAccessDef(f_subtype_indication: *(f_name: - AttributeRef(f_attribute: Identifier(p_name_is("Class"): true))))) | - SubtypeDecl(p_canonical_type(): TypeDecl(f_type_def: - TypeAccessDef(f_subtype_indication: *(f_name: - AttributeRef(f_attribute: Identifier(p_name_is("Class"): true))))))) - when class_access != "-" => str_prefix & "access-to-class prefix " & class_access - | (TypeDecl(f_type_def: AccessToSubpDef) | - SubtypeDecl(p_canonical_type(): - TypeDecl(f_type_def: AccessToSubpDef))) - when subprogram_access != "-" => - str_prefix & "access-to-subprogram prefix " & subprogram_access - | (TypeDecl(f_type_def: AccessDef) | - SubtypeDecl(p_canonical_type(): TypeDecl(f_type_def: AccessDef))) - when access != "-" => str_prefix & "access prefix " & access + [{message: n.text & + (match n.parent + | p@(TaskTypeDecl | ProtectedTypeDecl | + SubtypeDecl(p_canonical_type(): TaskTypeDecl | ProtectedTypeDecl)) + when p is not SingleTaskTypeDecl and concurrent != "-" + => str_prefix & "concurrent prefix " & concurrent + | (TypeDecl(f_type_def: TypeAccessDef(f_subtype_indication: *(f_name: + AttributeRef(f_attribute: Identifier(p_name_is("Class"): true))))) | + SubtypeDecl(p_canonical_type(): TypeDecl(f_type_def: + TypeAccessDef(f_subtype_indication: *(f_name: + AttributeRef(f_attribute: Identifier(p_name_is("Class"): true))))))) + when class_access != "-" => str_prefix & "access-to-class prefix " & class_access + | (TypeDecl(f_type_def: AccessToSubpDef) | + SubtypeDecl(p_canonical_type(): + TypeDecl(f_type_def: AccessToSubpDef))) + when subprogram_access != "-" => + str_prefix & "access-to-subprogram prefix " & subprogram_access + | (TypeDecl(f_type_def: AccessDef) | + SubtypeDecl(p_canonical_type(): TypeDecl(f_type_def: AccessDef))) + when access != "-" => str_prefix & "access prefix " & access - | p@(TypeDecl(f_type_def: DerivedTypeDef) | SubtypeDecl) - when derived != [] and - p.p_canonical_type().p_base_type() is t@BaseTypeDecl - when get_derived(t, derived) != "" - => { - val t = p.p_canonical_type().p_base_type(); - str_prefix & "derived prefix " & get_derived(t, derived) - .split(":")[2] - } + | p@(TypeDecl(f_type_def: DerivedTypeDef) | SubtypeDecl) + when derived != [] and + p.p_canonical_type().p_base_type() is t@BaseTypeDecl + when get_derived(t, derived) != "" + => { + val t = p.p_canonical_type().p_base_type(); + str_prefix & "derived prefix " & get_derived(t, derived) + .split(":")[2] + } - | BaseTypeDecl => str_prefix & "subtype prefix " & type - | EnumLiteralDecl => str_prefix & "enumeration prefix " & enum - | p => match p.parent - | (ObjectDecl | NumberDecl) => - str_prefix & "constant prefix " & constant - | SubpRenamingDecl => str_prefix & "enumeration prefix " & enum - | ExceptionDecl => str_prefix & "exception prefix " & exception - | * => " does not have an exclusive prefix"), - loc: n} - for n in from unit.root select node@DefiningName when match node.parent - # Concurrent types - | p@(TaskTypeDecl | ProtectedTypeDecl | TaskBody | ProtectedBody | - SubtypeDecl(p_canonical_type(): TaskTypeDecl | ProtectedTypeDecl)) - when p is not SingleTaskTypeDecl and concurrent != "-" - => - p.p_previous_part() is (null | IncompleteTypeDecl) and - (if node.f_name.text.starts_with(concurrent) - then check_exclusive(node.f_name.text, - exclusive=exclusive, - concurrent_exclusive=false)) + | BaseTypeDecl => str_prefix & "subtype prefix " & type + | EnumLiteralDecl => str_prefix & "enumeration prefix " & enum + | p => match p.parent + | (ObjectDecl | NumberDecl) => + str_prefix & "constant prefix " & constant + | SubpRenamingDecl => str_prefix & "enumeration prefix " & enum + | ExceptionDecl => str_prefix & "exception prefix " & exception + | * => " does not have an exclusive prefix"), + loc: n} + for n in from unit.root select node@DefiningName when match node.parent + # Concurrent types + | p@(TaskTypeDecl | ProtectedTypeDecl | TaskBody | ProtectedBody | + SubtypeDecl(p_canonical_type(): TaskTypeDecl | ProtectedTypeDecl)) + when p is not SingleTaskTypeDecl and concurrent != "-" + => + p.p_previous_part() is (null | IncompleteTypeDecl) and + (if node.f_name.text.starts_with(concurrent) + then check_exclusive(node.f_name.text, + exclusive=exclusive, + concurrent_exclusive=false)) - # 'Class access - | (p@TypeDecl(f_type_def: TypeAccessDef(f_subtype_indication: *(f_name: - AttributeRef(f_attribute: Identifier(p_name_is("Class"): true))))) | - p@SubtypeDecl(p_canonical_type(): TypeDecl(f_type_def: - TypeAccessDef(f_subtype_indication: *(f_name: - AttributeRef(f_attribute: Identifier(p_name_is("Class"): true))))))) - when class_access != "-" - => - p?.p_previous_part() is (null | IncompleteTypeDecl) and - (if node.f_name.text.starts_with(class_access) - then check_exclusive(node.f_name.text, - exclusive=exclusive, - class_access_exclusive=false)) + # 'Class access + | (p@TypeDecl(f_type_def: TypeAccessDef(f_subtype_indication: *(f_name: + AttributeRef(f_attribute: Identifier(p_name_is("Class"): true))))) | + p@SubtypeDecl(p_canonical_type(): TypeDecl(f_type_def: + TypeAccessDef(f_subtype_indication: *(f_name: + AttributeRef(f_attribute: Identifier(p_name_is("Class"): true))))))) + when class_access != "-" + => + p?.p_previous_part() is (null | IncompleteTypeDecl) and + (if node.f_name.text.starts_with(class_access) + then check_exclusive(node.f_name.text, + exclusive=exclusive, + class_access_exclusive=false)) - # Subprogram access - | (p@TypeDecl(f_type_def: AccessToSubpDef) | - p@SubtypeDecl(p_canonical_type(): - TypeDecl(f_type_def: AccessToSubpDef))) - when subprogram_access != "-" - => - p?.p_previous_part() is (null | IncompleteTypeDecl) and - (if node.f_name.text.starts_with(subprogram_access) - then check_exclusive(node.f_name.text, - exclusive=exclusive, - subprogram_access_exclusive=false)) + # Subprogram access + | (p@TypeDecl(f_type_def: AccessToSubpDef) | + p@SubtypeDecl(p_canonical_type(): + TypeDecl(f_type_def: AccessToSubpDef))) + when subprogram_access != "-" + => + p?.p_previous_part() is (null | IncompleteTypeDecl) and + (if node.f_name.text.starts_with(subprogram_access) + then check_exclusive(node.f_name.text, + exclusive=exclusive, + subprogram_access_exclusive=false)) - # Other access types - | (p@TypeDecl(f_type_def: AccessDef) | - p@SubtypeDecl(p_canonical_type(): TypeDecl(f_type_def: AccessDef))) - when access != "-" - => - p?.p_previous_part() is (null | IncompleteTypeDecl) and - (if node.f_name.text.starts_with(access) - then check_exclusive(node.f_name.text, - exclusive=exclusive, - access_exclusive=false, - # If both an Access prefix and a Type prefix are - # set and the type prefix is a prefix of the access - # prefix, we don't want to flag this access because - # it broke the exclusivity of the type prefix. - type_exclusive=false)) + # Other access types + | (p@TypeDecl(f_type_def: AccessDef) | + p@SubtypeDecl(p_canonical_type(): TypeDecl(f_type_def: AccessDef))) + when access != "-" + => + p?.p_previous_part() is (null | IncompleteTypeDecl) and + (if node.f_name.text.starts_with(access) + then check_exclusive(node.f_name.text, + exclusive=exclusive, + access_exclusive=false, + # If both an Access prefix and a Type prefix are + # set and the type prefix is a prefix of the access + # prefix, we don't want to flag this access because + # it broke the exclusivity of the type prefix. + type_exclusive=false)) - # (Sub)Types derived from `derived` - | p@(TypeDecl(f_type_def: DerivedTypeDef) | SubtypeDecl) - when derived != [] and - p.p_canonical_type().p_base_type() is t@BaseTypeDecl - when get_derived(t, derived) != "" - => { - val t = p.p_canonical_type().p_base_type(); - p.p_previous_part() is (null | IncompleteTypeDecl) and - not node.f_name.text.starts_with(get_derived(t, derived) - .split(":")[2]) - } + # (Sub)Types derived from `derived` + | p@(TypeDecl(f_type_def: DerivedTypeDef) | SubtypeDecl) + when derived != [] and + p.p_canonical_type().p_base_type() is t@BaseTypeDecl + when get_derived(t, derived) != "" + => { + val t = p.p_canonical_type().p_base_type(); + p.p_previous_part() is (null | IncompleteTypeDecl) and + not node.f_name.text.starts_with(get_derived(t, derived) + .split(":")[2]) + } - # Exclude IncompleteTypeDecl - | IncompleteTypeDecl => false + # Exclude IncompleteTypeDecl + | IncompleteTypeDecl => false - # Other types and subtypes - | p@BaseTypeDecl when p is not SingleTaskTypeDecl => - p.p_previous_part() is (null | IncompleteTypeDecl) and - ((type != "-" and not node.f_name.text.starts_with(type)) or - check_exclusive(node.f_name.text, - exclusive=exclusive, - type_exclusive=false)) + # Other types and subtypes + | p@BaseTypeDecl when p is not SingleTaskTypeDecl => + p.p_previous_part() is (null | IncompleteTypeDecl) and + ((type != "-" and not node.f_name.text.starts_with(type)) or + check_exclusive(node.f_name.text, + exclusive=exclusive, + type_exclusive=false)) - # Enums - | EnumLiteralDecl => check_enum(node.f_name.text) + # Enums + | EnumLiteralDecl => check_enum(node.f_name.text) - # Look one level up for remaining cases - | p => match p.parent - # Constants - | ((ObjectDecl(p_is_constant_object(): true) when not node.p_previous_part()) - | NumberDecl) - => - (constant != "-" and not node.f_name.text.starts_with(constant)) or - check_exclusive(node.f_name.text, - exclusive=exclusive, - constant_exclusive=false) + # Look one level up for remaining cases + | p => match p.parent + # Constants + | ((ObjectDecl(p_is_constant_object(): true) when not node.p_previous_part()) + | NumberDecl) + => + (constant != "-" and not node.f_name.text.starts_with(constant)) or + check_exclusive(node.f_name.text, + exclusive=exclusive, + constant_exclusive=false) - # Function renaming an enum literal - | r@SubpRenamingDecl - when r.f_renames?.f_renamed_object?.p_referenced_decl() is EnumLiteralDecl - => check_enum(node.f_name.text) + # Function renaming an enum literal + | r@SubpRenamingDecl + when r.f_renames?.f_renamed_object?.p_referenced_decl() is EnumLiteralDecl + => check_enum(node.f_name.text) - # Exceptions - | ExceptionDecl => - (exception != "-" and not node.f_name.text.starts_with(exception)) or - check_exclusive(node.f_name.text, - exclusive=exclusive, - exception_exclusive=false) + # Exceptions + | ExceptionDecl => + (exception != "-" and not node.f_name.text.starts_with(exception)) or + check_exclusive(node.f_name.text, + exclusive=exclusive, + exception_exclusive=false) - # Check all other defining names for exclusion except for completions - # and renaming-as-body - | p2 => - (if p2 is (BodyNode | SubpRenamingDecl) then not p2.p_previous_part()) and - (if p2 is ObjectDecl then not node.p_previous_part()) and - check_exclusive(node.f_name.text, exclusive=exclusive)] -} + # Check all other defining names for exclusion except for completions + # and renaming-as-body + | p2 => + (if p2 is (BodyNode | SubpRenamingDecl) then not p2.p_previous_part()) and + (if p2 is ObjectDecl then not node.p_previous_part()) and + check_exclusive(node.f_name.text, exclusive=exclusive)] + } diff --git a/lkql_checker/share/lkql/identifier_suffixes.lkql b/lkql_checker/share/lkql/identifier_suffixes.lkql index 5dd0650f9..617cb4597 100644 --- a/lkql_checker/share/lkql/identifier_suffixes.lkql +++ b/lkql_checker/share/lkql/identifier_suffixes.lkql @@ -1,66 +1,3 @@ -# Flag the declaration of each identifier that does not have a suffix -# corresponding to the kind of entity being declared. The following -# declarations are checked: -# - type declarations -# - subtype declarations -# - object declarations (variable and constant declarations, but not number -# declarations, record component declarations, parameter specifications, -# extended return object declarations, formal object declarations) -# - package renaming declarations (but not generic package renaming -# declarations) -# -# Defining identifiers from incomplete type declarations are never flagged. -# -# 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 declaration -# - record component declaration -# - return object declaration -# - parameter specification -# - extended return object declaration -# - formal object declaration -# -# If both checks for constant suffixes and for access object suffixes are -# enabled, and if different suffixes are defined for them, then for constants -# of access type the check for access object suffixes is applied. -# -# The rule may have the following parameters: -# - 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 the Type_Suffix parameter. -# - Access_Access_Sufix=string -# When the designated type is also an access type, the type name should have -# the Access_Suffix & Access_Access_Sufix suffix. -# - Class_Access_Suffix=string -# Specifies the suffix for the name of an access type that points to some -# class-wide type. If this parameter is set, it overrides for such access -# types the suffix set by the Type_Suffix or Access_Suffix parameter. -# - Class_Subtype_Suffix=string -# Specifies the suffix for the name of a subtype that denotes a class-wide -# type. -# - Constant_Suffix=string -# Specifies the suffix for a constant name. -# - Renaming_Suffix=string -# Specifies the suffix for a 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=string -# Specifies the suffix for protected subprograms used as interrupt handlers. - import stdlib @unit_check(help="suffixes in defining names", remediation="EASY", @@ -75,110 +12,255 @@ fun identifier_suffixes(unit, constant_suffix="", renaming_suffix="", access_obj_suffix="", - interrupt_suffix="") = [ - {message: n.text & " does not end with " & - match n.parent - | SubpSpec when interrupt_suffix != "" => - "interrupt suffix " & interrupt_suffix - | TypeDecl(p_is_access_type(): true, - p_accessed_type(): - ClasswideTypeDecl | - SubtypeDecl(p_canonical_type(): - ClasswideTypeDecl)) - when class_access_suffix != "" => - "access-to-class suffix " & class_access_suffix - | BaseSubtypeDecl(p_base_subtype(): ClasswideTypeDecl) - when class_subtype_suffix != "" => - "class-wide suffix " & class_subtype_suffix - | p@TypeDecl(p_is_access_type(): true) - when access_suffix != "" => - if access_access_suffix != "" and - p.p_accessed_type() is - BaseTypeDecl(p_is_access_type(): true) - then "access-to-access suffix " & access_suffix & access_access_suffix - else "access suffix " & access_suffix - | TypeDecl => "type suffix " & type_suffix - | PackageRenamingDecl => "renaming suffix " & renaming_suffix - | p => if p.parent is not ObjectDecl or - constant_suffix == "" or - p.parent.f_type_expr.p_designated_type_decl() - .p_is_access_type() - then "access object suffix " & access_obj_suffix - else "constant suffix " & constant_suffix, - loc: n} - for n in from unit.root select node@DefiningName when match node.parent - # Interrupt handlers - | s@SubpSpec when interrupt_suffix != "" => - s is SubpSpec(any parent(depth=4): ProtectedDef, parent: d@SubpDecl) - when (d.p_has_aspect("Interrupt_Handler") or - d.p_has_aspect("Attach_Handler")) and - not node.f_name.text.ends_with(interrupt_suffix) + interrupt_suffix="") = + |" Flag the declaration of each identifier that does not have a suffix + |" corresponding to the kind of entity being declared. + |" The following declarations are checked: + |" + |" * type declarations + |" * subtype declarations + |" * object declarations (variable and constant declarations, but not number, + |" declarations, record component declarations, parameter specifications, + |" extended return object declarations, formal object declarations) + |" * package renaming declarations (but not generic package renaming + |" declarations) + |" + |" The default checks (enforced by the *Default* rule parameter) are: + |" + |" * type-defining names end with ``_T``, unless the type is an access type, + |" in which case the suffix must be ``_A`` + |" * constant names end with ``_C`` + |" * names defining package renamings end with ``_R`` + |" * the check for access type objects is not enabled + |" + |" Defining identifiers from incomplete type declarations are never flagged. + |" + |" 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 declaration + |" * record component declaration + |" * return object declaration + |" * parameter specification + |" * extended return object declaration + |" * formal object declaration + |" + |" If both checks for constant suffixes and for access object suffixes are + |" enabled, and if different suffixes are defined for them, then for constants + |" of access type the check for access object suffixes is applied. + |" + |" The rule may have the following parameters for ``+R`` option and for LKQL rule + |" options files: + |" + |" *Default: bool* + |" If ``true``, 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 the ``Type_Suffix`` parameter. + |" For access types, this parameter 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* + |" Specifies the suffix for the name of an access type that points to some + |" class-wide type. + |" If this parameter is set, it overrides for such access types the suffix + |" set by the ``Type_Suffix`` or ``Access_Suffix`` parameter. + |" + |" *Class_Subtype_Suffix: string* + |" Specifies the suffix for the name of a subtype that denotes a class-wide type. + |" + |" *Constant_Suffix: string* + |" Specifies the suffix for a constant name. + |" + |" *Renaming_Suffix: string* + |" Specifies the suffix for a 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: string* + |" Specifies the suffix for protected subprograms used as interrupt handlers. + |" + |" You have to use the ``param_name=value`` formatting to pass arguments through + |" the ``+R`` options. Example: ``+RIdentifier_Prefixes:Type=_T,Constant=_C``. + |" + |" The ``+RIdentifier_Prefixes`` option (with no parameter) does not create a new + |" instance for the rule; thus, it has no effect on the current GNATcheck run. + |" + |" The *string* value must be a valid suffix for an Ada identifier (after + |" trimming 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, the parameter is ignored. + |" In such a case the options that are set for the rule are not + |" specified. + |" + |" The rule allows parametric exemption, the parameters that are allowed in + |" the definition of exemption sections are: + |" + |" *Type* + |" Exempts check for type name suffixes + |" + |" *Access* + |" Exempts check for access type name suffixes + |" + |" *Access_Obj* + |" Exempts check for access object name suffixes + |" + |" *Class_Access* + |" Exempts check for names of access types that point to + |" some class-wide types + |" + |" *Class_Subtype* + |" Exempts check for names of subtypes that denote class-wide types + |" + |" *Constant* + |" Exempts check for constant name suffixes + |" + |" *Renaming* + |" Exempts check for package renaming name suffixes + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3, 6, 9 + |" + |" -- if the rule is activated as '+RIdentifier_Suffixes:Access_Suffix=_PTR,Type_Suffix=_T,Constant_Suffix=_C' + |" package Foo is + |" type Int is range 0 .. 100; -- FLAG + |" type Int_T is range 0 .. 100; + |" + |" type Int_A is access Int; -- FLAG + |" type Int_PTR is access Int; + |" + |" Const : constant Int := 1; -- FLAG + |" Const_C : constant Int := 1; + |" + |" end Foo; + [ + {message: n.text & " does not end with " & + match n.parent + | SubpSpec when interrupt_suffix != "" => + "interrupt suffix " & interrupt_suffix + | TypeDecl(p_is_access_type(): true, + p_accessed_type(): + ClasswideTypeDecl | + SubtypeDecl(p_canonical_type(): + ClasswideTypeDecl)) + when class_access_suffix != "" => + "access-to-class suffix " & class_access_suffix + | BaseSubtypeDecl(p_base_subtype(): ClasswideTypeDecl) + when class_subtype_suffix != "" => + "class-wide suffix " & class_subtype_suffix + | p@TypeDecl(p_is_access_type(): true) + when access_suffix != "" => + if access_access_suffix != "" and + p.p_accessed_type() is + BaseTypeDecl(p_is_access_type(): true) + then "access-to-access suffix " & access_suffix & access_access_suffix + else "access suffix " & access_suffix + | TypeDecl => "type suffix " & type_suffix + | PackageRenamingDecl => "renaming suffix " & renaming_suffix + | p => if p.parent is not ObjectDecl or + constant_suffix == "" or + p.parent.f_type_expr.p_designated_type_decl() + .p_is_access_type() + then "access object suffix " & access_obj_suffix + else "constant suffix " & constant_suffix, + loc: n} + for n in from unit.root select node@DefiningName when match node.parent + # Interrupt handlers + | s@SubpSpec when interrupt_suffix != "" => + s is SubpSpec(any parent(depth=4): ProtectedDef, parent: d@SubpDecl) + when (d.p_has_aspect("Interrupt_Handler") or + d.p_has_aspect("Attach_Handler")) and + not node.f_name.text.ends_with(interrupt_suffix) - # 'Class access - | p@TypeDecl(p_is_access_type(): true, - p_accessed_type(): - ClasswideTypeDecl | - SubtypeDecl(p_canonical_type(): ClasswideTypeDecl)) - when class_access_suffix != "" - => - p.p_previous_part() is (null | IncompleteTypeDecl) and - not node.f_name.text.ends_with(class_access_suffix) + # 'Class access + | p@TypeDecl(p_is_access_type(): true, + p_accessed_type(): + ClasswideTypeDecl | + SubtypeDecl(p_canonical_type(): ClasswideTypeDecl)) + when class_access_suffix != "" + => + p.p_previous_part() is (null | IncompleteTypeDecl) and + not node.f_name.text.ends_with(class_access_suffix) - # 'Class subtype - | p@BaseSubtypeDecl(p_base_subtype(): ClasswideTypeDecl) - when class_subtype_suffix != "" - => - p.p_previous_part() is (null | IncompleteTypeDecl) and - not node.f_name.text.ends_with(class_subtype_suffix) + # 'Class subtype + | p@BaseSubtypeDecl(p_base_subtype(): ClasswideTypeDecl) + when class_subtype_suffix != "" + => + p.p_previous_part() is (null | IncompleteTypeDecl) and + not node.f_name.text.ends_with(class_subtype_suffix) - # Other access types - | p@TypeDecl(p_is_access_type(): true) when access_suffix != "" - => - p.p_previous_part() is (null | IncompleteTypeDecl) and - not node.f_name.text.ends_with( - if access_access_suffix != "" - and p.p_accessed_type() is t@BaseTypeDecl - when t.p_is_access_type() - then access_suffix & access_access_suffix - else access_suffix - ) + # Other access types + | p@TypeDecl(p_is_access_type(): true) when access_suffix != "" + => + p.p_previous_part() is (null | IncompleteTypeDecl) and + not node.f_name.text.ends_with( + if access_access_suffix != "" + and p.p_accessed_type() is t@BaseTypeDecl + when t.p_is_access_type() + then access_suffix & access_access_suffix + else access_suffix + ) - # Exclude IncompleteTypeDecl - | IncompleteTypeDecl => false + # Exclude IncompleteTypeDecl + | IncompleteTypeDecl => false - # Other types - | p@TypeDecl => - type_suffix != "" and - p.p_previous_part() is (null | IncompleteTypeDecl) and - not node.f_name.text.ends_with(type_suffix) + # Other types + | p@TypeDecl => + type_suffix != "" and + p.p_previous_part() is (null | IncompleteTypeDecl) and + not node.f_name.text.ends_with(type_suffix) - | p@PackageRenamingDecl => - renaming_suffix != "" and - not node.f_name.text.ends_with(renaming_suffix) + | p@PackageRenamingDecl => + renaming_suffix != "" and + not node.f_name.text.ends_with(renaming_suffix) - # Look one level up for remaining cases - | p => node.p_previous_part() == null and match p.parent - # Access data objects - | (ObjectDecl(f_type_expr: TypeExpr(p_designated_type_decl(): - BaseTypeDecl(p_is_access_type(): true))) | - ComponentDecl(f_component_def: - ComponentDef(f_type_expr: - TypeExpr(p_designated_type_decl(): - BaseTypeDecl(p_is_access_type(): true)))) | - ParamSpec(f_type_expr: - TypeExpr(p_designated_type_decl(): - BaseTypeDecl(p_is_access_type(): true))) | - DiscriminantSpec(f_type_expr: - TypeExpr(p_designated_type_decl(): - BaseTypeDecl(p_is_access_type(): true)))) - when access_obj_suffix != "" - => - not node.f_name.text.ends_with(access_obj_suffix) + # Look one level up for remaining cases + | p => node.p_previous_part() == null and match p.parent + # Access data objects + | (ObjectDecl(f_type_expr: TypeExpr(p_designated_type_decl(): + BaseTypeDecl(p_is_access_type(): true))) | + ComponentDecl(f_component_def: + ComponentDef(f_type_expr: + TypeExpr(p_designated_type_decl(): + BaseTypeDecl(p_is_access_type(): true)))) | + ParamSpec(f_type_expr: + TypeExpr(p_designated_type_decl(): + BaseTypeDecl(p_is_access_type(): true))) | + DiscriminantSpec(f_type_expr: + TypeExpr(p_designated_type_decl(): + BaseTypeDecl(p_is_access_type(): true)))) + when access_obj_suffix != "" + => + not node.f_name.text.ends_with(access_obj_suffix) - # Constants - | ObjectDecl(p_is_constant_object(): true) - when constant_suffix != "" - => - not node.f_name.text.ends_with(constant_suffix) + # Constants + | ObjectDecl(p_is_constant_object(): true) + when constant_suffix != "" + => + not node.f_name.text.ends_with(constant_suffix) - | * => false] + | * => false + ] diff --git a/lkql_checker/share/lkql/implicit_in_mode_parameters.lkql b/lkql_checker/share/lkql/implicit_in_mode_parameters.lkql index 99f3eea39..b6d4b8bcf 100644 --- a/lkql_checker/share/lkql/implicit_in_mode_parameters.lkql +++ b/lkql_checker/share/lkql/implicit_in_mode_parameters.lkql @@ -1,10 +1,19 @@ -# Flag each occurrence of a formal parameter with an implicit in mode. Note -# that access parameters, although they technically behave like in parameters, -# are not flagged. - @check(message="implicit IN mode in parameter specification", + rule_name="Implicit_IN_Mode_Parameters", remediation="TRIVIAL", category="Feature") fun implicit_in_mode_parameters(node) = + |" Flag each occurrence of a formal parameter with an implicit ``in`` mode. + |" Note that ``access`` parameters, although they technically behave + |" like ``in`` parameters, are not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" procedure Proc1 (I : Integer); -- FLAG + |" procedure Proc2 (I : in Integer); + |" procedure Proc3 (I : access Integer); node is ParamSpec(f_mode: ModeDefault) when not node.f_type_expr is AnonymousType(f_type_decl: *(f_type_def: AccessDef)) diff --git a/lkql_checker/share/lkql/implicit_small_for_fixed_point_types.lkql b/lkql_checker/share/lkql/implicit_small_for_fixed_point_types.lkql index 0f638504e..a19985547 100644 --- a/lkql_checker/share/lkql/implicit_small_for_fixed_point_types.lkql +++ b/lkql_checker/share/lkql/implicit_small_for_fixed_point_types.lkql @@ -1,10 +1,24 @@ -# Flag each fixed point type declaration that lacks an explicit representation -# clause to define its 'Small value. Since 'Small can be defined only for -# ordinary fixed point types, decimal fixed point type declarations are not -# checked. - @check(message="fixed point type declaration with no 'Small clause", + rule_name="Implicit_SMALL_For_Fixed_Point_Types", category="Style", subcategory="Portability") fun implicit_small_for_fixed_point_types(node) = - node is TypeDecl(any children: OrdinaryFixedPointDef, - p_has_aspect("Small"): false) + |" Flag each fixed point type declaration that lacks an explicit + |" representation clause to define its ``'Small`` value. + |" Since ``'Small`` can be defined only for ordinary fixed point types, + |" decimal fixed point type declarations are not checked. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" package Foo is + |" type Fraction is delta 0.01 range -1.0 .. 1.0; + |" type Fraction1 is delta 0.01 range -1.0 .. 1.0; -- FLAG + |" + |" type Money is delta 0.01 digits 15; + |" + |" for Fraction'Small use 0.01; + |" end Foo; + node is TypeDecl(any children: OrdinaryFixedPointDef, + p_has_aspect("Small"): false) diff --git a/lkql_checker/share/lkql/improper_returns.lkql b/lkql_checker/share/lkql/improper_returns.lkql index e62e6acdd..820c8a628 100644 --- a/lkql_checker/share/lkql/improper_returns.lkql +++ b/lkql_checker/share/lkql/improper_returns.lkql @@ -1,16 +1,42 @@ -# Flag each explicit return statement in procedures, and multiple return -# statements in functions. Diagnostic messages are generated for all return -# statements in a procedure (thus each procedure must be written so that it -# returns implicitly at the end of its statement part), and for all return -# statements in a function after the first one. This rule supports the -# stylistic convention that each subprogram should have no more than one point -# of normal return. - import stdlib @check(message="extra return statement", category="Style", subcategory="Programming Practice") fun improper_returns(node) = + |" Flag each explicit ``return`` statement in procedures, and + |" multiple ``return`` statements in functions. + |" Diagnostic messages are generated for all ``return`` statements + |" in a procedure (thus each procedure must be written so that it + |" returns implicitly at the end of its statement part), + |" and for all ``return`` statements in a function after the first one. + |" This rule supports the stylistic convention that each subprogram + |" should have no more than one point of normal return. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4, 15, 19 + |" + |" procedure Proc (I : in out Integer) is + |" begin + |" if I = 0 then + |" return; -- FLAG + |" end if; + |" + |" I := I * (I + 1); + |" end Proc; + |" + |" function Factorial (I : Natural) return Positive is + |" begin + |" if I = 0 then + |" return 1; + |" else + |" return I * Factorial (I - 1); -- FLAG + |" end if; + |" exception + |" when Constraint_Error => + |" return Natural'Last; -- FLAG + |" end Factorial; node is ReturnStmt and stdlib.enclosing_body(node) is body@BaseSubpBody when match body.f_subp_spec.f_subp_kind diff --git a/lkql_checker/share/lkql/improperly_located_instantiations.lkql b/lkql_checker/share/lkql/improperly_located_instantiations.lkql index 4b45ee331..046561f56 100644 --- a/lkql_checker/share/lkql/improperly_located_instantiations.lkql +++ b/lkql_checker/share/lkql/improperly_located_instantiations.lkql @@ -1,22 +1,33 @@ -# Flag all generic instantiations in library-level package specs (including -# library generic packages) and in all subprogram bodies. -# Instantiations in task and entry bodies are not flagged. Instantiations in -# the bodies of protected subprograms are flagged. - import stdlib @unit_check(help="instantiations not properly located", category="Feature") -fun improperly_located_instantiations(unit) = [ - {message: "instantiation in a " & - (if node is GenericInstantiation(any parent: BaseSubpBody) - then "subprogram body" - else (if unit.root.f_body.f_item is GenericPackageDecl - then "generic " else "") & "library package spec"), - loc: node.p_defining_name()} - for node in if unit.root is CompilationUnit - then (match unit.root.f_body - | LibraryItem(f_item: GenericPackageDecl | BasePackageDecl) - => from unit.root select GenericInstantiation - | * => from (from unit.root select BaseSubpBody) - select GenericInstantiation) - else []] +fun improperly_located_instantiations(unit) = + |" Flag all generic instantiations in library-level package specs + |" (including library generic packages) and in all subprogram bodies. + |" + |" Instantiations in task and entry bodies are not flagged. Instantiations in the + |" bodies of protected subprograms are flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" with Ada.Text_IO; use Ada.Text_IO; + |" procedure Proc is + |" package My_Int_IO is new Integer_IO (Integer); -- FLAG + [ + {message: "instantiation in a " & + (if node is GenericInstantiation(any parent: BaseSubpBody) + then "subprogram body" + else (if unit.root.f_body.f_item is GenericPackageDecl + then "generic " else "") & "library package spec"), + loc: node.p_defining_name()} + for node in if unit.root is CompilationUnit + then (match unit.root.f_body + | LibraryItem(f_item: GenericPackageDecl | BasePackageDecl) + => from unit.root select GenericInstantiation + | * => from (from unit.root select BaseSubpBody) + select GenericInstantiation) + else [] + ] diff --git a/lkql_checker/share/lkql/incomplete_representation_specifications.lkql b/lkql_checker/share/lkql/incomplete_representation_specifications.lkql index 1b0e0bfa2..6e768599e 100644 --- a/lkql_checker/share/lkql/incomplete_representation_specifications.lkql +++ b/lkql_checker/share/lkql/incomplete_representation_specifications.lkql @@ -1,9 +1,25 @@ -# Flag all record types that have a layout representation specification but -# without Size and Pack representation specifications. - @check(message="record type with incomplete representation specification", category="Style", subcategory="Portability") fun incomplete_representation_specifications(node) = + |" Flag all record types that have a layout representation specification + |" but without Size and Pack representation specifications. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" package Pack is + |" type Rec is record -- FLAG + |" I : Integer; + |" B : Boolean; + |" end record; + |" + |" for Rec use record + |" I at 0 range 0 ..31; + |" B at 4 range 0 .. 7; + |" end record; + |" end Pack; node is TypeDecl when node.p_get_record_representation_clause() and (if node.p_has_aspect("Size") then not node.p_get_aspect("Pack").exists) diff --git a/lkql_checker/share/lkql/integer_types_as_enum.lkql b/lkql_checker/share/lkql/integer_types_as_enum.lkql index e0c99daee..8eaf51d82 100644 --- a/lkql_checker/share/lkql/integer_types_as_enum.lkql +++ b/lkql_checker/share/lkql/integer_types_as_enum.lkql @@ -1,11 +1,3 @@ -# Flag each integer type which may benefit from being replaced by an -# enumeration type. All the following criterias are considered: -# - no use of any arithmetic or bitwise operator -# - no reference in generic instantiations -# - no type conversion from or to the given type -# - no type derivation -# - no subtype definition - @memoized fun arithmetic_ops() = |" Return a list of all types referenced in any arithmetic operator @@ -41,7 +33,36 @@ fun types() = message="integer type may be replaced by an enumeration", category="Style", subcategory="Programming Practice") fun integer_types_as_enum(node) = - node is TypeDecl(p_is_int_type(): true) - when not [t for t in types() if t == node] - and not [t for t in instantiations() if t == node] - and not [t for t in arithmetic_ops() if t == node] + |" Flag each integer type declaration (including types derived from + |" integer types) if this integer type may benefit from + |" being replaced by an enumeration type. An integer type is considered + |" as being potentially replaceable by an enumeration type if all the + |" following conditions are true: + |" + |" * there is no infix calls to any arithmetic or bitwise operator for objects + |" of this type; + |" * this type is not referenced in an actual parameter of a generics + |" instantiation; + |" * there is no type conversion from or to this type; + |" * no type is derived from this type; + |" * no subtype is declared for this type. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" procedure Proc is + |" type Enum is range 1 .. 3; -- FLAG + |" type Int is range 1 .. 3; -- NO FLAG + |" + |" X : Enum := 1; + |" Y : Int := 1; + |" begin + |" X := 2; + |" Y := Y + 1; + |" end Proc; + node is TypeDecl(p_is_int_type(): true) + when not [t for t in types() if t == node] + and not [t for t in instantiations() if t == node] + and not [t for t in arithmetic_ops() if t == node] diff --git a/lkql_checker/share/lkql/library_level_subprograms.lkql b/lkql_checker/share/lkql/library_level_subprograms.lkql index f41d75807..f85aef308 100644 --- a/lkql_checker/share/lkql/library_level_subprograms.lkql +++ b/lkql_checker/share/lkql/library_level_subprograms.lkql @@ -1,7 +1,12 @@ -# Flag all library-level subprograms (including generic subprogram -# instantiations). - @check(message="declaration of library level subprogram", category="Feature") fun library_level_subprograms(node) = + |" Flag all library-level subprograms (including generic + |" subprogram instantiations). + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" with Ada.Text_IO; use Ada.Text_IO; + |" procedure Proc is -- FLAG node is (BaseSubpBody | GenericSubpInstantiation) when node.parent is LibraryItem diff --git a/lkql_checker/share/lkql/local_instantiations.lkql b/lkql_checker/share/lkql/local_instantiations.lkql index f78f1c874..9c63a7835 100644 --- a/lkql_checker/share/lkql/local_instantiations.lkql +++ b/lkql_checker/share/lkql/local_instantiations.lkql @@ -1,12 +1,46 @@ -# Flag each occurrence of a non library level instantiation. -# If parameter packages is specified, only instantiations of the given -# packages are flagged. - import stdlib @check(message="local instantiation", category="Style", subcategory="Programming Practice") fun local_instantiations(node, packages=[]) = + |" Non library-level generic instantiations are flagged. + |" + |" The rule has an optional parameter(s) for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Packages: list[string]* + |" A list of fully expanded Ada names of generic units to flag local instantiations + |" of. + |" + |" If the rule is activated without parameters, all local instantiations + |" are flagged, otherwise only instantiations of the generic units which names + |" are listed as rule parameters are flagged. Note that a rule parameter should + |" be a generic unit name but not the name defined by generic renaming declaration. + |" Note also, that if a rule parameter does not denote an existing generic unit + |" or if it denotes a name defined by generic renaming declaration, the parameter + |" itself is (silently) ignored and does not have any effect, but the presence of at + |" least one of such a parameter already means that the rule will not flag any + |" instantiation if the full expanded Ada name of the instantiated generic unit is + |" listed as a rule parameter. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 11 + |" + |" generic + |" package Pack_G is + |" I : Integer; + |" end Pack_G; + |" + |" with Pack_G; + |" package Pack_I is new Pack_G; -- NO FLAG + |" + |" with Pack_G; + |" procedure Proc is + |" package Inst is new Pack_G; -- FLAG + |" begin + |" ... node is (GenericPackageInstantiation(f_generic_pkg_name: name@Name) | GenericSubpInstantiation(f_generic_subp_name: name@Name)) when stdlib.has_local_scope(node) diff --git a/lkql_checker/share/lkql/local_packages.lkql b/lkql_checker/share/lkql/local_packages.lkql index 66f864a7d..c50ca5c04 100644 --- a/lkql_checker/share/lkql/local_packages.lkql +++ b/lkql_checker/share/lkql/local_packages.lkql @@ -1,8 +1,19 @@ -# Flag all local packages declared in package and generic package specs. Local -# packages in bodies are not flagged. - @check(message="declaration of local package", category="Style", subcategory="Program Structure") fun local_packages(node) = + |" Flag all local packages declared in package and generic package + |" specs. + |" Local packages in bodies are not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" package Foo is + |" package Inner is -- FLAG + |" I : Integer; + |" end Inner; + |" end Foo; node is PackageDecl(any parent: PackageDecl | GenericPackageDecl) and not node is *(any parent: PackageBody) diff --git a/lkql_checker/share/lkql/local_use_clauses.lkql b/lkql_checker/share/lkql/local_use_clauses.lkql index 94407fd36..1bcebf10c 100644 --- a/lkql_checker/share/lkql/local_use_clauses.lkql +++ b/lkql_checker/share/lkql/local_use_clauses.lkql @@ -1,10 +1,28 @@ -# Use clauses that are not parts of compilation unit context clause are -# flagged. The rule has a parameter Except_USE_TYPE_Clauses: do not flag local -# use type clauses. - -@check(message="local use clause", +@check(message="local use clause", rule_name="Local_USE_Clauses", category="Style", subcategory="Programming Practice") fun local_use_clauses(node, except_use_type_clauses = false) = + |" Use clauses that are not parts of compilation unit context clause are + |" flagged. + |" + |" The rule has an optional parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Except_USE_TYPE_Clauses: bool* + |" If ``true``, do not flag local use type clauses. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4, 7 + |" + |" with Pack1; + |" with Pack2; + |" procedure Proc is + |" use Pack1; -- FLAG + |" + |" procedure Inner is + |" use type Pack2.T; -- FLAG (if Except_USE_TYPE_Clauses is not set) + |" ... node is UseClause when node.parent.parent is not CompilationUnit and not (except_use_type_clauses and node is UseTypeClause) diff --git a/lkql_checker/share/lkql/max_identifier_length.lkql b/lkql_checker/share/lkql/max_identifier_length.lkql index f30fe1fb9..26bf7fbdd 100644 --- a/lkql_checker/share/lkql/max_identifier_length.lkql +++ b/lkql_checker/share/lkql/max_identifier_length.lkql @@ -1,12 +1,24 @@ -# Flag any defining identifier that has length longer than specified by the -# rule parameter. Defining identifiers of enumeration literals are not flagged. -# The rule has a parameter N: the maximal allowed identifier length -# specification. - @check(message="identifier too long", help="maximal identifier length", remediation="EASY", category="Style", subcategory="Readability") fun max_identifier_length(node, n: int = 20) = + |" Flag any defining identifier that has length longer than specified by + |" the rule parameter. Defining identifiers of enumeration literals are not + |" flagged. + |" + |" The rule has a mandatory parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *N: int* + |" The maximal allowed identifier length specification. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" type My_Type is range -100 .. 100; + |" My_Variable_With_A_Long_Name : My_Type; -- FLAG (if rule parameter is 27 or smaller) node is DefiningName(parent: not EnumLiteralDecl) when (if node.f_name is DottedName then node.f_name.f_suffix diff --git a/lkql_checker/share/lkql/maximum_expression_complexity.lkql b/lkql_checker/share/lkql/maximum_expression_complexity.lkql index 1b2b462f0..c1d668c6f 100644 --- a/lkql_checker/share/lkql/maximum_expression_complexity.lkql +++ b/lkql_checker/share/lkql/maximum_expression_complexity.lkql @@ -1,12 +1,3 @@ -# Flag any expression not directly part of another expression which contains -# more than N expressions of the following kind (each count for 1): -# - Identifiers -# - Literals -# - Conditional expressions -# - Quantified expressions -# - Aggregates -# - @ symbols - fun num_expr(node) = |" Return the number of relevant expressions as defined above of a given |" node. @@ -15,14 +6,42 @@ fun num_expr(node) = @unit_check(help="maximum complexity of an expression", category="Style", subcategory="Program Structure") -fun maximum_expression_complexity(unit, n: int = 10) = [ - {message: "expression has too many sub-expressions (" & - img(num_expr(node)) & ")", loc: node} - for node in from unit.root select - # Note: using "all parent is not Expr" would be more accurate but would - # slow down this rule significantly and checking one level is good enough - # in practice. - # Exclude standalone identifiers which are not expressions per se. - expr@Expr(parent: not Expr) - when expr is not (Identifier | DefiningName | EndName) - and num_expr(expr) > n] +fun maximum_expression_complexity(unit, n: int = 10) = + |" Flag any expression that is not directly a part of another expression + |" which contains more than *N* expressions of the following kinds (each count for 1) + |" as its subcomponents, *N* is a rule parameter: + |" + |" * Identifiers; + |" * Numeric, string or character literals; + |" * Conditional expressions; + |" * Quantified expressions; + |" * Aggregates; + |" * @ symbols (target names). + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Positive integer specifying the maximum allowed number of expression + |" subcomponents. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1-3 + |" + |" I := 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10; -- FLAG if N < 10 + |" I := F (I); -- FLAG if N < 2 + |" I := F5 (1 + 2 + 3 + 4 + 5, 2, 3, 4, 5); -- FLAG (twice) if N < 5 + [ + {message: "expression has too many sub-expressions (" & + img(num_expr(node)) & ")", loc: node} + for node in from unit.root select + # Note: using "all parent is not Expr" would be more accurate but would + # slow down this rule significantly and checking one level is good enough + # in practice. + # Exclude standalone identifiers which are not expressions per se. + expr@Expr(parent: not Expr) + when expr is not (Identifier | DefiningName | EndName) + and num_expr(expr) > n + ] diff --git a/lkql_checker/share/lkql/maximum_lines.lkql b/lkql_checker/share/lkql/maximum_lines.lkql index de64bff67..ccb324492 100644 --- a/lkql_checker/share/lkql/maximum_lines.lkql +++ b/lkql_checker/share/lkql/maximum_lines.lkql @@ -1,12 +1,20 @@ -# Flag each file exceeding N textual lines - @unit_check(help="maximum number of lines in a file", category="Style", subcategory="Program Structure") -fun maximum_lines(unit, n: int = 10000) = { - val tokens = unit.tokens.to_list; - val tok = tokens[tokens.length]; +fun maximum_lines(unit, n: int = 10000) = + |" Flags the file containing the source text of a compilation unit if this + |" file contains more than N lines where N is a rule parameter + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Positive integer specifying the maximum allowed number of lines in + |" the compilation unit source text. + { + val tokens = unit.tokens.to_list; + val tok = tokens[tokens.length]; - if tok.end_line > n - then [{message: "too many lines: " & img(tok.end_line), loc: tok}] - else [] -} + if tok.end_line > n + then [{message: "too many lines: " & img(tok.end_line), loc: tok}] + else [] + } diff --git a/lkql_checker/share/lkql/maximum_out_parameters.lkql b/lkql_checker/share/lkql/maximum_out_parameters.lkql index a38af64da..75e7c81b4 100644 --- a/lkql_checker/share/lkql/maximum_out_parameters.lkql +++ b/lkql_checker/share/lkql/maximum_out_parameters.lkql @@ -1,13 +1,3 @@ -# Flag any subprogram declaration, subprogram body declaration, expression -# function declaration, null procedure declaration, subprogram body stub or -# generic subprogram declaration if the corresponding subprogram has more than -# N formal [IN] OUT parameters, where N is a parameter of the rule. -# A subprogram body, an expression function, a null procedure or a subprogram -# body stub is flagged only if there is no separate declaration for this -# subprogram. Subprogram renaming declarations and subprogram instantiations, -# as well as declarations inside expanded generic instantiations are never -# flagged. - fun num_out_params(node) = |" Return the number of out parameters of a subprogram node (from node.f_subp_spec?.f_subp_params?.f_params @@ -15,12 +5,43 @@ fun num_out_params(node) = when n.parent.parent.f_mode is (ModeOut | ModeInOut)).length @unit_check(help="maximum number of subprogram OUT parameters", - category="Style", subcategory="Programming Practice") -fun maximum_out_parameters(unit, n: int = 3) = [ - {message: "too many formal OUT parameters (" & img(num_out_params(n)) & ")", - loc: n.p_defining_name()} - for n in from unit.root select - node@(SubpBody | ExprFunction | NullSubpDecl | SubpBodyStub | - ClassicSubpDecl) - when (node is ClassicSubpDecl or not node.p_previous_part()) - and num_out_params(node) > n] + category="Style", subcategory="Programming Practice", + rule_name="Maximum_OUT_Parameters") +fun maximum_out_parameters(unit, n: int = 3) = + |" Flag any subprogram declaration, subprogram body declaration, expression + |" function declaration, null procedure declaration, subprogram + |" body stub or generic subprogram declaration if the corresponding + |" subprogram has more than *N* formal parameters of mode ``out`` or + |" ``in out``, where *N* is a parameter of the rule. + |" + |" A subprogram body, an expression function, a null procedure or + |" a subprogram body stub is flagged only if there is + |" no separate declaration for this subprogram. Subprogram renaming + |" declarations and subprogram instantiations, as well as declarations + |" inside expanded generic instantiations are never flagged. + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Positive integer specifying the maximum allowed total number of + |" subprogram formal parameters of modes ``out`` and ``in out``. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4 + |" + |" procedure Proc_1 (I : in out Integer); -- NO FLAG + |" procedure Proc_2 (I, J : in out Integer); -- NO FLAG + |" procedure Proc_3 (I, J, K : in out Integer); -- NO FLAG + |" procedure Proc_4 (I, J, K, L : in out Integer); -- FLAG (if rule parameter is 3) + [ + {message: "too many formal OUT parameters (" & img(num_out_params(n)) & ")", + loc: n.p_defining_name()} + for n in from unit.root select + node@(SubpBody | ExprFunction | NullSubpDecl | SubpBodyStub | + ClassicSubpDecl) + when (node is ClassicSubpDecl or not node.p_previous_part()) + and num_out_params(node) > n + ] diff --git a/lkql_checker/share/lkql/maximum_parameters.lkql b/lkql_checker/share/lkql/maximum_parameters.lkql index 8dbde3c59..98b4c231f 100644 --- a/lkql_checker/share/lkql/maximum_parameters.lkql +++ b/lkql_checker/share/lkql/maximum_parameters.lkql @@ -1,25 +1,55 @@ -# Flag any subprogram declaration, subprogram body declaration, expression -# function declaration, null procedure declaration, subprogram body stub or -# generic subprogram declaration if the corresponding subprogram has more than -# N formal parameters, where N is a parameter of the rule. -# A subprogram body, an expression function, a null procedure or a subprogram -# body stub is flagged only if there is no separate declaration for this -# subprogram. Subprogram renaming declarations and subprogram instantiations, -# as well as declarations inside expanded generic instantiations are never -# flagged. - fun num_params(node) = |" Return the number of parameters of a subprogram node (from node.f_subp_spec?.f_subp_params?.f_params select DefiningName).length @unit_check(help="maximum number of subprogram parameters", category="Style", subcategory="Programming Practice") -fun maximum_parameters(unit, n: int = 3) = [ - {message: "too many formal parameters (" & img(num_params(n)) & ")", - loc: n.p_defining_name()} - for n in from unit.root select - node@(SubpBody | ExprFunction | NullSubpDecl | SubpBodyStub | - ClassicSubpDecl | GenericSubpInternal) - when (node is (ClassicSubpDecl | GenericSubpInternal) or - node.p_previous_part() == null) - and num_params(node) > n] +fun maximum_parameters(unit, n: int = 3) = + |" Flag any subprogram declaration, subprogram body declaration, expression + |" function declaration, null procedure declaration, subprogram + |" body stub or generic subprogram declaration if the corresponding + |" subprogram has more than *N* formal parameters, where *N* is a + |" parameter of the rule. + |" + |" A subprogram body, an expression function, a null procedure or + |" a subprogram body stub is flagged only if there is + |" no separate declaration for this subprogram. Subprogram renaming + |" declarations and subprogram instantiations, as well as declarations + |" inside expanded generic instantiations are never flagged. + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Positive integer specifying the maximum allowed total number of + |" subprogram formal parameters. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 6, 8 + |" + |" package Foo is + |" + |" procedure Proc_1 (I : in out Integer); + |" procedure Proc_2 (I, J : in out Integer); + |" procedure Proc_3 (I, J, K : in out Integer); + |" procedure Proc_4 (I, J, K, L : in out Integer); -- FLAG (if rule parameter is 3) + |" + |" function Fun_4 -- FLAG (if rule parameter is 3) + |" (I : Integer; + |" J : Integer; + |" K : Integer; + |" L : Integer) return Integer is (I + J * K - L); + |" + |" end Foo; + [ + {message: "too many formal parameters (" & img(num_params(n)) & ")", + loc: n.p_defining_name()} + for n in from unit.root select + node@(SubpBody | ExprFunction | NullSubpDecl | SubpBodyStub | + ClassicSubpDecl | GenericSubpInternal) + when (node is (ClassicSubpDecl | GenericSubpInternal) or + node.p_previous_part() == null) + and num_params(node) > n + ] diff --git a/lkql_checker/share/lkql/maximum_subprogram_lines.lkql b/lkql_checker/share/lkql/maximum_subprogram_lines.lkql index 63cea5875..b69e1aa1f 100644 --- a/lkql_checker/share/lkql/maximum_subprogram_lines.lkql +++ b/lkql_checker/share/lkql/maximum_subprogram_lines.lkql @@ -1,15 +1,36 @@ -# Flag handled sequences of statements of subprogram bodies exceeding N textual -# lines. Lines are counted from the beginning of the first to -# the end of the last statement, including blank and comment lines. - fun count_lines(node) = node.token_end().end_line - node.token_start().start_line + 1 @unit_check(help="maximum number of lines in a subprogram", category="Style", subcategory="Program Structure") -fun maximum_subprogram_lines(unit, n: int = 1000) = [ - {message: "too many lines in subprogram body: " & img(count_lines(n)), - loc: n.token_start().previous(exclude_trivia=true)} - for n in from unit.root - select node@HandledStmts(parent: SubpBody) when count_lines(node) > n -] +fun maximum_subprogram_lines(unit, n: int = 1000) = + |" Flag handled sequences of statements of subprogram bodies exceeding *N* textual + |" lines (*N* is the rule parameter). Lines are counted from the beginning of the + |" first to the end of the last statement, including blank and comment lines + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Positive integer specifying the maximum allowed number of lines in the + |" subprogram statement sequence. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4 + |" + |" -- If the rule parameter is 3 + |" procedure P (I : in out Integer) is + |" begin + |" I := I + 1; -- FLAG + |" I := I + 2; + |" I := I + 3; + |" I := I + 4; + |" end P; + [ + {message: "too many lines in subprogram body: " & img(count_lines(n)), + loc: n.token_start().previous(exclude_trivia=true)} + for n in from unit.root + select node@HandledStmts(parent: SubpBody) when count_lines(node) > n + ] diff --git a/lkql_checker/share/lkql/membership_for_validity.lkql b/lkql_checker/share/lkql/membership_for_validity.lkql index 00d74446e..8554502e6 100644 --- a/lkql_checker/share/lkql/membership_for_validity.lkql +++ b/lkql_checker/share/lkql/membership_for_validity.lkql @@ -1,7 +1,3 @@ -# Flag each occurrence of a membership test of the form: -# X in Subtype_Of_X -# X in Subtype_Of_X'First .. Subtype_Of_X'Last - fun type_of(name) = match name.p_referenced_decl() | BasicDecl(p_type_expression(): t@TypeExpr) => t.p_designated_type_decl() @@ -10,6 +6,25 @@ fun type_of(name) = @check(message="membership test instead of 'Valid", category="Style", subcategory="Portability") fun membership_for_validity(node) = + |" Flag membership tests that can be replaced by a ``'Valid`` attribute. + |" Two forms of membership tests are flagged: + |" + |" * X in Subtype_Of_X + |" * X in Subtype_Of_X'First .. Subtype_Of_X'Last + |" + |" where X is a data object except for a loop parameter, and ``Subtype_Of_X`` + |" is the subtype of the object as given by the corresponding declaration. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5 + |" + |" subtype My_Int is Integer range 1 .. 10; + |" X : My_Int; + |" Y : Integer; + |" begin + |" if X in My_Int then -- FLAG node is MembershipExpr(f_expr: var@Name) when not node.f_membership_exprs[2] and node.f_membership_exprs[1] is diff --git a/lkql_checker/share/lkql/membership_tests.lkql b/lkql_checker/share/lkql/membership_tests.lkql index 9babb9dd7..8ce4f1fa4 100644 --- a/lkql_checker/share/lkql/membership_tests.lkql +++ b/lkql_checker/share/lkql/membership_tests.lkql @@ -1,18 +1,76 @@ -# Flag use of membership test expression. -# This rule has the following parameters: -# - Multi_Alternative_Only: Flag only those membership test expressions that -# have more than one membership choice in the membership choice list. -# - Float_Types_Only: Flag only those membership test expressions that checks -# objects of floating point type and private types whose completions are -# floating-point types. -# - Except_Assertions: Do not flag a membership test expression if it is a -# subcomponent of the following constructs[...] -# These three parameters are independent on each other. - import stdlib @check(message="membership test", category="Feature") fun membership_tests(node, multi_alternative_only=false, float_types_only=false, except_assertions=false) = + |" Flag use of membership test expression. + |" + |" This rule has the following (optional) parameters for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *Multi_Alternative_Only: bool* + |" If ``true``, flag only those membership test expressions that have more than + |" one membership choice in the membership choice list. + |" + |" *Float_Types_Only: bool* + |" If ``true``, flag only those membership test expressions that checks objects + |" of floating point type and private types whose completions are floating-point + |" types. + |" + |" *Except_Assertions: bool* + |" If ``true``, do not flag a membership test expression if it is a subcomponent + |" of the following constructs: + |" + |" *argument of the following pragmas* + |" + |" *Language-defined* + |" + |" * ``Assert`` + |" + |" *GNAT-specific* + |" + |" * ``Assert_And_Cut`` + |" * ``Assume`` + |" * ``Contract_Cases`` + |" * ``Debug`` + |" * ``Invariant`` + |" * ``Loop_Invariant`` + |" * ``Loop_Variant`` + |" * ``Postcondition`` + |" * ``Precondition`` + |" * ``Predicate`` + |" * ``Refined_Post`` + |" + |" *definition of the following aspects* + |" + |" *Language-defined* + |" + |" * ``Static_Predicate`` + |" * ``Dynamic_Predicate`` + |" * ``Pre`` + |" * ``Pre'Class`` + |" * ``Post`` + |" * ``Post'Class`` + |" * ``Type_Invariant`` + |" * ``Type_Invariant'Class`` + |" + |" *GNAT-specific* + |" + |" * ``Contract_Cases`` + |" * ``Invariant`` + |" * ``Invariant'Class`` + |" * ``Predicate`` + |" * ``Refined_Post`` + |" + |" These three parameters are independent on each other. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" procedure Proc (S : in out Speed) is + |" begin + |" if S in Low .. High then -- FLAG node is MembershipExpr and (if multi_alternative_only then node.f_membership_exprs[2]) and (not float_types_only diff --git a/lkql_checker/share/lkql/metrics_cyclomatic_complexity.lkql b/lkql_checker/share/lkql/metrics_cyclomatic_complexity.lkql index de402bab2..e8d476bac 100644 --- a/lkql_checker/share/lkql/metrics_cyclomatic_complexity.lkql +++ b/lkql_checker/share/lkql/metrics_cyclomatic_complexity.lkql @@ -1,17 +1,53 @@ -# Flag each program unit that is an executable body exceeding the limit N. -# This rule has the following optional parameter: -# Exempt_Case_Statements: Count the complexity introduced by CASE statement or -# CASE expression as 1. - import metrics @unit_check(help="cyclomatic complexity", execution_cost=3, category="Metrics") fun metrics_cyclomatic_complexity(unit, n : int = 5, - exempt_case_statements=false) = [ - { message: "cyclomatic complexity is too high: " & img(t[2]), loc: t[1] } - for t in [(body, metrics.cyclomatic_complexity(body, exempt_case_statements)) - for body in (from unit.root select - (BaseSubpBody | PackageBody | TaskBody | EntryBody))] - if t[2] > n -] - + exempt_case_statements=false) = + |" The ``Metrics_Cyclomatic_Complexity`` rule takes a positive integer as + |" upper bound. A program unit that is an executable body exceeding this limit will be flagged. + |" + |" This rule has the following optional parameter for the ``+R`` option and for + |" LKQL rule options files: + |" + |" *Exempt_Case_Statements: bool* + |" Whether to count the complexity introduced by ``case`` statement or ``case`` + |" expression as 1. + |" + |" The McCabe cyclomatic complexity metric is defined + |" in `http://www.mccabe.com/pdf/mccabe-nist235r.pdf `_ + |" The goal of cyclomatic complexity metric is to estimate the number + |" of independent paths in the control flow graph that in turn gives the number + |" of tests needed to satisfy paths coverage testing completeness criterion. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" -- if the rule parameter is 6 or less + |" procedure Proc (I : in out Integer; S : String) is -- FLAG + |" begin + |" if I in 1 .. 10 then + |" for J in S'Range loop + |" + |" if S (J) = ' ' then + |" if I < 10 then + |" I := 10; + |" end if; + |" end if; + |" + |" I := I + Character'Pos (S (J)); + |" end loop; + |" elsif S = "abs" then + |" if I > 0 then + |" I := I + 1; + |" end if; + |" end if; + |" end Proc; + [ + { message: "cyclomatic complexity is too high: " & img(t[2]), loc: t[1] } + for t in [(body, metrics.cyclomatic_complexity(body, exempt_case_statements)) + for body in (from unit.root select + (BaseSubpBody | PackageBody | TaskBody | EntryBody))] + if t[2] > n + ] diff --git a/lkql_checker/share/lkql/metrics_essential_complexity.lkql b/lkql_checker/share/lkql/metrics_essential_complexity.lkql index 39fc8e9a6..82df4036e 100644 --- a/lkql_checker/share/lkql/metrics_essential_complexity.lkql +++ b/lkql_checker/share/lkql/metrics_essential_complexity.lkql @@ -1,16 +1,39 @@ -# The Metrics_Essential_Complexity rule takes a positive integer as upper -# bound. A program unit that is an executable body exceeding this limit will be -# flagged. -# The Ada essential complexity metric is a McCabe cyclomatic complexity metric -# counted for the code that is reduced by excluding all the pure structural Ada -# control statements. - import metrics -@unit_check(help="essential complexity", execution_cost=3) -fun metrics_essential_complexity(unit, n : int = 3) = [ - { message: "essential complexity is too high: " & img(t[2]), loc: t[1] } - for t in [(body, metrics.essential_complexity(body)) - for body in (from unit.root select BaseSubpBody)] - if t[2] > n -] +@unit_check(help="essential complexity", execution_cost=3, category="Metrics") +fun metrics_essential_complexity(unit, n : int = 3) = + |" The ``Metrics_Essential_Complexity`` rule takes a positive integer as + |" upper bound. A program unit that is an executable body exceeding this limit will be flagged. + |" + |" The Ada essential complexity metric is a McCabe cyclomatic complexity metric counted + |" for the code that is reduced by excluding all the pure structural Ada control statements. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" -- if the rule parameter is 3 or less + |" procedure Proc (I : in out Integer; S : String) is -- FLAG + |" begin + |" if I in 1 .. 10 then + |" for J in S'Range loop + |" + |" if S (J) = ' ' then + |" if I > 10 then + |" exit; + |" else + |" I := 10; + |" end if; + |" end if; + |" + |" I := I + Character'Pos (S (J)); + |" end loop; + |" end if; + |" end Proc; + [ + { message: "essential complexity is too high: " & img(t[2]), loc: t[1] } + for t in [(body, metrics.essential_complexity(body)) + for body in (from unit.root select BaseSubpBody)] + if t[2] > n + ] diff --git a/lkql_checker/share/lkql/metrics_lsloc.lkql b/lkql_checker/share/lkql/metrics_lsloc.lkql index d4f7fbb31..ee1a7f50e 100644 --- a/lkql_checker/share/lkql/metrics_lsloc.lkql +++ b/lkql_checker/share/lkql/metrics_lsloc.lkql @@ -1,28 +1,51 @@ -# The Metrics_LSLOC rule takes a positive integer as upper bound. A program -# unit declaration or a program unit body exceeding this limit will be flagged. -# -# The metric counts the total number of declarations and the total number of -# statements. -# -# This rule has the following optional parameter: -# Subprograms: Check for subprogram bodies only. - import metrics -@unit_check(help="Logical source lines", execution_cost=3) -fun metrics_lsloc(unit, n : int = 5, subprograms=false) = { - val nodes = - if subprograms - then (from unit.root select BaseSubpBody) - else (from unit.root select - (GenericPackageDecl | PackageDecl | PackageBody | - BaseSubpBody | - TaskTypeDecl | SingleTaskDecl | TaskBody | - SingleProtectedDecl | ProtectedTypeDecl | ProtectedBody)); +@unit_check(help="Logical source lines", execution_cost=3, + rule_name="Metrics_LSLOC", category="Metrics") +fun metrics_lsloc(unit, n : int = 5, subprograms=false) = + |" The ``Metrics_LSLOC`` rule takes a positive integer as + |" upper bound. A program unit declaration or a program unit body exceeding + |" this limit will be flagged. + |" + |" The metric counts the total number of declarations and the total number of statements. + |" + |" This rule has the following optional parameter for the ``+R`` option and for + |" LKQL rule options files: + |" + |" *Subprograms: bool* + |" Whether to check the rule for subprogram bodies only. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" -- if the rule parameter is 20 or less + |" package Pack is -- FLAG + |" procedure Proc1 (I : in out Integer); + |" procedure Proc2 (I : in out Integer); + |" procedure Proc3 (I : in out Integer); + |" procedure Proc4 (I : in out Integer); + |" procedure Proc5 (I : in out Integer); + |" procedure Proc6 (I : in out Integer); + |" procedure Proc7 (I : in out Integer); + |" procedure Proc8 (I : in out Integer); + |" procedure Proc9 (I : in out Integer); + |" procedure Proc10 (I : in out Integer); + |" end Pack; + { + val nodes = + if subprograms + then (from unit.root select BaseSubpBody) + else (from unit.root select + (GenericPackageDecl | PackageDecl | PackageBody | + BaseSubpBody | + TaskTypeDecl | SingleTaskDecl | TaskBody | + SingleProtectedDecl | ProtectedTypeDecl | ProtectedBody)); - [ - { message: "LSLOC is too high: " & img(t[2]), loc: t[1] } - for t in [(body, metrics.logical_slocs(body)) for body in nodes] - if t[2] > n - ] -} + [ + { message: "LSLOC is too high: " & img(t[2]), loc: t[1] } + for t in [(body, metrics.logical_slocs(body)) for body in nodes] + if t[2] > n + ] + } diff --git a/lkql_checker/share/lkql/min_identifier_length.lkql b/lkql_checker/share/lkql/min_identifier_length.lkql index 9a48dba8d..c05f32f44 100644 --- a/lkql_checker/share/lkql/min_identifier_length.lkql +++ b/lkql_checker/share/lkql/min_identifier_length.lkql @@ -1,9 +1,23 @@ -# Flag each occurrence of a defining name whose length is shorter than N. -# Numeric types are excluded. - @check(message="identifier too short", category="Style", subcategory="Readability") fun min_identifier_length(node, n: int = 2) = + |" Flag any defining identifier that has length shorter than specified by + |" the rule parameter. Defining identifiers of objects and components of + |" numeric types are not flagged. + |" + |" The rule has a mandatory parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *N: int* + |" The minimal allowed identifier length specification. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" I : Integer; -- NO FLAG + |" J : String (1 .. 10); -- FLAG node is DefiningName when node.text.length < n and node.p_basic_decl()?.p_type_expression() is (null | diff --git a/lkql_checker/share/lkql/misnamed_controlling_parameters.lkql b/lkql_checker/share/lkql/misnamed_controlling_parameters.lkql index 3f985b805..e15cbd2fb 100644 --- a/lkql_checker/share/lkql/misnamed_controlling_parameters.lkql +++ b/lkql_checker/share/lkql/misnamed_controlling_parameters.lkql @@ -1,16 +1,28 @@ -# Flag a declaration of a dispatching operation, if the first parameter is not -# a controlling one and its name is not This (the check for parameter name is -# not case-sensitive). Declarations of dispatching functions with a controlling -# result and no controlling parameter are never flagged. -# A subprogram body declaration, subprogram renaming declaration, or subprogram -# body stub is flagged only if it is not a completion of a prior subprogram -# declaration. - import stdlib @check(message="first parameter should have name 'This' and proper type", remediation="EASY", category="Style", subcategory="Readability") fun misnamed_controlling_parameters(node) = + |" Flag a declaration of a dispatching operation, if the first parameter is + |" not a controlling one and its name is not ``This`` (the check for + |" parameter name is not case-sensitive). Declarations of dispatching functions + |" with a controlling result and no controlling parameter are never flagged. + |" + |" A subprogram body declaration, subprogram renaming declaration, or subprogram + |" body stub is flagged only if it is not a completion of a prior subprogram + |" declaration. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5, 6 + |" + |" package Foo is + |" type T is tagged private; + |" + |" procedure P1 (This : in out T); + |" procedure P2 (That : in out T); -- FLAG + |" procedure P1 (I : Integer; This : in out T); -- FLAG node is (BasicSubpDecl | BaseSubpBody(p_previous_part(): null) | SubpBodyStub(p_previous_part(): null)) diff --git a/lkql_checker/share/lkql/misplaced_representation_items.lkql b/lkql_checker/share/lkql/misplaced_representation_items.lkql index b29d425f0..3a264eab3 100644 --- a/lkql_checker/share/lkql/misplaced_representation_items.lkql +++ b/lkql_checker/share/lkql/misplaced_representation_items.lkql @@ -1,22 +1,3 @@ -# Flag a representation item if there is any Ada construct except another -# representation item for the same entity between this clause and the -# declaration of the entity it applies to. A representation item in the context -# of this rule is either a representation clause: -# - Attribute Definition Clause 13.3 -# - Enumeration Representation Clause 13.4 -# - Record Representation Clause 13.5.1 -# - At Clause J.7 -# -# or one of the following representation pragmas: -# - Atomic J.15.8(9/3) -# - Atomic_Components J.15.8(9/3) -# - Independent J.15.8(9/3) -# - Independent_Components J.15.8(9/3) -# - Pack J.15.3(1/3) -# - Unchecked_Union J.15.6(1/3) -# - Volatile J.15.8(9/3) -# - Volatile_Components J.15.8(9/3) - fun is_rep_pragma(id) = id.p_name_is("Atomic") or id.p_name_is("Atomic_Components") or @@ -51,6 +32,31 @@ fun misplaced_node(n, decl) = @check(message="misplaced representation item", category="Style", subcategory="Programming Practice") fun misplaced_representation_items(node) = + |" Flag a representation item if there is any Ada construct except + |" another representation item for the same entity between this clause + |" and the declaration of the entity it applies to. A representation item + |" in the context of this rule is either a representation clause or one of + |" the following representation pragmas: + |" + |" * Atomic J.15.8(9/3) + |" * Atomic_Components J.15.8(9/3) + |" * Independent J.15.8(9/3) + |" * Independent_Components J.15.8(9/3) + |" * Pack J.15.3(1/3) + |" * Unchecked_Union J.15.6(1/3) + |" * Volatile J.15.8(9/3) + |" * Volatile_Components J.15.8(9/3) + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5 + |" + |" type Int1 is range 0 .. 1024; + |" type Int2 is range 0 .. 1024; + |" + |" for Int2'Size use 16; -- NO FLAG + |" for Int1'Size use 16; -- FLAG match node | AttributeDefClause(f_attribute_expr: AttributeRef) => misplaced_node(node, diff --git a/lkql_checker/share/lkql/multiple_entries_in_protected_definitions.lkql b/lkql_checker/share/lkql/multiple_entries_in_protected_definitions.lkql index 358b0d64a..934f9c73b 100644 --- a/lkql_checker/share/lkql/multiple_entries_in_protected_definitions.lkql +++ b/lkql_checker/share/lkql/multiple_entries_in_protected_definitions.lkql @@ -1,10 +1,23 @@ -# Flag each protected definition (i.e., each protected object/type declaration) -# that declares more than one entry. Diagnostic messages are generated for all -# the entry declarations except the first one. An entry family is counted as -# one entry. Entries from the private part of the protected definition are also -# checked. - @check(message="more than one entry in protected definition", category="Style", subcategory="Tasking") fun multiple_entries_in_protected_definitions(node) = + |" Flag each protected definition (i.e., each protected object/type declaration) + |" that declares more than one entry. + |" Diagnostic messages are generated for all the entry declarations + |" except the first one. An entry family is counted as one entry. Entries from + |" the private part of the protected definition are also checked. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" protected PO is + |" entry Get (I : Integer); + |" entry Put (I : out Integer); -- FLAG + |" procedure Reset; + |" function Check return Boolean; + |" private + |" Val : Integer := 0; + |" end PO; node is EntryDecl(any prev_siblings: EntryDecl) diff --git a/lkql_checker/share/lkql/name_clashes.lkql b/lkql_checker/share/lkql/name_clashes.lkql index 831933d48..094dce03f 100644 --- a/lkql_checker/share/lkql/name_clashes.lkql +++ b/lkql_checker/share/lkql/name_clashes.lkql @@ -1,10 +1,46 @@ -# Check that certain names are not used as defining identifiers. The names that -# should not be used as identifiers must be listed in the forbidden parameter. -# The check is not case-sensitive. Only the whole identifiers are checked, not -# substrings thereof. - @check(message="use of forbidden identifier", category="Style", subcategory="Readability") fun name_clashes(node, forbidden=[]) = + |" Check that certain names are not used as defining identifiers. The names that + |" should not be used as identifiers must be listed in a dictionary file that is + |" a rule parameter. A defining identifier is flagged if it is included in a + |" dictionary file specified as a rule parameter, the check is not case-sensitive. + |" Only the whole identifiers are checked, not substrings thereof. + |" More than one dictionary file can be specified as the rule parameter, in this + |" case the rule checks defining identifiers against the union of all the + |" identifiers from all the dictionary files provided as the rule parameters. + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *Dictionary_File: string* + |" The name of a dictionary file. The name may contain references to environment + |" variables (e.g. $REPOSITORY_ROOT/my_dict.txt), they are replaced by the + |" values of these variables. + |" + |" A dictionary file is a plain text file. The maximum line length for this file + |" is 1024 characters. If the line is longer than this limit, extra characters + |" are ignored. + |" + |" If the name of the dictionary file does not contain any path information and + |" the rule option is specifies in a rule file, first the tool tries to locate + |" the dictionary file in the same directory where the rule file is located, and + |" if the attempt fails - in the current directory. + |" + |" Each line can be either an empty line, a comment line, or a line containing + |" a list of identifiers separated by space or HT characters. + |" A comment is an Ada-style comment (from ``--`` to end-of-line). + |" Identifiers must follow the Ada syntax for identifiers. + |" A line containing one or more identifiers may end with a comment. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2, 3 + |" + |" -- If the dictionary file contains names 'One' and 'Two": + |" One : constant Integer := 1; -- FLAG + |" Two : constant Float := 2.0; -- FLAG + |" Constant_One : constant Float := 1.0; node is DefiningName when [p for p in forbidden if node.p_name_is(p)] diff --git a/lkql_checker/share/lkql/nested_paths.lkql b/lkql_checker/share/lkql/nested_paths.lkql index dd6f6366e..9c50ac16d 100644 --- a/lkql_checker/share/lkql/nested_paths.lkql +++ b/lkql_checker/share/lkql/nested_paths.lkql @@ -1,10 +1,3 @@ -# Flag each occurrence of list of statements that can be moved outside -# an enclosing if statement. This happens when the if statement has only then -# and else paths, and one of them only ends with a "breaking" statement -# (raise, return, exit or goto, possibly nested in a block with no exception -# handler); in this case, the other path needs not be nested inside the if -# statement and is flagged. - fun has_last_breaking_stmt(stmts) = match stmts[stmts.children_count] | (RaiseStmt | ReturnStmt | ExitStmt(f_cond_expr: null) | GotoStmt) => true @@ -15,6 +8,38 @@ fun has_last_breaking_stmt(stmts) = @check(message="nested path may be moved outside if statement", category="Style", subcategory="Programming Practice") fun nested_paths(node) = + |" Flag the beginning of a sequence of statements that is immediately enclosed + |" by an ``IF`` statement if this sequence of statement can be moved outside + |" the enclosing ``IF`` statement. The beginning of a sequence of statements is + |" flagged if: + |" + |" * + |" The enclosing ``IF`` statement contains ``IF`` and ``ELSE`` paths and + |" no ``ELSIF`` path; + |" + |" * + |" This sequence of statements does not end with a breaking statement but + |" the sequence of statement in another path does end with a breaking statement. + |" + |" A breaking statement is either a raise statement, or a return statement, + |" or an unconditional exit statement, or a goto statement or a block + |" statement without an exception handler with the enclosed sequence of + |" statements that ends with some breaking statement. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" loop + |" if I > K then + |" K := K + I; -- FLAG + |" I := I + 1; + |" else + |" L := 10; + |" exit; + |" end if; + |" end loop; # Match stmt lists that are either the then or the else list of an if stmt node is (StmtList(parent: if_stmt@IfStmt) | StmtList(parent: ElsePart(parent: if_stmt@IfStmt))) diff --git a/lkql_checker/share/lkql/nested_subprograms.lkql b/lkql_checker/share/lkql/nested_subprograms.lkql index 9020197a5..05be7fb50 100644 --- a/lkql_checker/share/lkql/nested_subprograms.lkql +++ b/lkql_checker/share/lkql/nested_subprograms.lkql @@ -1,17 +1,35 @@ -# Flag any subprogram declaration, subprogram body declaration, subprogram -# instantiation, expression function declaration or subprogram body stub that -# is not a completion of another subprogram declaration and that is declared -# within subprogram body (including bodies of generic subprograms), task body -# or entry body directly or indirectly (that is - inside a local nested -# package). Protected subprograms are not flagged. Null procedure declarations -# are not flagged. Procedure declarations completed by null procedure -# declarations are not flagged. - import stdlib @check(message="subprogram declared in executable body", category="Style", subcategory="Programming Practice") fun nested_subprograms(node) = + |" Flag any subprogram declaration, subprogram body declaration, subprogram + |" instantiation, expression function declaration or subprogram body stub + |" that is not a completion of another subprogram declaration and that is + |" declared within subprogram body (including bodies of generic + |" subprograms), task body or entry body directly or indirectly (that is - + |" inside a local nested package). Protected subprograms are not flagged. + |" Null procedure declarations are not flagged. Procedure declarations + |" completed by null procedure declarations are not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4, 6 + |" + |" procedure Bar (I, J : in out Integer) is + |" + |" procedure Foo (K : Integer) is null; + |" procedure Proc1; -- FLAG + |" + |" procedure Proc2 is separate; -- FLAG + |" + |" procedure Proc1 is + |" begin + |" I := I + J; + |" end Proc1; + |" + |" begin node is (SubpBody | ExprFunction | SubpBodyStub | BasicSubpDecl | GenericSubpInstantiation) when (node is (BasicSubpDecl | GenericSubpInstantiation) or diff --git a/lkql_checker/share/lkql/no_closing_names.lkql b/lkql_checker/share/lkql/no_closing_names.lkql index 069ad3ba7..5436eee43 100644 --- a/lkql_checker/share/lkql/no_closing_names.lkql +++ b/lkql_checker/share/lkql/no_closing_names.lkql @@ -1,9 +1,25 @@ -# Flag each program unit that is longer than N lines and does not repeat its -# name after the "end". - @check(message="no closing name", remediation="TRIVIAL", category="Style", subcategory="Programming Practice") fun no_closing_names(node, n : int = 0) = + |" Flag any program unit that is longer than N lines where N is a rule parameter + |" and does not repeat its name after the trailing ``END`` keyword. + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Positive integer specifying the maximal allowed number of lines in the + |" program unit that allows not to repeat the unit name at the end. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" procedure Proc (I : in out Integer) is -- FLAG is rule parameter is 3 or less + |" begin + |" I := I + 1; + |" end; node is (SubpBody | PackageBody | BasePackageDecl | TaskTypeDecl | TaskBody | ProtectedTypeDecl | SingleProtectedDecl | ProtectedBody) diff --git a/lkql_checker/share/lkql/no_explicit_real_range.lkql b/lkql_checker/share/lkql/no_explicit_real_range.lkql index e5f23cb7b..0eeaf4e30 100644 --- a/lkql_checker/share/lkql/no_explicit_real_range.lkql +++ b/lkql_checker/share/lkql/no_explicit_real_range.lkql @@ -1,7 +1,3 @@ -# Flag a declaration of a floating point type or a decimal fixed point type, -# including types derived from them if no explicit range specification is -# provided for the type. - fun is_real_without_range(decl) = decl is ((TypeDecl @@ -18,4 +14,15 @@ fun is_real_without_range(decl) = @check(message="real type with no range definition", category="Style", subcategory="Portability") fun no_explicit_real_range(node) = + |" Flag a declaration of a floating point type or a decimal fixed point + |" type, including types derived from them if no explicit range + |" specification is provided for the type. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1, 2 + |" + |" type F1 is digits 8; -- FLAG + |" type F2 is delta 0.01 digits 8; -- FLAG node is TypeDecl when node.p_is_real_type() and is_real_without_range(node) diff --git a/lkql_checker/share/lkql/no_inherited_classwide_pre.lkql b/lkql_checker/share/lkql/no_inherited_classwide_pre.lkql index 814602b6d..0fcbf3136 100644 --- a/lkql_checker/share/lkql/no_inherited_classwide_pre.lkql +++ b/lkql_checker/share/lkql/no_inherited_classwide_pre.lkql @@ -1,30 +1,65 @@ -# Flag a declaration of an overriding primitive operation of a tagged type if -# at least one of the operations it overrides or implements does not have -# (explicitly defined or inherited) Pre'Class aspect defined for it. - @memoized fun base_decls(node) = node.p_base_subp_declarations() @unit_check(help="overridden operation has no Pre'Class", category="Style", subcategory="Object Orientation") -fun no_inherited_classwide_pre(unit) = [ - {message: - "overriding operation that does not inherit Pre'Class (" & - ({ - val tok = [d for d in base_decls(n) - if base_decls(d).length == 1 and - not d.p_has_aspect("Pre'Class")][1].token_start(); - tok.unit.name.base_name & ":" & - img(tok.start_line) & ":" & img(tok.start_column) & ")"}), - loc: n.p_defining_name()} - for n in from unit.root select node@(BasicSubpDecl | BaseSubpBody) - # Get subprogram declarations that are primitive of a tagged type - when node.p_subp_spec_or_null()?.p_primitive_subp_tagged_type() - and ({ - val decls = base_decls(node); - # If decls.length is greater than 1, it means we are overriding - decls.length > 1 and - # Check whether one of the root operation(s) does not define Pre'Class - [d for d in decls - if (base_decls(d).length == 1) and not d.p_has_aspect("Pre'Class")] - })] +fun no_inherited_classwide_pre(unit) = + |" Flag a declaration of an overriding primitive operation of a tagged type + |" if at least one of the operations it overrides or implements does not + |" have (explicitly defined or inherited) Pre'Class aspect defined for + |" it. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 13, 17 + |" + |" package Foo is + |" + |" type Int is interface; + |" function Test (X : Int) return Boolean is abstract; + |" procedure Proc (I : in out Int) is abstract with Pre'Class => Test (I); + |" + |" type Int1 is interface; + |" procedure Proc (I : in out Int1) is abstract; + |" + |" type T is tagged private; + |" + |" type NT1 is new T and Int with private; + |" function Test (X : NT1) return Boolean; -- FLAG + |" procedure Proc (X : in out NT1); + |" + |" type NT2 is new T and Int1 with private; + |" procedure Proc (X : in out NT2); -- FLAG + |" + |" private + |" type T is tagged record + |" I : Integer; + |" end record; + |" + |" type NT1 is new T and Int with null record; + |" type NT2 is new T and Int1 with null record; + |" + |" end Foo; + [ + {message: + "overriding operation that does not inherit Pre'Class (" & + ({ + val tok = [d for d in base_decls(n) + if base_decls(d).length == 1 and + not d.p_has_aspect("Pre'Class")][1].token_start(); + tok.unit.name.base_name & ":" & + img(tok.start_line) & ":" & img(tok.start_column) & ")"}), + loc: n.p_defining_name()} + for n in from unit.root select node@(BasicSubpDecl | BaseSubpBody) + # Get subprogram declarations that are primitive of a tagged type + when node.p_subp_spec_or_null()?.p_primitive_subp_tagged_type() + and ({ + val decls = base_decls(node); + # If decls.length is greater than 1, it means we are overriding + decls.length > 1 and + # Check whether one of the root operation(s) does not define Pre'Class + [d for d in decls + if (base_decls(d).length == 1) and not d.p_has_aspect("Pre'Class")] + }) + ] diff --git a/lkql_checker/share/lkql/no_others_in_exception_handlers.lkql b/lkql_checker/share/lkql/no_others_in_exception_handlers.lkql index 32739c28b..835077e46 100644 --- a/lkql_checker/share/lkql/no_others_in_exception_handlers.lkql +++ b/lkql_checker/share/lkql/no_others_in_exception_handlers.lkql @@ -1,8 +1,3 @@ -# Flag each occurrence of a subprogram body (if `subprogram` is true) or task -# body (if `task` is true) with no others exception handler, or any handled -# sequence of statements with exception handlers (if `all_handlers` is true) -# with no others handler. - fun check_others(stmts) = stmts.f_exceptions is AdaNodeList(all children(depth=3) : not OthersDesignator) @@ -13,17 +8,67 @@ fun no_others_in_exception_handlers(unit, all_handlers=false, subprogram=false, task=false) = -[ - (match n - | TaskBody => {message: "no OTHERS exception handler in task", loc: n} - | SubpBody => {message: "no OTHERS exception handler in subprogram", - loc: n} - | * => {message: "no OTHERS choice in exception handler", - loc: n.f_exceptions.token_start().previous()}) - for n in from unit.root select - ((node@((TaskBody when task) | (SubpBody when subprogram)) - when if node.f_stmts.f_exceptions[1] then check_others(node.f_stmts)) - | node@HandledStmts - when all_handlers and node.f_exceptions[1] and - check_others(node)) -] + |" Flag handled sequences of statements that do not contain exception + |" handler with ``others``, depending on the rule parameter(s) + |" specified. + |" + |" This rule has three parameters for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Subprogram: bool* + |" If ``true``, flag a subprogram body if the handled sequence of statements + |" of this body does not contain an exception handler with ``others`` choice. + |" This includes the case when the body does not contain any exception handler + |" at all. The diagnostic message points to the beginning of the subprogram body. + |" + |" *Task: bool* + |" If ``true``, flag a task body if the handled sequence of statements of this + |" body does not contain an exception handler with ``others`` choice. This + |" includes the case when the body does not contain any exception handler at all. + |" The diagnostic message points to the beginning of the task body. + |" + |" *All_Handlers: bool* + |" If ``true``, flag a handled sequence of statements if it does contain at least + |" one exception handler, but it does not contain an exception handler with + |" ``others`` choice. If a handled sequence of statements does not have any + |" exception handler, nothing is flagged for it. The diagnostic message points + |" to the ``EXCEPTION`` keyword in the handled sequence of statements. + |" + |" At least one parameter should be specified for the rule. If + |" more than one parameter is specified, each of the specified + |" parameters has its effect. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5 + |" + |" procedure Other (I, J : in out Integer) is + |" begin + |" begin + |" I := I + 1; + |" exception -- FLAG (if All_Handlers parameter is set) + |" when Constraint_Error => null; + |" end; + |" + |" exception -- NO FLAG + |" when Constraint_Error => + |" I := Integer'Last; + |" when others => + |" I := J; + |" raise; + |" end Other; + [ + (match n + | TaskBody => {message: "no OTHERS exception handler in task", loc: n} + | SubpBody => {message: "no OTHERS exception handler in subprogram", + loc: n} + | * => {message: "no OTHERS choice in exception handler", + loc: n.f_exceptions.token_start().previous()}) + for n in from unit.root select + ((node@((TaskBody when task) | (SubpBody when subprogram)) + when if node.f_stmts.f_exceptions[1] then check_others(node.f_stmts)) + | node@HandledStmts + when all_handlers and node.f_exceptions[1] and + check_others(node)) + ] diff --git a/lkql_checker/share/lkql/no_scalar_storage_order_specified.lkql b/lkql_checker/share/lkql/no_scalar_storage_order_specified.lkql index c68349b4e..1ce8c9c35 100644 --- a/lkql_checker/share/lkql/no_scalar_storage_order_specified.lkql +++ b/lkql_checker/share/lkql/no_scalar_storage_order_specified.lkql @@ -1,9 +1,3 @@ -# Flag each record type declaration, record extension declaration, and untagged -# derived record type declaration if a record_representation_clause that has at -# least one component clause applies to it (or an ancestor), but neither the -# type nor any of its ancestors has an explicitly specified -# Scalar_Storage_Order aspect. - fun non_empty_rep_clause(n) = n.p_get_record_representation_clause() is RecordRepClause(f_components: *(any children(depth=1): ComponentClause)) @@ -17,16 +11,49 @@ fun bit_order_image(n) = { @unit_check(help="Scalar_Storage_Order is not specified", remediation="EASY", category="Style", subcategory="Portability") -fun no_scalar_storage_order_specified(unit) = [ - {message: "Scalar_Storage_Order is not specified" & bit_order_image(n), - loc: n} - for n in from unit.root select node@TypeDecl - when (node.f_type_def is - ((RecordTypeDef when not node.p_has_aspect("Scalar_Storage_Order")) | - DerivedTypeDef when not - (node.p_has_aspect("Scalar_Storage_Order") - or [p for p in node.p_base_types() - if p.p_has_aspect("Scalar_Storage_Order")]))) - and (non_empty_rep_clause(node) or - [p for p in node.p_base_types() if non_empty_rep_clause(p)]) -] +fun no_scalar_storage_order_specified(unit) = + |" Flag each record type declaration, record extension declaration, and + |" untagged derived record type declaration if a + |" record_representation_clause that has at least one component clause + |" applies to it (or an ancestor), but neither the type nor any of its + |" ancestors has an explicitly specified Scalar_Storage_Order aspect. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4 + |" + |" with System; + |" package Foo is + |" + |" type Rec1 is record -- FLAG + |" I : Integer; + |" end record; + |" + |" for Rec1 use record + |" I at 0 range 0 .. 31; + |" end record; + |" + |" type Rec2 is record -- NO FLAG + |" I : Integer; + |" end record + |" with Scalar_Storage_Order => System.Low_Order_First; + |" + |" for Rec2 use record + |" I at 0 range 0 .. 31; + |" end record; + |" + |" end Foo; + [ + {message: "Scalar_Storage_Order is not specified" & bit_order_image(n), + loc: n} + for n in from unit.root select node@TypeDecl + when (node.f_type_def is + ((RecordTypeDef when not node.p_has_aspect("Scalar_Storage_Order")) | + DerivedTypeDef when not + (node.p_has_aspect("Scalar_Storage_Order") + or [p for p in node.p_base_types() + if p.p_has_aspect("Scalar_Storage_Order")]))) + and (non_empty_rep_clause(node) or + [p for p in node.p_base_types() if non_empty_rep_clause(p)]) + ] diff --git a/lkql_checker/share/lkql/non_component_in_barriers.lkql b/lkql_checker/share/lkql/non_component_in_barriers.lkql index 4a81808e2..a9d25cb60 100644 --- a/lkql_checker/share/lkql/non_component_in_barriers.lkql +++ b/lkql_checker/share/lkql/non_component_in_barriers.lkql @@ -1,6 +1,3 @@ -# Flag each occurrence of a protected entry barrier referencing variables -# other than components of the protected object. - fun is_protected_component(id, decl, names) = { val name = decl.p_defining_name(); [n for n in names if n == name] or @@ -10,17 +7,53 @@ fun is_protected_component(id, decl, names) = { @unit_check(help="barrier references non component variable", category="Style", subcategory="Programming Practice") -fun non_component_in_barriers(unit) = [ - {message: "barrier references non component variable", loc: n.f_barrier} - for n in from unit.root select node@EntryBody( - any parent: b@ProtectedBody - when { - val names = from b.p_decl_part()?.f_definition?.f_private_part?.f_decls - select DefiningName; - [id for id in (from node.f_barrier select Identifier) - if id.p_referenced_decl() is - (ObjectDecl | ParamSpec | - d@ComponentDecl when not is_protected_component(id, d, names))] - } - ) -] +fun non_component_in_barriers(unit) = + |" Flag a barrier condition expression in an entry body declaration + |" if this expression contains a reference to a data object that is + |" not a (sub)component of the enclosing record the entry belongs to. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 21 + |" + |" protected Obj is + |" entry E1; + |" entry E2; + |" private + |" Value : Integer; + |" Is_Set : Boolean := False; + |" end Obj; + |" + |" Global_Bool : Boolean := False; + |" + |" protected body Obj is + |" + |" entry E1 + |" when Is_Set and then Value > 0 is -- NO FLAG + |" begin + |" Value := Value - 1; + |" Is_Set := False; + |" end E1; + |" + |" entry E2 + |" when Global_Bool is -- FLAG + |" begin + |" Is_Set := True; + |" end E2; + |" + |" end Obj; + [ + {message: "barrier references non component variable", loc: n.f_barrier} + for n in from unit.root select node@EntryBody( + any parent: b@ProtectedBody + when { + val names = from b.p_decl_part()?.f_definition?.f_private_part?.f_decls + select DefiningName; + [id for id in (from node.f_barrier select Identifier) + if id.p_referenced_decl() is + (ObjectDecl | ParamSpec | + d@ComponentDecl when not is_protected_component(id, d, names))] + } + ) + ] diff --git a/lkql_checker/share/lkql/non_constant_overlays.lkql b/lkql_checker/share/lkql/non_constant_overlays.lkql index 5aa69b67e..6690f0bbd 100644 --- a/lkql_checker/share/lkql/non_constant_overlays.lkql +++ b/lkql_checker/share/lkql/non_constant_overlays.lkql @@ -1,15 +1,3 @@ -# Flag an overlay definition that has a form of an attribute definition clause -# for Overlaying'Address use Overlaid'Address; or a form of aspect definition -# Address => Overlaid'Address, and Overlaid is a data object defined by a -# variable declaration, a formal parameter of mode IN OUT or OUT or a generic -# formal parameter of mode IN OUT if at least one of the following is true: -# - the overlaying object is a constant object; -# - overlaying object is not marked as Volatile; -# - if overlaid object is not a parameter, it is not marked as Volatile. - -# This rule is basically the mirror of the Constant_Overlays rule and will -# trigger on the same nodes. - import stdlib fun check_non_const_overlay(decl, overlaid) = @@ -44,12 +32,32 @@ fun check_non_const_overlay(decl, overlaid) = @check(message="constant object overlays a variable object", category="Style", subcategory="Programming Practice") -fun non_constant_overlays(node) = match node - | AspectAssoc(f_id: id@Identifier, any parent(depth=3): o@ObjectDecl - when id.p_name_is("Address") - and check_non_const_overlay(o, node.f_expr)) => true - | AttributeDefClause(f_attribute_expr: at@AttributeRef - when at.f_attribute.p_name_is("Address") - and check_non_const_overlay(at.f_prefix.p_referenced_decl(), - node.f_expr)) => true - | * => false +fun non_constant_overlays(node) = + |" Flag an overlay definition that has a form of an attribute definition + |" clause ``for Overlaying'Address use Overlaid'Address;`` or a form of + |" aspect definition ``Address => Overlaid'Address``, and ``Overlaid`` + |" is a data object defined by a variable declaration , a formal parameter + |" of mode ``IN OUT`` or ``OUT`` or a generic formal parameter of mode ``IN OUT`` + |" if at least one of the following is true: + |" + |" * the overlaying object is a constant object; + |" * overlaying object is not marked as Volatile; + |" * if overlaid object is not a parameter, it is not marked as Volatile; + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" V : Integer with Volatile; + |" C : constant Integer := 1; + |" for C'Address use V'Address; -- FLAG + match node + | AspectAssoc(f_id: id@Identifier, any parent(depth=3): o@ObjectDecl + when id.p_name_is("Address") + and check_non_const_overlay(o, node.f_expr)) => true + | AttributeDefClause(f_attribute_expr: at@AttributeRef + when at.f_attribute.p_name_is("Address") + and check_non_const_overlay(at.f_prefix.p_referenced_decl(), + node.f_expr)) => true + | * => false diff --git a/lkql_checker/share/lkql/non_qualified_aggregates.lkql b/lkql_checker/share/lkql/non_qualified_aggregates.lkql index 3a7f7be37..452a91ae7 100644 --- a/lkql_checker/share/lkql/non_qualified_aggregates.lkql +++ b/lkql_checker/share/lkql/non_qualified_aggregates.lkql @@ -1,12 +1,22 @@ -# Flag each non-qualified aggregate. A non-qualified aggregate is an aggregate -# that is not the expression of a qualified expression. A string literal is not -# considered an aggregate, but an array aggregate of a string type is -# considered as a normal aggregate. Aggregates of anonymous array types are not -# flagged. - @check(message="aggregate is not a part of a qualified expression", remediation="EASY", category="Feature") fun non_qualified_aggregates(node) = + |" Flag each non-qualified aggregate. + |" A non-qualified aggregate is an + |" aggregate that is not the expression of a qualified expression. A + |" string literal is not considered an aggregate, but an array + |" aggregate of a string type is considered as a normal aggregate. + |" Aggregates of anonymous array types are not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" type Arr is array (1 .. 10) of Integer; + |" + |" Var1 : Arr := (1 => 10, 2 => 20, others => 30); -- FLAG + |" Var2 : array (1 .. 10) of Integer := (1 => 10, 2 => 20, others => 30); node is Aggregate(p_expression_type(): not AnonymousTypeDecl, p_is_subaggregate(): false, all parent: not (QualExpr | AspectClause | Aggregate( diff --git a/lkql_checker/share/lkql/non_short_circuit_operators.lkql b/lkql_checker/share/lkql/non_short_circuit_operators.lkql index d669c7bc0..9280f01f3 100644 --- a/lkql_checker/share/lkql/non_short_circuit_operators.lkql +++ b/lkql_checker/share/lkql/non_short_circuit_operators.lkql @@ -1,10 +1,3 @@ -# Flag all calls to predefined "and" and "or" operators for any boolean type. -# Calls to user-defined "and" and "or" 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 the parameter Except_Assertions: Do not flag operators that are -# subcomponents of the assertion-related pragmas or aspects. - import stdlib fun operator_image(node) = @@ -19,16 +12,63 @@ fun operator_image(node) = @unit_check(help="use of predefined AND and OR for boolean types", remediation="EASY", category="Style", subcategory="Programming Practice") -fun non_short_circuit_operators(unit, except_assertions=false) = [ - {message: "use of predefined " & operator_image(n) & " for boolean type", - loc: n} - for n in from unit.root select node@(((OpAnd | OpOr) - when stdlib.is_predefined_op(node) - and stdlib.is_standard_boolean(node.parent) - and stdlib.is_standard_boolean(node.parent?.f_left)) - | CallExpr(p_relative_name(): n@Name - when n?.p_name_is("\"and\"") or n?.p_name_is("\"or\"")) - when stdlib.is_predefined_op(node) - and stdlib.is_standard_boolean(node) - and stdlib.is_standard_boolean(node.f_suffix[1]?.f_r_expr)) - when not (except_assertions and stdlib.within_assert(node))] +fun non_short_circuit_operators(unit, except_assertions=false) = + |" Flag all calls to predefined ``and`` and ``or`` operators for + |" any boolean type. Calls to + |" user-defined ``and`` and ``or`` 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. + |" + |" The rule has an optional parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Except_Assertions: bool* + |" If ``true``, do not flag the use of non-short-circuit_operators inside + |" assertion-related pragmas or aspect specifications. + |" + |" A pragma or an aspect is considered as assertion-related if its name + |" is from the following list: + |" + |" * ``Assert`` + |" * ``Assert_And_Cut`` + |" * ``Assume`` + |" * ``Contract_Cases`` + |" * ``Debug`` + |" * ``Default_Initial_Condition`` + |" * ``Dynamic_Predicate`` + |" * ``Invariant`` + |" * ``Loop_Invariant`` + |" * ``Loop_Variant`` + |" * ``Post`` + |" * ``Postcondition`` + |" * ``Pre`` + |" * ``Precondition`` + |" * ``Predicate`` + |" * ``Predicate_Failure`` + |" * ``Refined_Post`` + |" * ``Static_Predicate`` + |" * ``Type_Invariant`` + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1, 3 + |" + |" B1 := I > 0 and J > 0; -- FLAG + |" B2 := I < 0 and then J < 0; + |" B3 := I > J or J > 0; -- FLAG + |" B4 := I < J or else I < 0; + [ + {message: "use of predefined " & operator_image(n) & " for boolean type", + loc: n} + for n in from unit.root select node@(((OpAnd | OpOr) + when stdlib.is_predefined_op(node) + and stdlib.is_standard_boolean(node.parent) + and stdlib.is_standard_boolean(node.parent?.f_left)) + | CallExpr(p_relative_name(): n@Name + when n?.p_name_is("\"and\"") or n?.p_name_is("\"or\"")) + when stdlib.is_predefined_op(node) + and stdlib.is_standard_boolean(node) + and stdlib.is_standard_boolean(node.f_suffix[1]?.f_r_expr)) + when not (except_assertions and stdlib.within_assert(node)) + ] diff --git a/lkql_checker/share/lkql/non_spark_attributes.lkql b/lkql_checker/share/lkql/non_spark_attributes.lkql index 07c84d4dc..fa368e43e 100644 --- a/lkql_checker/share/lkql/non_spark_attributes.lkql +++ b/lkql_checker/share/lkql/non_spark_attributes.lkql @@ -1,9 +1,69 @@ -# The SPARK 95 language defines the following subset of Ada 95 attribute -# designators as those that can be used in SPARK programs. The use of any other -# attribute is flagged. [...] - -@check(message="attribute is not from the SPARK subset", category="SPARK") +@check(message="attribute is not from the SPARK subset", category="SPARK", + rule_name="Non_SPARK_Attributes") fun non_spark_attributes(node) = + |" The SPARK language defines the following subset of Ada 95 attribute + |" designators as those that can be used in SPARK programs. The use of + |" any other attribute is flagged. + |" + |" * ``'Adjacent`` + |" * ``'Aft`` + |" * ``'Base`` + |" * ``'Ceiling`` + |" * ``'Component_Size`` + |" * ``'Compose`` + |" * ``'Copy_Sign`` + |" * ``'Delta`` + |" * ``'Denorm`` + |" * ``'Digits`` + |" * ``'Exponent`` + |" * ``'First`` + |" * ``'Floor`` + |" * ``'Fore`` + |" * ``'Fraction`` + |" * ``'Last`` + |" * ``'Leading_Part`` + |" * ``'Length`` + |" * ``'Machine`` + |" * ``'Machine_Emax`` + |" * ``'Machine_Emin`` + |" * ``'Machine_Mantissa`` + |" * ``'Machine_Overflows`` + |" * ``'Machine_Radix`` + |" * ``'Machine_Rounds`` + |" * ``'Max`` + |" * ``'Min`` + |" * ``'Model`` + |" * ``'Model_Emin`` + |" * ``'Model_Epsilon`` + |" * ``'Model_Mantissa`` + |" * ``'Model_Small`` + |" * ``'Modulus`` + |" * ``'Pos`` + |" * ``'Pred`` + |" * ``'Range`` + |" * ``'Remainder`` + |" * ``'Rounding`` + |" * ``'Safe_First`` + |" * ``'Safe_Last`` + |" * ``'Scaling`` + |" * ``'Signed_Zeros`` + |" * ``'Size`` + |" * ``'Small`` + |" * ``'Succ`` + |" * ``'Truncation`` + |" * ``'Unbiased_Rounding`` + |" * ``'Val`` + |" * ``'Valid`` + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4 + |" + |" type Integer_A is access all Integer; + |" + |" Var : aliased Integer := 1; + |" Var_A : Integer_A := Var'Access; -- FLAG node is AttributeRef when not (node.f_attribute?.p_name_is("Adjacent") or node.f_attribute?.p_name_is("Aft") or diff --git a/lkql_checker/share/lkql/non_tagged_derived_types.lkql b/lkql_checker/share/lkql/non_tagged_derived_types.lkql index 9e1d1e432..263c7f72b 100644 --- a/lkql_checker/share/lkql/non_tagged_derived_types.lkql +++ b/lkql_checker/share/lkql/non_tagged_derived_types.lkql @@ -1,6 +1,16 @@ -# Flag all derived type declarations that do not have a record extension part. - @check(message="derived type that is not a type extension", category="SPARK") fun non_tagged_derived_types(node) = + |" Flag all derived type declarations that do not have a record extension part. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5 + |" + |" type Coordinates is record + |" X, Y, Z : Float; + |" end record; + |" + |" type Hidden_Coordinates is new Coordinates; -- FLAG node is DerivedTypeDef(f_record_extension: null, f_has_with_private: WithPrivateAbsent) diff --git a/lkql_checker/share/lkql/non_visible_exceptions.lkql b/lkql_checker/share/lkql/non_visible_exceptions.lkql index ddb5cde25..ca32e43f3 100644 --- a/lkql_checker/share/lkql/non_visible_exceptions.lkql +++ b/lkql_checker/share/lkql/non_visible_exceptions.lkql @@ -1,55 +1,89 @@ -# Flag constructs leading to the possibility of propagating an exception out of -# the scope in which the exception is declared. Two cases are detected: -# - An exception declaration in a subprogram body, task body or block statement -# is flagged if the body or statement does not contain a handler for that -# exception or a handler with an others choice. -# - A raise statement in an exception handler of a subprogram body, task body -# or block statement is flagged if it (re)raises a locally declared exception. -# This may occur under the following circumstances: -# - it explicitly raises a locally declared exception, or -# - it does not specify an exception name (i.e., it is simply raise;) and the -# enclosing handler contains a locally declared exception in its exception -# choices. -# Renamings of local exceptions are not flagged. - import stdlib @unit_check(help="potential propagations of non-visible exceptions", category="Style", subcategory="Program Structure") -fun non_visible_exceptions(unit) = [ - {message: if n is Identifier - then "local exception not handled locally" - else "propagates local exception" & - (if n.f_exception_name - then " declared at line " & - img(n.f_exception_name.p_referenced_decl() - .token_start().start_line) - else "") & " outside its visibility", - loc: n} - for n in from unit.root select - # Find exception identifiers part of an ExceptionDecl and not a renaming... - node@(Identifier(parent: DefiningName(parent: DefiningNameList(parent: - e@ExceptionDecl(f_renames: null) - # ...declared in a subprogram body, task body or block - when e.p_semantic_parent() is p@(SubpBody | TaskBody | DeclBlock) - # with either no exception handler - when not p.f_stmts.f_exceptions - # or no handler referencing node or "others" - or not p.f_stmts.f_exceptions is - AdaNodeList(any children(depth=3): - OthersDesignator | - (id@(Identifier | DottedName) - when stdlib.ultimate_exception_alias(id) == e))))) - # Find also raise statements in an exception handler of a subprogram body, - # task body or block statement - | RaiseStmt(any parent: h@ExceptionHandler - when h.p_semantic_parent() is p@(SubpBody | TaskBody | DeclBlock) - when - # raises a locally declared exception - if node.f_exception_name - then node.f_exception_name.p_referenced_decl()?.parent?.parent - == p.f_decls - # does not specify an exception name and the enclosing handler - # contains a locally declared exception in its choices - else h.f_handled_exceptions is *(any children: id@Identifier - when id.p_referenced_decl()?.p_semantic_parent?() == p)))] +fun non_visible_exceptions(unit) = + |" Flag constructs leading to the possibility of propagating an exception + |" out of the scope in which the exception is declared. + |" Two cases are detected: + |" + |" * An exception declaration located immediately within a subprogram body, task + |" body or block statement is flagged if the body or statement does not contain + |" a handler for that exception or a handler with an ``others`` choice. + |" * A ``raise`` statement in an exception handler of a subprogram body, + |" task body or block statement is flagged if it (re)raises a locally + |" declared exception. This may occur under the following circumstances: + |" * it explicitly raises a locally declared exception, or + |" + |" * it does not specify an exception name (i.e., it is simply ``raise;``) + |" and the enclosing handler contains a locally declared exception in its + |" exception choices. + |" + |" Renamings of local exceptions are not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5, 18 + |" + |" procedure Bar is + |" Var : Integer :=- 13; + |" + |" procedure Inner (I : in out Integer) is + |" Inner_Exception_1 : exception; -- FLAG + |" Inner_Exception_2 : exception; + |" begin + |" if I = 0 then + |" raise Inner_Exception_1; + |" elsif I = 1 then + |" raise Inner_Exception_2; + |" else + |" I := I - 1; + |" end if; + |" exception + |" when Inner_Exception_2 => + |" I := 0; + |" raise; -- FLAG + |" end Inner; + |" + |" begin + |" Inner (Var); + |" end Bar; + [ + {message: if n is Identifier + then "local exception not handled locally" + else "propagates local exception" & + (if n.f_exception_name + then " declared at line " & + img(n.f_exception_name.p_referenced_decl() + .token_start().start_line) + else "") & " outside its visibility", + loc: n} + for n in from unit.root select + # Find exception identifiers part of an ExceptionDecl and not a renaming... + node@(Identifier(parent: DefiningName(parent: DefiningNameList(parent: + e@ExceptionDecl(f_renames: null) + # ...declared in a subprogram body, task body or block + when e.p_semantic_parent() is p@(SubpBody | TaskBody | DeclBlock) + # with either no exception handler + when not p.f_stmts.f_exceptions + # or no handler referencing node or "others" + or not p.f_stmts.f_exceptions is + AdaNodeList(any children(depth=3): + OthersDesignator | + (id@(Identifier | DottedName) + when stdlib.ultimate_exception_alias(id) == e))))) + # Find also raise statements in an exception handler of a subprogram body, + # task body or block statement + | RaiseStmt(any parent: h@ExceptionHandler + when h.p_semantic_parent() is p@(SubpBody | TaskBody | DeclBlock) + when + # raises a locally declared exception + if node.f_exception_name + then node.f_exception_name.p_referenced_decl()?.parent?.parent + == p.f_decls + # does not specify an exception name and the enclosing handler + # contains a locally declared exception in its choices + else h.f_handled_exceptions is *(any children: id@Identifier + when id.p_referenced_decl()?.p_semantic_parent?() == p))) + ] diff --git a/lkql_checker/share/lkql/nonoverlay_address_specifications.lkql b/lkql_checker/share/lkql/nonoverlay_address_specifications.lkql index f339bee49..f41027ca4 100644 --- a/lkql_checker/share/lkql/nonoverlay_address_specifications.lkql +++ b/lkql_checker/share/lkql/nonoverlay_address_specifications.lkql @@ -1,9 +1,3 @@ -# Flag an overlay definition if it has neither the form of an attribute -# definition clause "for Overlaying'Address use Overlaid'Address;" nor the form -# of aspect definition "Address => Overlaid'Address", where Overlaid is an -# identifier defined either by an object declaration or a parameter -# specification. - import stdlib fun check_nonoverlay(overlaid) = @@ -18,6 +12,32 @@ fun check_nonoverlay(overlaid) = @check(message="nonoverlay address specification", category="Style", subcategory="Programming Practice") fun nonoverlay_address_specifications(node) = + |" Flag an attribute definition clause that defines ``'Address`` attribute if + |" it does not have the form ``for Overlaying'Address use Overlaid'Address;`` + |" where ``Overlaying`` is an identifier defined by an object declaration + |" and ``Overlaid`` is an identifier defined either by an object declaration + |" or a parameter specification. Flag an Address aspect specification if + |" this aspect specification is not a part of an object declaration and + |" if the aspect value does not have the form ``Overlaid'Address`` + |" where ``Overlaid`` is an identifier defined either by an object + |" declaration or a parameter specification. + |" + |" Address specifications given for program units are not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 9 + |" + |" type Rec is record + |" C : Integer; + |" end record; + |" + |" Var_Rec : Rec; + |" Var_Int : Integer; + |" + |" Var1 : Integer with Address => Var_Int'Address; + |" Var2 : Integer with Address => Var_Rec.C'Address; -- FLAG node is ((AspectAssoc(f_id: id@Identifier, any parent(depth=3): ObjectDecl when id.p_name_is("address") and check_nonoverlay (node.f_expr))) diff --git a/lkql_checker/share/lkql/not_imported_overlays.lkql b/lkql_checker/share/lkql/not_imported_overlays.lkql index e02a6e9bd..a202a460c 100644 --- a/lkql_checker/share/lkql/not_imported_overlays.lkql +++ b/lkql_checker/share/lkql/not_imported_overlays.lkql @@ -1,13 +1,32 @@ -# Flag a 'Address attribute definition clause or Address aspect specification -# that has the form [for Overlaying'Address use] Overlaid'Address; where -# Overlaying and Overlaid are identifiers both defined by object declarations -# if Overlaying is not marked as imported. - import stdlib @check(message="not imported overlay", category="Style", subcategory="Programming Practice") fun not_imported_overlays(node) = + |" Flag an attribute definition clause that defines 'Address attribute and + |" has the form ``for Overlaying'Address use Overlaid'Address;`` where + |" ``Overlaying`` and ``Overlaid`` are identifiers + |" both defined by object declarations if ``Overlaying`` is not marked as + |" imported. Flag an Address aspect specification if this aspect specification + |" is a part of an object declaration of the object ``Overlaying`` and + |" if the aspect value has the form ``Overlaid'Address`` where ``Overlaid`` + |" is an identifier defined by an object declaration if the object ``Overlaying`` + |" is not marked as imported. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4 + |" + |" package Pack is + |" I : Integer; + |" + |" J : Integer with Address => I'Address; -- FLAG + |" + |" L : Integer; + |" for L'Address use I'Address; -- NO FLAG + |" pragma Import (C, L); + |" end Pack; node is (( AspectAssoc(f_id: Identifier(p_name_is("Address"): true), any parent(depth=3): o@ObjectDecl diff --git a/lkql_checker/share/lkql/null_paths.lkql b/lkql_checker/share/lkql/null_paths.lkql index bf5a1b362..ca2954f0d 100644 --- a/lkql_checker/share/lkql/null_paths.lkql +++ b/lkql_checker/share/lkql/null_paths.lkql @@ -1,11 +1,39 @@ -# Flag a statement sequence that is a component of an IF, CASE or LOOP -# statement if this sequence consists of NULL statements only. -# This rule has an optional parameter Except_Enums: exclude case statements on -# enumerated types. - @check(message="null path", remediation="EASY", category="Style", subcategory="Programming Practice") fun null_paths(node, except_enums = false) = + |" Flag a statement sequence that is a component of an ``if``, ``case`` or + |" ``loop`` statement if this sequences consists of NULL statements only. + |" + |" The rule has an optional parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Except_Enums: bool* + |" If ``true``, do not flag null paths inside case statements whose selecting + |" expression is of an enumeration type. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4, 13, 17 + |" + |" if I > 10 then + |" J := 5; + |" elsif I > 0 then + |" null; -- FLAG + |" else + |" J := J + 1; + |" end if; + |" + |" case J is + |" when 1 => + |" I := I + 1; + |" when 2 => + |" null; -- FLAG + |" when 3 => + |" J := J + 1; + |" when others => + |" null; -- FLAG + |" end case; node is StmtList when node[1] and node is StmtList(any parent: diff --git a/lkql_checker/share/lkql/number_declarations.lkql b/lkql_checker/share/lkql/number_declarations.lkql index 48dde4575..18c917b65 100644 --- a/lkql_checker/share/lkql/number_declarations.lkql +++ b/lkql_checker/share/lkql/number_declarations.lkql @@ -1,4 +1,15 @@ -# Number declarations are flagged. - @check(message="number declaration", category="Feature") -fun number_declarations(node) = node is NumberDecl +fun number_declarations(node) = + |" Number declarations are flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1, 2 + |" + |" Num1 : constant := 13; -- FLAG + |" Num2 : constant := 1.3; -- FLAG + |" + |" Const1 : constant Integer := 13; + |" Const2 : constant Float := 1.3; + node is NumberDecl diff --git a/lkql_checker/share/lkql/numeric_format.lkql b/lkql_checker/share/lkql/numeric_format.lkql index 0a26f4082..9ca232f00 100644 --- a/lkql_checker/share/lkql/numeric_format.lkql +++ b/lkql_checker/share/lkql/numeric_format.lkql @@ -1,12 +1,28 @@ -# Flag each numeric literal which does not follow these rules: -# - given in bases 2, 8, 10 or 16 only -# - an underscore should separate groups of 3 digits for bases 8 or 10 -# - an underscore should separate groups of 4 digits for bases 2 or 16 -# - all letters (exponent symbol and digits above 9) should be in upper case. - @check(message="incorrect format for numeric literal", category="Style", subcategory="Readability") fun numeric_format(node) = + |" Flag each numeric literal which does not satisfy at least one of the + |" following requirements: + |" + |" * the literal is given in the conventional decimal notation given, + |" or, if its base is specified explicitly, this base should be + |" 2, 8, 10 or 16 only; + |" * if the literal base is 8 or 10, an underscore should separate groups + |" of 3 digits starting from the right end of the literal; + |" * if the literal base is 2 or 16, an underscore should separate groups + |" of 4 digits starting from the right end of the literal; + |" * all letters (exponent symbol and digits above 9) should be in upper case. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4, 5 + |" + |" D : constant := 16#12AB_C000#; -- NO FLAG + |" E : constant := 3.5E3; -- NO FLAG + |" + |" F : constant := 1000000; -- FLAG + |" G : constant := 2#0001000110101011#; -- FLAG node is NumLiteral when match node.text # default base | "^[0-9]{1,3}(_[0-9]{3})*(\.[0-9]{1,3}(_[0-9]{3})*)?(E[+-]?[0-9]+)?$" diff --git a/lkql_checker/share/lkql/numeric_indexing.lkql b/lkql_checker/share/lkql/numeric_indexing.lkql index 93d8406bf..340de60f6 100644 --- a/lkql_checker/share/lkql/numeric_indexing.lkql +++ b/lkql_checker/share/lkql/numeric_indexing.lkql @@ -1,12 +1,22 @@ -# Flag numeric literals, including those preceded by a 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). - import stdlib @check(message="integer literal as index value", category="Feature") fun numeric_indexing(node) = + |" Flag numeric literals, including those preceded by a 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). + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5 + |" + |" procedure Proc is + |" type Arr is array (1 .. 10) of Integer; + |" Var : Arr; + |" begin + |" Var (1) := 10; -- FLAG node is IntLiteral when { val n = if node.parent is UnOp(f_op: op@OpMinus when stdlib.is_predefined_op(op)) diff --git a/lkql_checker/share/lkql/numeric_literals.lkql b/lkql_checker/share/lkql/numeric_literals.lkql index a7348d4b1..d46c6a796 100644 --- a/lkql_checker/share/lkql/numeric_literals.lkql +++ b/lkql_checker/share/lkql/numeric_literals.lkql @@ -1,19 +1,3 @@ -# Flag each use of a numeric literal except for the following: -# - a literal occurring in the initialization expression for a constant -# declaration or a named number declaration, or -# - a literal occurring in an aspect definition or in an aspect clause, or -# - an integer literal that is less than or equal to a value specified by the -# N rule parameter. -# - As the immediate right expression of an infix exponentiation operator -# - As an indexing of an array attribute -# - a literal occurring in a declaration in case the Statements_Only rule -# parameter is given. -# This rule has the following parameters: -# - N: an integer literal used as the maximal value that is not flagged (i.e., -# integer literals not exceeding this value are allowed). -# - ALL: Ignore parameter N. -# - Statements_Only: Numeric literals are flagged only when used in statements. - fun check_parents(n, statements_only) = match n | null => true @@ -28,6 +12,49 @@ fun check_parents(n, statements_only) = @check(message="numeric literal", category="Feature") fun numeric_literals(node, n : int = 1, all = false, statements_only = false) = + |" Flag each use of a numeric literal except for the following: + |" + |" * a literal occurring in the initialization expression for a constant + |" declaration or a named number declaration, or + |" * a literal occurring in an aspect definition or in an aspect clause, or + |" * an integer literal that is less than or equal to a value + |" specified by the *N* rule parameter, or + |" * an integer literal that is the right operand of an infix call to an + |" exponentiation operator, or + |" * an integer literal that denotes a dimension in array types attributes + |" ``First``, ``Last`` and ``Length``, or + |" * a literal occurring in a declaration in case the *Statements_Only* + |" rule parameter is given. + |" + |" This rule may have the following parameters for the ``+R`` option and for + |" LKQL rule options files: + |" + |" *N: int* + |" An integer literal used as the maximal value that is not flagged + |" (i.e., integer literals not exceeding this value are allowed). + |" + |" + |" *All: bool* + |" If ``true``, all integer literals are flagged. + |" + |" + |" *Statements_Only: bool* + |" If ``true``, numeric literals are flagged only when used in statements. + |" + |" If no parameters are set, the maximum unflagged value is 1, and the check for + |" literals is not limited by statements only. + |" + |" The last specified check limit (or the fact that there is no limit at + |" all) is used when multiple ``+R`` options appear. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" C1 : constant Integer := 10; + |" V1 : Integer := C1; + |" V2 : Integer := 20; -- FLAG node is NumLiteral # check parameter N if we have an integer literal, unless ALL is set when (all or (node is RealLiteral or node.p_denoted_value() > n) diff --git a/lkql_checker/share/lkql/object_declarations_out_of_order.lkql b/lkql_checker/share/lkql/object_declarations_out_of_order.lkql index 503eed8a3..29c55b310 100644 --- a/lkql_checker/share/lkql/object_declarations_out_of_order.lkql +++ b/lkql_checker/share/lkql/object_declarations_out_of_order.lkql @@ -1,14 +1,25 @@ -# Flag any object declaration that is located in a library unit body if it -# is preceded by a declaration of a program unit spec, stub or body. - import stdlib @unit_check(help="object declarations should precede program unit declarations", remediation="EASY", category="Style", subcategory="Readability") -fun object_declarations_out_of_order(unit) = [ - {message: "object declaration after program unit declaration at line " & - img(node.previous_sibling()?.token_start().start_line), - loc: node.p_defining_name()} - for node in from unit.root select o@ObjectDecl - when stdlib.is_program_unit(o.previous_sibling()) - and stdlib.is_in_library_unit_body(o)] +fun object_declarations_out_of_order(unit) = + |" Flag any object declaration that is located in a library unit body if + |" this is preceding by a declaration of a program unit spec, stub or body. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4 + |" + |" procedure Proc is + |" procedure Proc1 is separate; + |" + |" I : Integer; -- FLAG + [ + {message: "object declaration after program unit declaration at line " & + img(node.previous_sibling()?.token_start().start_line), + loc: node.p_defining_name()} + for node in from unit.root select o@ObjectDecl + when stdlib.is_program_unit(o.previous_sibling()) + and stdlib.is_in_library_unit_body(o) + ] diff --git a/lkql_checker/share/lkql/objects_of_anonymous_types.lkql b/lkql_checker/share/lkql/objects_of_anonymous_types.lkql index be6e7e9fc..6ce8406b4 100644 --- a/lkql_checker/share/lkql/objects_of_anonymous_types.lkql +++ b/lkql_checker/share/lkql/objects_of_anonymous_types.lkql @@ -1,14 +1,36 @@ -# Flag any object declaration located immediately within a package declaration -# or a package body (including generic packages) if it uses anonymous access or -# array type definition. Record component definitions and parameter -# specifications are not flagged. Formal object declarations defined with -# anonymous access definitions are flagged. - import stdlib @check(message="object of anonymous type", remediation="EASY", category="Style", subcategory="Programming Practice") fun objects_of_anonymous_types(node) = + |" Flag any object declaration located immediately within a package + |" declaration or a package body (including generic packages) if it uses + |" anonymous access or array type definition. Record component definitions + |" and parameter specifications are not flagged. Formal object declarations + |" defined with anonymous access definitions are flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5, 8, 12 + |" + |" package Foo is + |" type Arr is array (1 .. 10) of Integer; + |" type Acc is access Integer; + |" + |" A : array (1 .. 10) of Integer; -- FLAG + |" B : Arr; + |" + |" C : access Integer; -- FLAG + |" D : Acc; + |" + |" generic + |" F1 : access Integer; -- FLAG + |" F2 : Acc; + |" procedure Proc_G + |" (P1 : access Integer; + |" P2 : Acc); + |" end Foo; node is ObjectDecl(f_type_expr: TypeExpr(p_designated_type_decl(): AnonymousTypeDecl)) when stdlib.is_in_package_scope(node) diff --git a/lkql_checker/share/lkql/one_construct_per_line.lkql b/lkql_checker/share/lkql/one_construct_per_line.lkql index 28e89d22f..bd759a362 100644 --- a/lkql_checker/share/lkql/one_construct_per_line.lkql +++ b/lkql_checker/share/lkql/one_construct_per_line.lkql @@ -1,18 +1,36 @@ -# Flag any statement, declaration or representation clause if the code -# line where this construct starts contains some other Ada code symbols -# preceding or following this construct. The following constructs are not -# flagged: -# - enumeration literal specification; -# - parameter specifications; -# - discriminant specifications; -# - loop parameter specification; -# - entry index specification; - import stdlib @check(message="more than one construct on the same line", remediation="EASY", category="Style", subcategory="Readability") fun one_construct_per_line(node) = + |" Flag any statement, declaration or representation clause if the code + |" line where this construct starts contains some other Ada code symbols + |" preceding or following this construct. The following constructs are not + |" flagged: + |" + |" * enumeration literal specification; + |" * parameter specifications; + |" * discriminant specifications; + |" * mod clauses; + |" * loop parameter specification; + |" * entry index specification; + |" * choice parameter specification; + |" + |" In case if we have two or more declarations/statements/clauses on a + |" line and if there is no Ada code preceding the first construct, the + |" first construct is flagged + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5 + |" + |" procedure Swap (I, J : in out Integer) is + |" Tmp : Integer; + |" begin + |" Tmp := I; + |" I := J; J := Tmp; -- FLAG + |" end Swap; # Flag any statement, declaration or representation clause node is (Stmt | BasicDecl | AttributeDefClause | EnumRepClause | RecordRepClause | AtClause) diff --git a/lkql_checker/share/lkql/one_tagged_type_per_package.lkql b/lkql_checker/share/lkql/one_tagged_type_per_package.lkql index 5d5bf2195..717763b82 100644 --- a/lkql_checker/share/lkql/one_tagged_type_per_package.lkql +++ b/lkql_checker/share/lkql/one_tagged_type_per_package.lkql @@ -1,9 +1,20 @@ -# Flag all package declarations with more than one tagged type declaration -# in the public part. - @check(message="more than one tagged type declared in package spec", category="Style", subcategory="Program Structure") fun one_tagged_type_per_package(node) = + |" Flag all package declarations with more than one tagged type declaration + |" in the visible part. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" package P is -- FLAG + |" + |" type T is tagged null record; + |" type T2 is tagged null record; + |" + |" end P; node is BasePackageDecl(f_public_part: *(f_decls: decls)) when (from decls select t@BaseTypeDecl when t.p_is_tagged_type() and t.parent == decls).length > 1 diff --git a/lkql_checker/share/lkql/operator_renamings.lkql b/lkql_checker/share/lkql/operator_renamings.lkql index cfc8cfcde..1060fc2c5 100644 --- a/lkql_checker/share/lkql/operator_renamings.lkql +++ b/lkql_checker/share/lkql/operator_renamings.lkql @@ -1,13 +1,28 @@ -# Flag all operator renamings. -# If name_mismatch is true then only flag when the renamed subprogram is also -# an operator with a different name. - @check(message="renaming of an operator", category="Style", subcategory="Programming Practice") fun operator_renamings(node, name_mismatch=false) = - node is SubpRenamingDecl - when node.f_renames.f_renamed_object?.p_is_operator_name() - and (if name_mismatch - then (node.p_defining_name().p_is_operator_name() and not - node.p_defining_name().p_relative_name().p_name_matches( - node.f_renames.f_renamed_object.p_relative_name()))) + |" Flag subprogram renaming declarations that have an operator symbol as + |" the name of renamed subprogram. + |" + |" The rule has an optional parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Name_Mismatch: bool* + |" If ``true``, only flag when the renamed subprogram is also an operator with + |" a different name. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" function Foo (I, J : Integer) -- FLAG + |" return Integer renames Standard."+"; + |" function "-" (I, J : Integer) -- NO FLAG + |" return Integer renames Bar; + node is SubpRenamingDecl + when node.f_renames.f_renamed_object?.p_is_operator_name() + and (if name_mismatch + then (node.p_defining_name().p_is_operator_name() and not + node.p_defining_name().p_relative_name().p_name_matches( + node.f_renames.f_renamed_object.p_relative_name()))) diff --git a/lkql_checker/share/lkql/others_in_aggregates.lkql b/lkql_checker/share/lkql/others_in_aggregates.lkql index fb6c2c4ae..d8cfbbd26 100644 --- a/lkql_checker/share/lkql/others_in_aggregates.lkql +++ b/lkql_checker/share/lkql/others_in_aggregates.lkql @@ -1,14 +1,51 @@ -# Flag each use of an others choice in extension aggregates. In record and -# array aggregates, an others choice is flagged unless it is used to refer to -# all components, or to all but one component. -# If, in case of a named array aggregate, there are two associations, one with -# an others choice and another with a discrete range, the others choice is -# flagged even if the discrete range specifies exactly one component; for -# example, (1..1 => 0, others => 1). - @check(message="OTHERS choice in aggregate", remediation="EASY", + rule_name="OTHERS_In_Aggregates", category="Style", subcategory="Programming Practice") fun others_in_aggregates(node) = + |" Flag each use of an ``others`` choice in extension aggregates. + |" In record and array aggregates, an ``others`` choice is flagged unless + |" it is used to refer to all components, or to all but one component. + |" + |" If, in case of a named array aggregate, there are two associations, one + |" with an ``others`` choice and another with a discrete range, the + |" ``others`` choice is flagged even if the discrete range specifies + |" exactly one component; for example, ``(1..1 => 0, others => 1)``. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 22, 25, 29 + |" + |" package Foo is + |" type Arr is array (1 .. 10) of Integer; + |" + |" type Rec is record + |" C1 : Integer; + |" C2 : Integer; + |" C3 : Integer; + |" C4 : Integer; + |" end record; + |" + |" type Tagged_Rec is tagged record + |" C1 : Integer; + |" end record; + |" + |" type New_Tagged_Rec is new Tagged_Rec with record + |" C2 : Integer; + |" C3 : Integer; + |" C4 : Integer; + |" end record; + |" + |" Arr_Var1 : Arr := (others => 1); + |" Arr_Var2 : Arr := (1 => 1, 2=> 2, others => 0); -- FLAG + |" + |" Rec_Var1 : Rec := (C1 => 1, others => 0); + |" Rec_Var2 : Rec := (1, 2, others => 3); -- FLAG + |" + |" Tagged_Rec_Var : Tagged_Rec := (C1 => 1); + |" + |" New_Tagged_Rec_Var : New_Tagged_Rec := (Tagged_Rec_Var with others => 0); -- FLAG + |" end Foo; node is OthersDesignator(parent: l@AlternativesList( parent: a@AggregateAssoc # Flag all aggregates with more than 2 alternatives diff --git a/lkql_checker/share/lkql/others_in_case_statements.lkql b/lkql_checker/share/lkql/others_in_case_statements.lkql index b57a6a7bd..b74f7c875 100644 --- a/lkql_checker/share/lkql/others_in_case_statements.lkql +++ b/lkql_checker/share/lkql/others_in_case_statements.lkql @@ -1,7 +1,3 @@ -# Flag any use of an others choice in a case statement. -# If the optional parameter N is specified, only flag if the others choice -# can be determined to span less than N values (0 means no minimum value). - import stdlib fun choices(list) = @@ -22,8 +18,31 @@ fun remaining_values(case) = 0) @check(message="OTHERS choice in case statement", remediation="EASY", + rule_name="OTHERS_In_CASE_Statements", category="Style", subcategory="Programming Practice") fun others_in_case_statements(node, n : int = 0, ignore = false) = + |" Flag any use of an ``others`` choice in a ``case`` statement. + |" + |" The rule has an optional parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *N: int* + |" If specified, only flag if the others choice can be determined to span less + |" than ``N`` values (0 means no minimum value). + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 6 + |" + |" case J is + |" when 1 => + |" I := I + 1; + |" when 3 => + |" J := J + 1; + |" when others => -- FLAG + |" null; + |" end case; node is OthersDesignator(parent: AlternativesList( parent: alt@CaseStmtAlternative)) when n == 0 or diff --git a/lkql_checker/share/lkql/others_in_exception_handlers.lkql b/lkql_checker/share/lkql/others_in_exception_handlers.lkql index 94b3c13a4..de1e42c9d 100644 --- a/lkql_checker/share/lkql/others_in_exception_handlers.lkql +++ b/lkql_checker/share/lkql/others_in_exception_handlers.lkql @@ -1,7 +1,19 @@ -# Flag any use of an others choice in an exception handler. - @check(message="OTHERS choice in exception handler", + rule_name="OTHERS_In_Exception_Handlers", category="Style", subcategory="Programming Practice") fun others_in_exception_handlers(node) = + |" Flag any use of an ``others`` choice in an exception handler. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4 + |" + |" exception + |" when Constraint_Error => + |" I:= Integer'Last; + |" when others => -- FLAG + |" I := I_Old; + |" raise; node is OthersDesignator(parent: AlternativesList( parent: ExceptionHandler)) diff --git a/lkql_checker/share/lkql/outbound_protected_assignments.lkql b/lkql_checker/share/lkql/outbound_protected_assignments.lkql index 23ca936bf..b940f487c 100644 --- a/lkql_checker/share/lkql/outbound_protected_assignments.lkql +++ b/lkql_checker/share/lkql/outbound_protected_assignments.lkql @@ -1,12 +1,42 @@ -# Flag an assignment statement located in a protected body if the variable name -# in the left part of the statement denotes an object declared outside this -# protected type or object. - import stdlib @check(message="assignment from protected body to outside object", category="Style", subcategory="Programming Practice") fun outbound_protected_assignments(node) = + |" Flag an assignment statement located in a protected body if the + |" variable name in the left part of the statement denotes an object + |" declared outside this protected type or object. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 17 + |" + |" package Pack is + |" Var : Integer; + |" + |" protected P is + |" entry E (I : in out Integer); + |" procedure P (I : Integer); + |" private + |" Flag : Boolean; + |" end P; + |" + |" end Pack; + |" package body Pack is + |" protected body P is + |" entry E (I : in out Integer) when Flag is + |" begin + |" I := Var + I; + |" Var := I; -- FLAG + |" end E; + |" + |" procedure P (I : Integer) is + |" begin + |" Flag := I > 0; + |" end P; + |" end P; + |" end Pack; node is AssignStmt(any parent: p@ProtectedBody when not (stdlib.ultimate_alias(node.f_dest) is *(any parent: pr@(ProtectedTypeDecl | diff --git a/lkql_checker/share/lkql/outer_loop_exits.lkql b/lkql_checker/share/lkql/outer_loop_exits.lkql index 9f8f478dd..69b4c5d26 100644 --- a/lkql_checker/share/lkql/outer_loop_exits.lkql +++ b/lkql_checker/share/lkql/outer_loop_exits.lkql @@ -1,8 +1,21 @@ -# Flag each exit statement containing a loop name that is not the name of the -# immediately enclosing loop statement. - @check(message="exit out of the nesting loop", category="SPARK") fun outer_loop_exits(node) = + |" Flag each ``exit`` statement containing a loop name that is not the name + |" of the immediately enclosing ``loop`` statement. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5 + |" + |" Outer : for J in S1'Range loop + |" for K in S2'Range loop + |" if S1 (J) = S2 (K) then + |" Detected := True; + |" exit Outer; -- FLAG + |" end if; + |" end loop; + |" end loop Outer; node is ExitStmt(f_loop_name: Identifier) when [p for p in node.parents(include_self=false) if p is BaseLoopStmt].to_list[1] is l@BaseLoopStmt diff --git a/lkql_checker/share/lkql/outside_references_from_subprograms.lkql b/lkql_checker/share/lkql/outside_references_from_subprograms.lkql index 9e5807f73..9ebf1edaa 100644 --- a/lkql_checker/share/lkql/outside_references_from_subprograms.lkql +++ b/lkql_checker/share/lkql/outside_references_from_subprograms.lkql @@ -1,8 +1,3 @@ -# Within a subprogram body or an expression function flag any identifier that -# denotes a non global data object declared outside this body. -# This rule analyzes generic instantiations and ignores generic packages to -# avoid flagging all references to formal objects. - import stdlib fun outside_refs(body) = { @@ -23,9 +18,28 @@ fun outside_refs(body) = { @unit_check(message="outside references from subprogram", category="Style", subcategory="Program Structure") -fun outside_references_from_subprograms(unit) = [ - {message: "outside references from subprogram", loc: n} - for n in concat([outside_refs(body) - for body in from unit.root through follow_generics - select subp@BaseSubpBody - when not stdlib.in_generic_template(subp)].to_list)] +fun outside_references_from_subprograms(unit) = + |" Within a subprogram body or an expression function flag any identifier that + |" denotes a non global data object declared outside this body. + |" + |" This rule analyzes generic instantiations and ignores generic packages to + |" avoid flagging all references to formal objects. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 6 + |" + |" procedure Enclosing is + |" Var : Integer; + |" + |" procedure Proc (I : in out Integer) is + |" begin + |" I := I + Var; -- FLAG + [ + {message: "outside references from subprogram", loc: n} + for n in concat([outside_refs(body) + for body in from unit.root through follow_generics + select subp@BaseSubpBody + when not stdlib.in_generic_template(subp)].to_list) + ] diff --git a/lkql_checker/share/lkql/overloaded_operators.lkql b/lkql_checker/share/lkql/overloaded_operators.lkql index 1dac5edd6..c182f7c78 100644 --- a/lkql_checker/share/lkql/overloaded_operators.lkql +++ b/lkql_checker/share/lkql/overloaded_operators.lkql @@ -1,10 +1,21 @@ -# Flag each function declaration that overloads an operator symbol. A function -# body or an expression function is checked only if it does not have a separate -# spec. Formal functions are also checked. For a renaming declaration, only -# renaming-as-declaration is checked. - @check(message="overloading of an operator symbol", category="SPARK") fun overloaded_operators(node) = + |" Flag each function declaration that overloads an operator symbol. + |" A function body or an expression function is checked only if it + |" does not have a separate spec. Formal functions are also checked. For a + |" renaming declaration, only renaming-as-declaration is checked. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 6 + |" + |" type Rec is record + |" C1 : Integer; + |" C2 : Float; + |" end record; + |" + |" function "<" (Left, Right : Rec) return Boolean; -- FLAG match node | ClassicSubpDecl => node.p_defining_name()?.p_is_operator_name() | BaseSubpBody => not node.p_decl_part() and diff --git a/lkql_checker/share/lkql/overly_nested_control_structures.lkql b/lkql_checker/share/lkql/overly_nested_control_structures.lkql index 6f22005a1..ad1c85857 100644 --- a/lkql_checker/share/lkql/overly_nested_control_structures.lkql +++ b/lkql_checker/share/lkql/overly_nested_control_structures.lkql @@ -1,15 +1,3 @@ -# Flag each control structure whose nesting level exceeds the value provided in -# the rule parameter n. -# The control structures checked are the following: -# - if statement -# - case statement -# - loop statement -# - selective accept statement -# - timed entry call statement -# - conditional entry call statement -# - asynchronous select statement -# If Loops_Only is true, only loop statements are counted. - fun check_control_parent(node, n) = |" Return true if node and its parents contain more than n control structure match node @@ -28,6 +16,48 @@ fun check_loop_parent(node, n) = @check(message="nesting level of control structures too deep", category="Style", subcategory="Programming Practice") fun overly_nested_control_structures(node, n: int = 3, loops_only = false) = + |" Flag each control structure whose nesting level exceeds the value provided + |" in the rule parameter. + |" + |" The control structures checked are the following: + |" + |" * ``if`` statement + |" * ``case`` statement + |" * ``loop`` statement + |" * selective accept statement + |" * timed entry call statement + |" * conditional entry call statement + |" * asynchronous select statement + |" + |" The rule has the following (optional) parameters for the ``+R`` option and for + |" LKQL rule options files: + |" + |" *N: int* + |" Positive integer specifying the maximal control structure nesting + |" level that is not flagged. Defaults to 3 if not specified. + |" + |" *Loops_Only: bool* + |" If ``true``, only loop statements are counted. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 6 + |" + |" if I > 0 then + |" for Idx in I .. J loop + |" if J < 0 then + |" case I is + |" when 1 => + |" if Idx /= 0 then -- FLAG (if rule parameter is 3) + |" J := J / Idx; + |" end if; + |" when others => + |" J := J + Idx; + |" end case; + |" end if; + |" end loop; + |" end if; if loops_only then node is BaseLoopStmt when check_loop_parent(node.parent, n) else node is (IfStmt | CaseStmt | BaseLoopStmt | SelectStmt) diff --git a/lkql_checker/share/lkql/overly_nested_scopes.lkql b/lkql_checker/share/lkql/overly_nested_scopes.lkql index e9f1abc9d..475c661e9 100644 --- a/lkql_checker/share/lkql/overly_nested_scopes.lkql +++ b/lkql_checker/share/lkql/overly_nested_scopes.lkql @@ -1,13 +1,3 @@ -# Flag each declarative construct whose nesting level exceeds the value -# provided in the rule parameter n. -# The declaration constructs checked are the following: -# - package decl and body -# - subprogram decl and body -# - task decl and body -# - protected decl and body -# - entry body -# - blocks - fun check_decl_parent(node, n) = |" Return true if node and its parents contain more than n decl constructs if node == null then false @@ -22,6 +12,44 @@ fun check_decl_parent(node, n) = @check(message="nesting level of scopes too deep", category="Style", subcategory="Programming Practice") fun overly_nested_scopes(node, n: int = 10) = + |" Flag a nested scope if the nesting level of this scope is more than the + |" rule parameter. The following declarations are considered as scopes by this + |" rule: + |" + |" * package and generic package declarations and bodies; + |" * subprogram and generic subprogram declarations and bodies; + |" * task type and single task declarations and bodies; + |" * protected type and single protected declarations and bodies; + |" * entry bodies; + |" * block statements; + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Non-negative integer specifying the maximal allowed depth of scope + |" constructs. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 8 + |" + |" with P; use P; + |" package Pack is + |" package Pack1 is + |" package Pack2 is + |" generic + |" package Pack_G is + |" procedure P; -- FLAG if rule parameter is 3 or less + |" + |" package Inner_Pack is -- FLAG if rule parameter is 3 or less + |" I : Integer; + |" end Inner_Pack; + |" end Pack_G; + |" end Pack2; + |" end Pack1 + |" end Pack; node is (BasePackageDecl | PackageBody | BasicSubpDecl | BaseSubpBody | TaskTypeDecl | SingleTaskDecl | TaskBody | ProtectedTypeDecl | SingleProtectedDecl | ProtectedBody | diff --git a/lkql_checker/share/lkql/parameters_aliasing.lkql b/lkql_checker/share/lkql/parameters_aliasing.lkql index c720ced4d..15560dad6 100644 --- a/lkql_checker/share/lkql/parameters_aliasing.lkql +++ b/lkql_checker/share/lkql/parameters_aliasing.lkql @@ -1,11 +1,3 @@ -# Flag occurrences of calls where it is guaranteed that the same variable is -# given as an actual to more than one `[in] out` parameter. If `in_parameters` -# is true, aliasing between `[in] out` and `in` parameters is also considered, -# unless the `in` parameter is a by-copy type (full view is a non aliased -# elementary type). -# Note that this rule will also consider partial aliasing between a record -# variable and one of its components, and follows renamings. - import stdlib fun can_eval_as_int(expr) = @@ -135,11 +127,45 @@ fun param_image(params, in_parameters, canonical_indexes = false) = { @unit_check(help="parameter aliasing", category="Style", subcategory="Programming Practice") -fun parameters_aliasing(unit, in_parameters = false) = [ - {message: "parameter aliasing between " & - param_image(n.parent.p_call_params(), in_parameters), - loc: n.parent} - for n in from unit.root select - AssocList(parent: call@CallExpr(p_is_call(): true)) - when params_aliasing(call.p_call_params(), in_parameters) -] +fun parameters_aliasing(unit, in_parameters = false) = + |" Flags subprogram calls for which it can be statically detected that the same + |" variable (or a variable and a subcomponent of this variable) is given as + |" an actual to more than one ``OUT`` or ``IN OUT`` parameter. The rule resolves + |" object renamings. + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *In_Parameters: bool* + |" Whether to consider aliasing between ``OUT``, ``IN OUT`` and ``IN`` + |" parameters, except for those ``IN`` parameters that are of a by-copy + |" type, see the definition of by-copy parameters in the Ada Standard. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 15 + |" + |" package Pack is + |" type Arr is array (1 .. 5) of Integer; + |" + |" type Rec is record + |" Comp : Arr; + |" end record; + |" + |" procedure Proc (P1 : in out : Rec; P2 : out Integer); + |" end Pack; + |" + |" with Pack; use Pack; + |" procedure Test (I : Integer) is + |" Var : Rec; + |" begin + |" Proc (Var, Var.Comp (I)); -- FLAG + [ + {message: "parameter aliasing between " & + param_image(n.parent.p_call_params(), in_parameters), + loc: n.parent} + for n in from unit.root select + AssocList(parent: call@CallExpr(p_is_call(): true)) + when params_aliasing(call.p_call_params(), in_parameters) + ] diff --git a/lkql_checker/share/lkql/parameters_out_of_order.lkql b/lkql_checker/share/lkql/parameters_out_of_order.lkql index bc4d7ef61..0c6fffc4c 100644 --- a/lkql_checker/share/lkql/parameters_out_of_order.lkql +++ b/lkql_checker/share/lkql/parameters_out_of_order.lkql @@ -1,13 +1,3 @@ -# Flag each formal parameter not ordered according to the specified scheme -# among the following categories: -# - in parameters -# - access parameters -# - in out parameters -# - out parameters -# - in parameters with default initialization expressions -# -# The `order` parameter defines the order required. - fun index(order, str) = [n for n in [1, 2, 3, 4, 5] if order[n] == str].to_list[1] @@ -27,6 +17,40 @@ fun priority(spec, order) = fun parameters_out_of_order(node, order = ["in", "access", "in_out", "out", "defaulted_in"]) = + |" Flag each parameter specification if it does not follow the required + |" ordering of parameter specifications in a formal part. The required + |" order may be specified by the following rule parameters: + |" + |" *in* + |" ``in`` non-access parameters without initialization expressions; + |" + |" *access* + |" ``access`` parameters without initialization expressions; + |" + |" *in_out* + |" ``in out`` parameters; + |" + |" *out* + |" ``out`` parameters; + |" + |" *defaulted_in* + |" parameters with initialization expressions (the order of ``access`` + |" and non-access parameters is not checked. + |" + |" When the rule is used with parameters, all the five parameters should + |" be given, and each parameter should be specified only once. + |" + |" The rule can be called without parameters, in this case it checks the + |" default ordering that corresponds to the order in which the + |" rule parameters are listed above. + |" + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" procedure Proc1 (I : in out Integer; B : Boolean) is -- FLAG node is ParamSpec(any parent(depth=3): not EntryCompletionFormalParams) when ({ val prio = priority(node, order); diff --git a/lkql_checker/share/lkql/pos_on_enumeration_types.lkql b/lkql_checker/share/lkql/pos_on_enumeration_types.lkql index 12ee228d4..4da083149 100644 --- a/lkql_checker/share/lkql/pos_on_enumeration_types.lkql +++ b/lkql_checker/share/lkql/pos_on_enumeration_types.lkql @@ -1,9 +1,24 @@ -# Flag 'Pos attribute in case if the attribute prefix has an enumeration type -# (including types derived from enumeration types). - @check(message="prefix of 'POS attribute has enumeration type", - category="Style", subcategory="Programming Practice") + category="Style", subcategory="Programming Practice", + rule_name="POS_On_Enumeration_Types") fun pos_on_enumeration_types(node) = + |" Flag ``'Pos`` attribute in case if the attribute prefix has an enumeration + |" type (including types derived from enumeration types). + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3, 5, 7 + |" + |" procedure Bar (Ch1, Ch2 : Character; I : in out Integer) is + |" begin + |" if Ch1'Pos in 32 .. 126 -- FLAG + |" and then + |" Ch2'Pos not in 0 .. 31 -- FLAG + |" then + |" I := (Ch1'Pos + Ch2'Pos) / 2; -- FLAG (twice) + |" end if; + |" end Bar; node is AttributeRef when node.f_attribute?.p_name_is("Pos") and node.f_prefix?.p_referenced_decl() is t@BaseTypeDecl diff --git a/lkql_checker/share/lkql/positional_actuals_for_defaulted_generic_parameters.lkql b/lkql_checker/share/lkql/positional_actuals_for_defaulted_generic_parameters.lkql index 914c55720..a55e1ddcd 100644 --- a/lkql_checker/share/lkql/positional_actuals_for_defaulted_generic_parameters.lkql +++ b/lkql_checker/share/lkql/positional_actuals_for_defaulted_generic_parameters.lkql @@ -1,6 +1,3 @@ -# Flag each generic actual parameter corresponding to a generic formal -# parameter with a default initialization, if positional notation is used. - import stdlib fun get_formal(decls, pos, n: int = 1) = @@ -22,6 +19,41 @@ fun check_generic(n, node) = @check(message="use named notation when passing actual to defaulted generic parameter", remediation="EASY", category="Style", subcategory="Programming Practice") fun positional_actuals_for_defaulted_generic_parameters(node) = + |" Flag each generic actual parameter corresponding to a generic formal + |" parameter with a default initialization, if positional notation is used. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 23-25 + |" + |" package Foo is + |" function Fun_1 (I : Integer) return Integer; + |" function Fun_2 (I : Integer) return Integer; + |" + |" generic + |" I_Par1 : Integer; + |" I_Par2 : Integer := 1; + |" with function Fun_1 (I : Integer) return Integer is <>; + |" with function Fun_3 (I : Integer) return Integer is Fun_2; + |" package Pack_G is + |" Var_1 : Integer := I_Par1; + |" Var_2 : Integer := I_Par2; + |" Var_3 : Integer := Fun_1 (Var_1); + |" Var_4 : Integer := Fun_3 (Var_2); + |" end Pack_G; + |" + |" package Pack_I_1 is new Pack_G (1); + |" + |" package Pact_I_2 is new Pack_G + |" (2, I_Par2 => 3, Fun_1 => Fun_2, Fun_3 => Fun_1); + |" + |" package Pack_I_3 is new Pack_G (1, + |" 2, -- FLAG + |" Fun_2, -- FLAG + |" Fun_1); -- FLAG + |" + |" end Foo; node is ParamAssoc(f_designator: null, parent: l@AssocList) when match l.parent | p@GenericSubpInstantiation => diff --git a/lkql_checker/share/lkql/positional_actuals_for_defaulted_parameters.lkql b/lkql_checker/share/lkql/positional_actuals_for_defaulted_parameters.lkql index 39a36ec33..6e88dd7ec 100644 --- a/lkql_checker/share/lkql/positional_actuals_for_defaulted_parameters.lkql +++ b/lkql_checker/share/lkql/positional_actuals_for_defaulted_parameters.lkql @@ -1,7 +1,3 @@ -# Flag each actual parameter to a subprogram or entry call where the -# corresponding formal parameter has a default expression, if positional -# notation is used. - import stdlib fun get_param_spec(params, pos, n: int = 1) = { @@ -24,5 +20,21 @@ fun check_actual(spec, node) = @check(message="use named notation when passing actual to defaulted parameter", remediation="EASY", category="Style", subcategory="Programming Practice") fun positional_actuals_for_defaulted_parameters(node) = + |" Flag each actual parameter to a subprogram or entry call where the + |" corresponding formal parameter has a default expression, if positional + |" notation is used. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 7 + |" + |" procedure Proc (I : in out Integer; J : Integer := 0) is + |" begin + |" I := I + J; + |" end Proc; + |" + |" begin + |" Proc (Var1, Var2); -- FLAG node is ParamAssoc(f_designator: null, parent: l@AssocList) when l.parent is c@CallExpr when check_actual(c.p_called_subp_spec(), node) diff --git a/lkql_checker/share/lkql/positional_components.lkql b/lkql_checker/share/lkql/positional_components.lkql index 92dd9450d..21bc19e06 100644 --- a/lkql_checker/share/lkql/positional_components.lkql +++ b/lkql_checker/share/lkql/positional_components.lkql @@ -1,12 +1,33 @@ -# Flag each array, record and extension aggregate that includes positional -# notation. - fun is_array_or_record(n) = n is BaseTypeDecl when n?.p_is_array_type() or n?.p_is_record_type() @check(message="aggregate with a positional component association", remediation="EASY", category="Style", subcategory="Programming Practice") fun positional_components(node) = + |" Flag each array, record and extension aggregate that includes positional + |" notation. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 11, 12, 15 + |" + |" package Foo is + |" type Arr is array (1 .. 10) of Integer; + |" + |" type Rec is record + |" C_Int : Integer; + |" C_Bool : Boolean; + |" C_Char : Character; + |" end record; + |" + |" Var_Rec_1 : Rec := (C_Int => 1, C_Bool => True, C_Char => 'a'); + |" Var_Rec_2 : Rec := (2, C_Bool => False, C_Char => 'b'); -- FLAG + |" Var_Rec_3 : Rec := (1, True, 'c'); -- FLAG + |" + |" Var_Arr_1 : Arr := (1 => 1, others => 10); + |" Var_Arr_2 : Arr := (1, others => 10); -- FLAG + |" end Foo; node is Aggregate(f_assocs: *(any children(depth=2): a@AlternativesList when not a[1])) when is_array_or_record(node.p_expression_type()) diff --git a/lkql_checker/share/lkql/positional_generic_parameters.lkql b/lkql_checker/share/lkql/positional_generic_parameters.lkql index 14c4cc833..6b8585edf 100644 --- a/lkql_checker/share/lkql/positional_generic_parameters.lkql +++ b/lkql_checker/share/lkql/positional_generic_parameters.lkql @@ -1,6 +1,3 @@ -# Flag each positional actual generic parameter except for the case when the -# generic unit being instantiated has exactly one generic formal parameter. - fun check_generic(n) = |" Return true if the generic decl corresponding to n contains more than 1 |" formal parameter. @@ -13,6 +10,27 @@ fun check_generic(n) = @check(message="positional generic association", remediation="EASY", category="Style", subcategory="Programming Practice") fun positional_generic_parameters(node) = + |" Flag each positional actual generic parameter except for the case when + |" the generic unit being instantiated has exactly one generic formal + |" parameter. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 10 + |" + |" with Ada.Text_IO; use Ada.Text_IO; + |" with Ada.Unchecked_Conversion; + |" procedure Bar (I : in out Integer) is + |" type My_Int is range -12345 .. 12345; + |" + |" function To_My_Int is new Ada.Unchecked_Conversion + |" (Source => Integer, Target => My_Int); + |" + |" function To_Integer is new Ada.Unchecked_Conversion + |" (My_Int, Integer); -- FLAG (twice) + |" + |" package My_Int_IO is new Ada.Text_IO.Integer_IO (My_Int); node is ParamAssoc(f_designator: null, parent: l@AssocList(parent: g@GenericInstantiation)) when l.children_count > 1 diff --git a/lkql_checker/share/lkql/positional_parameters.lkql b/lkql_checker/share/lkql/positional_parameters.lkql index 78548d19e..51a6b8988 100644 --- a/lkql_checker/share/lkql/positional_parameters.lkql +++ b/lkql_checker/share/lkql/positional_parameters.lkql @@ -1,18 +1,3 @@ -# Flag each positional parameter notation in a subprogram or entry call, except -# for the following: -# - Parameters of calls to attribute subprograms are not flagged; -# - Parameters of prefix or infix calls to operator functions are not flagged; -# - If the called subprogram or entry has only one formal parameter, the -# parameter of the call is not flagged; -# - If a subprogram call uses the Object.Operation notation, then -# - the first parameter (that is, Object) is not flagged; -# - if the called subprogram has only two parameters, the second parameter of -# the call is not flagged; -# This rule has the parameter All: if this parameter is specified, all the -# positional parameter associations that can be replaced with named -# associations according to language rules are flagged, except parameters of -# the calls to operator functions. - fun check_actual_param(spec, node, check_dot) = match spec | SubpSpec => { @@ -26,6 +11,55 @@ fun check_actual_param(spec, node, check_dot) = @check(message="positional parameter association", remediation="EASY", category="Style", subcategory="Programming Practice") fun positional_parameters(node, all=false) = + |" Flag each positional parameter notation in a subprogram or entry call, + |" except for the following: + |" + |" * Parameters of calls to attribute subprograms are not flagged; + |" * Parameters of prefix or infix calls to operator functions are not flagged; + |" * If the called subprogram or entry has only one formal parameter, + |" the parameter of the call is not flagged; + |" * If a subprogram call uses the *Object.Operation* notation, then + |" * the first parameter (that is, *Object*) is not flagged; + |" + |" * if the called subprogram has only two parameters, the second parameter + |" of the call is not flagged; + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *All: bool* + |" If ``true``, all the positional parameter associations that can be replaced + |" with named associations according to language rules are flagged, except + |" parameters of the calls to operator functions. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 17, 21 + |" + |" procedure Bar (I : in out Integer) is + |" function My_Max (Left, Right : Integer) return Integer renames Integer'Max; + |" + |" procedure Proc1 (I : in out Integer) is + |" begin + |" I := I + 1; + |" end Proc1; + |" + |" procedure Proc2 (I, J : in out Integer) is + |" begin + |" I := I + J; + |" end Proc2; + |" + |" L, M : Integer := 1; + |" begin + |" Proc1 (L); + |" Proc2 (L, M); -- FLAG (twice) + |" Proc2 (I => M, J => L); + |" + |" L := Integer'Max (10, M); + |" M := My_Max (100, Right => L); -- FLAG + |" + |" end Bar; node is ParamAssoc(f_designator: null, parent: l@AssocList) when l.parent is c@CallExpr( p_is_call(): true, diff --git a/lkql_checker/share/lkql/potential_parameters_aliasing.lkql b/lkql_checker/share/lkql/potential_parameters_aliasing.lkql index 70cf6061e..3c6b7a3cc 100644 --- a/lkql_checker/share/lkql/potential_parameters_aliasing.lkql +++ b/lkql_checker/share/lkql/potential_parameters_aliasing.lkql @@ -1,23 +1,49 @@ -# Complement of Parameters_Aliasing: only flag occurrences of additional -# potential aliasing, namely when at least one array indexing and another -# component may be potential aliases. Also take into account the -# `in_parameters` parameter. -# Note that this rule will also consider partial aliasing between a record -# variable and one of its components, and follows renamings. - import stdlib import parameters_aliasing @unit_check(help="potential parameter aliasing", category="Style", subcategory="Programming Practice") -fun potential_parameters_aliasing(unit, in_parameters = false) = [ - {message: "potential parameter aliasing between " & - parameters_aliasing.param_image( - n.parent.p_call_params(), in_parameters, - canonical_indexes=true), - loc: n.parent} - for n in from unit.root select - AssocList(parent: call@CallExpr(p_is_call(): true)) - when parameters_aliasing.params_aliasing( - call.p_call_params(), in_parameters, canonical_indexes=true) -] +fun potential_parameters_aliasing(unit, in_parameters = false) = + |" This rule is a complementary rule for the *Parameters_Aliasing* rule - + |" it flags subprogram calls where the same variable (or a variable and its + |" subcomponent) is given as an actual to more than one ``OUT`` or ``IN OUT`` + |" parameter, but the fact of aliasing cannot be determined statically because + |" this variable is an array component, and the index value(s) is(are) not + |" known statically. The rule resolves object renamings. + |" + |" Note that this rule does not flag calls that are flagged by the + |" *Parameters_Aliasing* rule and vice versa. + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *In_Parameters: bool* + |" Whether to consider aliasing between ``OUT``, ``IN OUT`` and ``IN`` + |" parameters, except for those ``IN`` parameters that are of a by-copy + |" type, see the definition of by-copy parameters in the Ada Standard. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 9 + |" + |" package Pack is + |" procedure Proc (P1 : out Integer; P2 : in out Integer); + |" type Arr is array (1 .. 10 ) of Integer; + |" end Pack; + |" + |" with Pack; use Pack; + |" procedure Proc (X : in out Arr; I, J : Integer) is + |" begin + |" Proc (X (I), X (J)); -- FLAG + [ + {message: "potential parameter aliasing between " & + parameters_aliasing.param_image( + n.parent.p_call_params(), in_parameters, + canonical_indexes=true), + loc: n.parent} + for n in from unit.root select + AssocList(parent: call@CallExpr(p_is_call(): true)) + when parameters_aliasing.params_aliasing( + call.p_call_params(), in_parameters, canonical_indexes=true) + ] diff --git a/lkql_checker/share/lkql/predefined_numeric_types.lkql b/lkql_checker/share/lkql/predefined_numeric_types.lkql index 42ca3a932..d31021717 100644 --- a/lkql_checker/share/lkql/predefined_numeric_types.lkql +++ b/lkql_checker/share/lkql/predefined_numeric_types.lkql @@ -1,10 +1,47 @@ -# Flag each explicit use of the name of any numeric type or subtype declared in -# package Standard. - import stdlib @check(message="explicit reference to predefined numeric subtype", category="Style", subcategory="Portability") fun predefined_numeric_types(node) = + |" Flag each explicit use of the name of any numeric type or subtype declared + |" in package ``Standard``. + |" + |" The rationale for this rule is to detect when the + |" program may depend on platform-specific characteristics of the implementation + |" of the predefined numeric types. Note that this rule is overly pessimistic; + |" for example, a program that uses ``String`` indexing + |" likely needs a variable of type ``Integer``. + |" Another example is the flagging of predefined numeric types with explicit + |" constraints: + |" + |" .. code-block:: ada + |" + |" subtype My_Integer is Integer range Left .. Right; + |" Vy_Var : My_Integer; + |" + |" + |" This rule detects only numeric types and subtypes declared in package + |" ``Standard``. The use of numeric types and subtypes declared in other + |" predefined packages (such as ``System.Any_Priority`` or + |" ``Ada.Text_IO.Count``) is not flagged + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2, 3, 6, 9 + |" + |" package Foo is + |" I : Integer; -- FLAG + |" F : Float; -- FLAG + |" B : Boolean; + |" + |" type Arr is array (1 .. 5) of Short_Float; -- FLAG + |" + |" type Res is record + |" C1 : Long_Integer; -- FLAG + |" C2 : Character; + |" end record; + |" + |" end Foo; node is Identifier(p_referenced_decl(): t@BaseTypeDecl when stdlib.is_standard_numeric(t.p_canonical_fully_qualified_name())) diff --git a/lkql_checker/share/lkql/predicate_testing.lkql b/lkql_checker/share/lkql/predicate_testing.lkql index 01379afb6..f27f93a52 100644 --- a/lkql_checker/share/lkql/predicate_testing.lkql +++ b/lkql_checker/share/lkql/predicate_testing.lkql @@ -1,11 +1,3 @@ -# Flag a membership test if at least one of its membership choice contains a -# subtype mark denoting a subtype defined with (static or dynamic) -# subtype predicate. -# Flags 'Valid attribute reference if the nominal subtype of the attribute -# prefix has (static or dynamic) subtype predicate. -# This rule has the parameter Except_Assertions: Do not flag a construct -# described above if it is a subcomponent of the following constructs[...] - import stdlib # Return true if t represents a SubtypeDecl with a predicate (directly or via @@ -22,6 +14,55 @@ fun has_predicate(t) = @check(message="expression needs subtype predicate evaluation", category="Feature") fun predicate_testing(node, except_assertions=false) = + |" Flag a membership test if at least one of its membership choice contains a + |" subtype mark denoting a subtype defined with (static or dynamic) + |" subtype predicate. + |" + |" Flags 'Valid attribute reference if the nominal subtype of the attribute + |" prefix has (static or dynamic) subtype predicate. + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *Except_Assertions: bool* + |" If ``true``, do not flag the use of non-short-circuit_operators inside + |" assertion-related pragmas or aspect specifications. + |" + |" A pragma or an aspect is considered as assertion-related if its name + |" is from the following list: + |" + |" * ``Assert`` + |" * ``Assert_And_Cut`` + |" * ``Assume`` + |" * ``Contract_Cases`` + |" * ``Debug`` + |" * ``Default_Initial_Condition`` + |" * ``Dynamic_Predicate`` + |" * ``Invariant`` + |" * ``Loop_Invariant`` + |" * ``Loop_Variant`` + |" * ``Post`` + |" * ``Postcondition`` + |" * ``Pre`` + |" * ``Precondition`` + |" * ``Predicate`` + |" * ``Predicate_Failure`` + |" * ``Refined_Post`` + |" * ``Static_Predicate`` + |" * ``Type_Invariant`` + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 7 + |" + |" with Support; use Support; + |" package Pack is + |" subtype Even is Integer with Dynamic_Predicate => Even mod 2 = 0; + |" + |" subtype Small_Even is Even range -100 .. 100; + |" + |" B1 : Boolean := Ident (101) in Small_Even; -- FLAG (match node # Flags a subtype mark[...] used as a membership choice | MembershipExpr => diff --git a/lkql_checker/share/lkql/printable_ascii.lkql b/lkql_checker/share/lkql/printable_ascii.lkql index 4a613f808..e90104a3f 100644 --- a/lkql_checker/share/lkql/printable_ascii.lkql +++ b/lkql_checker/share/lkql/printable_ascii.lkql @@ -1,13 +1,14 @@ -# Flag source code text characters that are not part of the printable ASCII -# character set, a line feed, or a carriage return character (i.e. values 10, -# 13 and 32 .. 126 of the ASCII Character set). - @unit_check(help="non-printable characters", remediation="EASY", - category="Style", subcategory="Portability") -fun printable_ascii(unit) = [ - {message: "non printable ASCII character", loc: tok} - for tok in unit.tokens - if match tok.text - | "[^\r\n -~]" => true - | * => false -] + category="Style", subcategory="Portability", + rule_name="Printable_ASCII") +fun printable_ascii(unit) = + |" Flag source code text characters that are not part of the printable + |" ASCII character set, a line feed, or a carriage return character (i.e. + |" values 10, 13 and 32 .. 126 of the ASCII Character set). + [ + {message: "non printable ASCII character", loc: tok} + for tok in unit.tokens + if match tok.text + | "[^\r\n -~]" => true + | * => false + ] diff --git a/lkql_checker/share/lkql/profile_discrepancies.lkql b/lkql_checker/share/lkql/profile_discrepancies.lkql index d1a6d63a6..6dd14d9e0 100644 --- a/lkql_checker/share/lkql/profile_discrepancies.lkql +++ b/lkql_checker/share/lkql/profile_discrepancies.lkql @@ -1,7 +1,3 @@ -# Flag subprogram or entry body (or body stub) if its parameter (or parameter -# and result) profile does not follow the lexical structure of the profile in -# the corresponding subprogram or entry declaration. - import stdlib # Return true if the two lists l1 and l2 have identical names @@ -48,13 +44,32 @@ fun entry_mismatch(e) = { @unit_check(help="parameter profile discrepancies", category="Style", subcategory="Readability") -fun profile_discrepancies(unit) = [ - {message: "structure of parameter profile differs from " & - stdlib.sloc_image(n.p_decl_part()), - loc: n.p_defining_name()} - for n in from unit.root select node@((BaseSubpBody | SubpBodyStub) - when match node.p_decl_part() - | g@GenericSubpDecl => subp_mismatch(node, g?.f_subp_decl) - | s@BasicSubpDecl => subp_mismatch(node, s) - | * => false - | EntryBody when entry_mismatch(node))] +fun profile_discrepancies(unit) = + |" Flag subprogram or entry body (or body stub) if its parameter (or + |" parameter and result) profile does not follow the lexical structure + |" of the profile in the corresponding subprogram or entry declaration. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 8 + |" + |" package Pack is + |" procedure Proc + |" (I : Integer; + |" J : Integer); + |" end Pack; + |" + |" package body Pack is + |" procedure Proc (I, J : Integer) is -- FLAG + [ + {message: "structure of parameter profile differs from " & + stdlib.sloc_image(n.p_decl_part()), + loc: n.p_defining_name()} + for n in from unit.root select node@((BaseSubpBody | SubpBodyStub) + when match node.p_decl_part() + | g@GenericSubpDecl => subp_mismatch(node, g?.f_subp_decl) + | s@BasicSubpDecl => subp_mismatch(node, s) + | * => false + | EntryBody when entry_mismatch(node)) + ] diff --git a/lkql_checker/share/lkql/quantified_expressions.lkql b/lkql_checker/share/lkql/quantified_expressions.lkql index b30aeee0d..f105cbe21 100644 --- a/lkql_checker/share/lkql/quantified_expressions.lkql +++ b/lkql_checker/share/lkql/quantified_expressions.lkql @@ -1,10 +1,67 @@ -# Flag use of quantified expression. -# This rule has the parameter Except_Assertions: Do not flag a quantified -# expression if it is a subcomponent of the following constructs[...] - import stdlib @check(message="quantified expression", category="Feature") fun quantified_expressions(node, except_assertions=false) = + |" Flag use of quantified expression. + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *Except_Assertions: bool* + |" If ``true``, do not flag a conditional expression if it is a subcomponent + |" of the following constructs: + |" + |" *argument of the following pragmas* + |" + |" *Language-defined* + |" + |" * ``Assert`` + |" + |" *GNAT-specific* + |" + |" * ``Assert_And_Cut`` + |" * ``Assume`` + |" * ``Contract_Cases`` + |" * ``Debug`` + |" * ``Invariant`` + |" * ``Loop_Invariant`` + |" * ``Loop_Variant`` + |" * ``Postcondition`` + |" * ``Precondition`` + |" * ``Predicate`` + |" * ``Refined_Post`` + |" + |" *definition of the following aspects* + |" + |" *Language-defined* + |" + |" * ``Static_Predicate`` + |" * ``Dynamic_Predicate`` + |" * ``Pre`` + |" * ``Pre'Class`` + |" * ``Post`` + |" * ``Post'Class`` + |" * ``Type_Invariant`` + |" * ``Type_Invariant'Class`` + |" + |" *GNAT-specific* + |" + |" * ``Contract_Cases`` + |" * ``Invariant`` + |" * ``Invariant'Class`` + |" * ``Predicate`` + |" * ``Refined_Post`` + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5, 6 + |" + |" subtype Ind is Integer range 1 .. 10; + |" type Matrix is array (Ind, Ind) of Integer; + |" + |" function Check_Matrix (M : Matrix) return Boolean is + |" (for some I in Ind => -- FLAG + |" (for all J in Ind => M (I, J) = 0)); -- FLAG node is QuantifiedExpr when not (except_assertions and stdlib.within_assert(node)) diff --git a/lkql_checker/share/lkql/raising_external_exceptions.lkql b/lkql_checker/share/lkql/raising_external_exceptions.lkql index be367f772..c77802b63 100644 --- a/lkql_checker/share/lkql/raising_external_exceptions.lkql +++ b/lkql_checker/share/lkql/raising_external_exceptions.lkql @@ -1,8 +1,3 @@ -# Flag any raise statement, in a program unit declared in a library package or -# in a generic library package, for an exception that is neither a predefined -# exception nor an exception that is also declared (or renamed) in the visible -# part of the package. - # TODO: share is_predefined_exception with raising_predefined_exception fun is_predefined_exception(e) = { val name = e.p_defining_name().p_canonical_fully_qualified_name(); @@ -22,6 +17,33 @@ fun check_raise(n, lib) = { @check(message="raised exception is not declared in visible part of enclosing library package", category="Style", subcategory="Program Structure") fun raising_external_exceptions(node) = + |" Flag any ``raise`` statement, in a program unit declared in a library + |" package or in a generic library package, for an exception that is + |" neither a predefined exception nor an exception that is also declared (or + |" renamed) in the visible part of the package. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 12 + |" + |" package Exception_Declarations is + |" Ex : exception; + |" end Exception_Declarations; + |" package Foo is + |" procedure Proc (I : in out Integer); + |" end Foo; + |" with Exception_Declarations; + |" package body Foo is + |" procedure Proc (I : in out Integer) is + |" begin + |" if I < 0 then + |" raise Exception_Declarations.Ex; -- FLAG + |" else + |" I := I - 1; + |" end if; + |" end Proc; + |" end Foo; node is RaiseStmt(f_exception_name: Name, any parent: lib@LibraryItem when match lib.f_item | BasePackageDecl => check_raise(node, lib) diff --git a/lkql_checker/share/lkql/raising_predefined_exceptions.lkql b/lkql_checker/share/lkql/raising_predefined_exceptions.lkql index c214e59ed..187032849 100644 --- a/lkql_checker/share/lkql/raising_predefined_exceptions.lkql +++ b/lkql_checker/share/lkql/raising_predefined_exceptions.lkql @@ -1,7 +1,3 @@ -# Flag each raise statement that raises a predefined exception (i.e., one -# of the exceptions Constraint_Error, Numeric_Error, Program_Error, -# Storage_Error, or Tasking_Error). - fun is_predefined_raise(id) = id.p_referenced_decl() is decl@BasicDecl when match decl.p_defining_name().p_canonical_fully_qualified_name() @@ -18,5 +14,16 @@ fun canonical_exception_name(name) = { @check(message="explicit raise of a predefined exception", category="Feature") fun raising_predefined_exceptions(node) = + |" Flag each ``raise`` statement that raises a predefined exception + |" (i.e., one of the exceptions ``Constraint_Error``, ``Numeric_Error``, + |" ``Program_Error``, ``Storage_Error``, or ``Tasking_Error``). + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" begin + |" raise Constraint_Error; -- FLAG node is RaiseStmt(f_exception_name: exc@Name) when is_predefined_raise(canonical_exception_name(exc)) diff --git a/lkql_checker/share/lkql/recursive_subprograms.lkql b/lkql_checker/share/lkql/recursive_subprograms.lkql index 1571908be..6c0ac368a 100644 --- a/lkql_checker/share/lkql/recursive_subprograms.lkql +++ b/lkql_checker/share/lkql/recursive_subprograms.lkql @@ -1,25 +1,3 @@ -# Flags specs (and bodies that act as specs) of recursive subprograms. A -# subprogram is considered as recursive in a given context if there exists a -# chain of direct calls starting from the body of, and ending at this -# subprogram within this context. A context is provided by the set of Ada -# sources specified as arguments of a given gnatcheck call. Neither dispatching -# calls nor calls through access-to-subprograms are considered as direct calls -# by this rule. If Follow_Dispatching_Calls is set, gnatcheck considers a -# dispatching call as a set of calls to all the subprograms the dispatching -# call may dispatch to, otherwise dispatching calls are ignored. As a -# limitation, primitive operations declared in generic instantiations are not -# taken into account. -# -# This rule does not take into account calls that may happen as the result of -# subprogram import or more generally unavailable subprogram bodies. See rule -# Unavailable_Body_Calls to detect these cases. -# -# Generic subprograms and subprograms detected in generic units are not flagged. -# Recursive subprograms in expanded generic instantiations are flagged. -# -# This rule does not take into account subprogram calls in aspect definitions -# nor implicit calls made via type initialization. - import stdlib fun get_body(node) = @@ -85,7 +63,63 @@ fun recursive_subprograms(node, skip_dispatching_calls=true, follow_dispatching_calls=false, follow_ghost_code=false) = - + |" Flags specs (and bodies that act as specs) of recursive subprograms. A + |" subprogram is considered as recursive in a given context if there exists + |" a chain of direct calls starting from the body of, and ending at + |" this subprogram within this context. A context is provided by the set + |" of Ada sources specified as arguments of a given ``gnatcheck`` call. + |" Neither dispatching calls nor calls through access-to-subprograms + |" are considered as direct calls by this rule. If *Follow_Dispatching_Calls* + |" rule parameter is set, ``gnatcheck`` considers a dispatching call as a set + |" of calls to all the subprograms the dispatching call may dispatch to, + |" otherwise dispatching calls are ignored. The current rule limitation is + |" that when processing dispatching calls the rule does not take into account + |" type primitive operations declared in generic instantiations. + |" + |" This rule does not take into account calls to subprograms whose + |" bodies are not available because of any reason (a subprogram is imported, + |" the Ada source containing the body is not provided as ``gnatcheck`` + |" argument source etc.). The *Unavailable_Body_Calls* rule can be used to + |" detect these cases. + |" + |" Generic subprograms and subprograms detected in generic units are not + |" flagged. Recursive subprograms in generic instantiations + |" are flagged. + |" + |" Ghost code and assertion code such as pre & post conditions or code inside of + |" `pragma Assert` is not flagged either by default. + |" + |" The rule does not take into account implicit calls that are the + |" result of computing default initial values for an object or a subcomponent + |" thereof as a part of the elaboration of an object declaration. + |" + |" The rule also does not take into account subprogram calls inside + |" aspect definitions. + |" + |" The rule has an optional parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Follow_Dispatching_Calls: bool* + |" Whether to treat a dispatching call as a set of calls to all the subprograms + |" the dispatching call may dispatch to. + |" + |" *Follow_Ghost_Code: bool* + |" Whether to analyze ghost code and assertion code, which isn't analyzed by + |" this check by default. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" function Factorial (N : Natural) return Positive is -- FLAG + |" begin + |" if N = 0 then + |" return 1; + |" else + |" return N * Factorial (N - 1); + |" end if; + |" end Factorial; node is (ClassicSubpDecl | SubpBodyStub(p_previous_part(): null) | BaseSubpBody(p_previous_part(): null | GenericSubpDecl)) diff --git a/lkql_checker/share/lkql/redundant_boolean_expressions.lkql b/lkql_checker/share/lkql/redundant_boolean_expressions.lkql index 942f74c62..c08aa5e6a 100644 --- a/lkql_checker/share/lkql/redundant_boolean_expressions.lkql +++ b/lkql_checker/share/lkql/redundant_boolean_expressions.lkql @@ -1,13 +1,3 @@ -# Flag each occurrence of the following constructs: -# - If statements with only then/else branches, no elsif, and each branch -# is a single statement, either an assignment on the same destination, or a -# return, of Standard.True on one branch and Standard.False on the other -# branch. -# - If expressions with only then/else branches, when one path expresion is -# Standard.True and the other is Standard.False. -# - infix predefined (in)equality against Standard.True/False. -# - infix predefined "not" operators whose argument is a predefined comparison. - import stdlib fun true_and_false(left, right) = @@ -30,6 +20,43 @@ fun check_then_else(then_stmt, else_stmt) = @check(message="redundant boolean expression", category="Style", subcategory="Programming Practice") fun redundant_boolean_expressions(node) = + |" Flag constructs including boolean operations that can be simplified. The + |" following constructs are flagged: + |" + |" * ``if`` statements that have ``if`` and ``else`` paths (and no ``elsif`` path) if + |" both paths contain a single statement that is either: + |" + |" * an assignment to the same variable of ``True`` in one path and ``False`` + |" in the other path + |" + |" * a return statement that in one path returns ``True`` and in the other + |" path ``False`` + |" + |" where ``True`` and ``False`` are literals of the type ``Standard.Boolean`` + |" or any type derived from it. Note that in case of assignment statements the + |" variable names in the left part should be literally the same (case + |" insensitive); + |" + |" * ``if`` expressions that have ``if`` and ``else`` paths (without any ``elseif``) + |" if one path expression is ``True`` and the other is ``False``, where ``True`` + |" and ``False`` are literals of the ``Standard.Boolean`` type (or any type derived + |" from it). + |" * infix call to a predefined ``=`` or ``/=`` operator when the right operand + |" is ``True`` or ``False`` where ``True`` and ``False`` are literals of the type + |" ``Standard.Boolean`` or any type derived from it. + |" * infix call to a predefined ``not`` operator whose argument is an infix + |" call to a predefined ordering operator. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" if I + J > K then -- FLAG + |" return True; + |" else + |" return False; + |" end if; node is (RelationOp(f_op: op@(OpEq | OpNeq) when stdlib.is_predefined_op(op) and (node.f_right is name@Name when { diff --git a/lkql_checker/share/lkql/redundant_null_statements.lkql b/lkql_checker/share/lkql/redundant_null_statements.lkql index 4182d4d38..696887dbd 100644 --- a/lkql_checker/share/lkql/redundant_null_statements.lkql +++ b/lkql_checker/share/lkql/redundant_null_statements.lkql @@ -1,10 +1,18 @@ -# Flag each occurrence of a null statement that serve no purpose and can be -# removed. When a null statement carries a label, it is considered as serving -# a purpose. - @check(message="redundant null statement", category="Style", subcategory="Programming Practice") fun redundant_null_statements(node) = + |" Flag null statements that serve no purpose and can be removed. If a null + |" statement has a label it is not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" if I > 0 then + |" null; -- FLAG + |" pragma Assert (J > 0); + |" end if; node is NullStmt and node.previous_sibling() is not Label and (node.previous_sibling() != null or diff --git a/lkql_checker/share/lkql/relative_delay_statements.lkql b/lkql_checker/share/lkql/relative_delay_statements.lkql index d5c138db7..ff3cd3940 100644 --- a/lkql_checker/share/lkql/relative_delay_statements.lkql +++ b/lkql_checker/share/lkql/relative_delay_statements.lkql @@ -1,6 +1,16 @@ -# Relative delay statements are flagged. Delay until statements are not -# flagged. - @check(message="relative delay statement", category="Feature") fun relative_delay_statements(node) = - node is DelayStmt(f_has_until: UntilAbsent) + |" Relative delay statements are flagged. Delay until statements are not + |" flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4 + |" + |" if I > 0 then + |" delay until Current_Time + Big_Delay; + |" else + |" delay Small_Delay; -- FLAG + |" end if; + node is DelayStmt(f_has_until: UntilAbsent) diff --git a/lkql_checker/share/lkql/renamings.lkql b/lkql_checker/share/lkql/renamings.lkql index 850bdbcc6..1e363e22b 100644 --- a/lkql_checker/share/lkql/renamings.lkql +++ b/lkql_checker/share/lkql/renamings.lkql @@ -1,4 +1,12 @@ -# Flag renaming declarations. - @check(message="renaming declaration", category="Feature") -fun renamings(node) = node is RenamingClause +fun renamings(node) = + |" Flag renaming declarations. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" I : Integer; + |" J : Integer renames I; -- FLAG + node is RenamingClause diff --git a/lkql_checker/share/lkql/representation_specifications.lkql b/lkql_checker/share/lkql/representation_specifications.lkql index 785b46cc0..4d5d573da 100644 --- a/lkql_checker/share/lkql/representation_specifications.lkql +++ b/lkql_checker/share/lkql/representation_specifications.lkql @@ -1,9 +1,3 @@ -# Flag each record representation clause, enumeration representation clause and -# declarations with a representation aspect (including attribute clauses and -# pragmas). -# The rule has a parameter Record_Rep_Clauses_Only: Only record representation -# clauses are flagged. - selector defining_names |" Return all the defining names of this basic decl. This can be used |" instead of `any children is DefiningName...` to avoid selecting the @@ -38,14 +32,43 @@ fun has_rep_aspect(node) = has_aspect(node, "Volatile_Components") @unit_check(help="representation specification", category="Feature") -fun representation_specifications(unit, record_rep_clauses_only=false) = [ - {message: if n is BasicDecl - then "declaration with a representation aspect" - else "representation specification", - loc: n} - for n in from unit.root - select (RecordRepClause | - (EnumRepClause when not record_rep_clauses_only) | - (BasicDecl(any defining_names: dn@*(p_previous_part(): null) when has_rep_aspect(dn)) - when not record_rep_clauses_only)) -] +fun representation_specifications(unit, record_rep_clauses_only=false) = + |" Flag each record representation clause, enumeration representation + |" clause and representation attribute clause. Flag each aspect definition + |" that defines a representation aspect. Also flag any pragma that is + |" classified by the Ada Standard as a representation pragma, and the + |" definition of the corresponding aspects. + |" + |" The rule has an optional parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Record_Rep_Clauses_Only: bool* + |" If ``true``, only record representation clauses are flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5, 8, 11 + |" + |" type State is (A,M,W,P); + |" type Mode is (Fix, Dec, Exp, Signif); + |" + |" type Byte_Mask is array (0..7) of Boolean + |" with Component_Size => 1; -- FLAG + |" + |" type State_Mask is array (State) of Boolean + |" with Component_Size => 1; -- FLAG + |" + |" type Mode_Mask is array (Mode) of Boolean; + |" for Mode_Mask'Component_Size use 1; -- FLAG + [ + {message: if n is BasicDecl + then "declaration with a representation aspect" + else "representation specification", + loc: n} + for n in from unit.root + select (RecordRepClause | + (EnumRepClause when not record_rep_clauses_only) | + (BasicDecl(any defining_names: dn@*(p_previous_part(): null) when has_rep_aspect(dn)) + when not record_rep_clauses_only)) + ] diff --git a/lkql_checker/share/lkql/same_instantiations.lkql b/lkql_checker/share/lkql/same_instantiations.lkql index 5d218dd39..e66dcc056 100644 --- a/lkql_checker/share/lkql/same_instantiations.lkql +++ b/lkql_checker/share/lkql/same_instantiations.lkql @@ -1,18 +1,3 @@ -# Flag each generic package instantiation when it can be determined that it has -# the same actual parameters as another generic instantiation. -# This determination is conservative and will check for a match on: -# - integer, character, and string literals -# - identifier names other than function calls (e.g. types, variables, -# subprogram names). -# Generic packages that have no parameters are ignored. -# -# If the parameter `library_level_only` is set, only check library level -# instantiations. -# -# Note that no verification is made to check if the instantiation declares -# global variables or have non trivial elaboration code (if they do, removing -# the flagged duplicates will likely not be possible). - import stdlib fun same_exprs(e1, e2) = @@ -60,9 +45,57 @@ fun same_instance(node, library_only) = @unit_check(help="duplicate generic package instantiations (global analysis required)", category="Style", subcategory="Program Structure") fun same_instantiations(unit, library_level_only = false) = + |" Flag each generic package instantiation when it can be determined that a set of + |" the ``gnatcheck`` argument sources contains another instantiation of the same + |" generic with the same actual parameters. + |" This determination is conservative, it checks currently for the following matching + |" parameters: + |" + |" * integer, character, and string literals; + |" + |" * Ada names that denote the same entity. + |" + |" Generic packages that have no parameters are ignored. + |" + |" If some instantiation is marked by the rule, additional investigation + |" is required to decide if one of the duplicated instantiations can be + |" removed to simplify the code. In particular, the rule does not check if + |" these instantiations declare any global variable or perform some + |" non-trivial actions as a part of their elaboration. + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *Library_Level_Only: bool* + |" If ``true``, only check library level instantiations. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 10, 17 + |" + |" generic + |" type T is private; + |" X : Integer; + |" package Gen is + |" end Gen; + |" + |" with Gen; + |" + |" package Inst1 is + |" package Inst_1 is new Gen (Integer, 2); -- FLAG + |" package Inst_2 is new Gen (Integer, 3); -- NO FLAG + |" end Inst1; + |" + |" with Gen; + |" + |" package Inst2 is + |" package Inst_3 is new Gen (Integer, 2); -- FLAG + |" end Inst2; [{message: "same instantiation found at " & stdlib.sloc_image(same_instance(n, library_level_only)), loc: n} for n in from unit.root select GenericPackageInstantiation if (if library_level_only then not stdlib.has_local_scope(n)) and - same_instance(n, library_level_only)] + same_instance(n, library_level_only) + ] diff --git a/lkql_checker/share/lkql/same_logic.lkql b/lkql_checker/share/lkql/same_logic.lkql index 83c4c5113..2f1e4fb0c 100644 --- a/lkql_checker/share/lkql/same_logic.lkql +++ b/lkql_checker/share/lkql/same_logic.lkql @@ -1,6 +1,3 @@ -# Flag a chain of the same boolean operator (and, or, and then, or else) -# that contains two syntactically equivalent operands. - fun check_list(l) = [e for e in l if [f for f in l if e != f and e.same_tokens(f)]] @@ -23,15 +20,26 @@ fun message(node) = { @unit_check(help="same logic", category="Style", subcategory="Programming Practice") -fun same_logic(unit) = [ - message (n) - for n in from unit.root - select node@BinOp(f_op: op@(OpAnd | OpAndThen | OpOr | OpOrElse | - OpXor)) - when { - val kind = op.kind; - not (node.parent is p@BinOp when p.f_op.kind == kind) and - check_list(gather_ops(node, kind)) - } -] - +fun same_logic(unit) = + |" Flags expressions that contain a chain of infix calls to the same boolean + |" operator (``and``, ``or``, ``and then``, ``or else``, ``xor``) if an expression + |" contains syntactically equivalent operands. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" B := Var1 and Var2; -- NO FLAG + |" return A or else B or else A; -- FLAG + [ + message (n) + for n in from unit.root + select node@BinOp(f_op: op@(OpAnd | OpAndThen | OpOr | OpOrElse | + OpXor)) + when { + val kind = op.kind; + not (node.parent is p@BinOp when p.f_op.kind == kind) and + check_list(gather_ops(node, kind)) + } + ] diff --git a/lkql_checker/share/lkql/same_operands.lkql b/lkql_checker/share/lkql/same_operands.lkql index 33812efb3..802c8017c 100644 --- a/lkql_checker/share/lkql/same_operands.lkql +++ b/lkql_checker/share/lkql/same_operands.lkql @@ -1,10 +1,17 @@ -# Flags infix calls to binary operators /, =, /=, >, >=, <, <=, -, mod, rem -# (except when operating on floating point types) if operands of a call are -# syntactically equivalent. - @check(message="same operands", category="Style", subcategory="Programming Practice") fun same_operands(node) = + |" Flags infix calls to binary operators ``/``, ``=``, ``/=``, ``>``, ``>=``, + |" ``<``, ``<=``, ``-``, ``mod``, ``rem`` (except when operating on floating + |" point types) if operands of a call are syntactically equivalent. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" Y := (X + 1) / (X - 1); -- NO FLAG + |" Z := (X + 1) / (X + 1); -- FLAG node is BinOp(f_op: OpDiv | OpEq | OpGt | OpGte | OpLt | OpLte | OpMinus | OpMod | OpNeq | OpRem) when node.f_left.p_expression_type() is not diff --git a/lkql_checker/share/lkql/same_tests.lkql b/lkql_checker/share/lkql/same_tests.lkql index 5318d540e..c4aee2c13 100644 --- a/lkql_checker/share/lkql/same_tests.lkql +++ b/lkql_checker/share/lkql/same_tests.lkql @@ -1,6 +1,3 @@ -# Flag if statements / expressions that contain several syntactically -# equivalent conditions. - fun check_list(l) = [e for e in l if [f for f in l if e != f and e.same_tokens(f)]] @@ -16,10 +13,29 @@ fun message(node) = { @unit_check(help="same test", category="Style", subcategory="Programming Practice") -fun same_tests(unit) = [ - message(n) - for n in from unit.root select - node@(IfStmt | IfExpr) - when check_list([node.f_cond_expr] & - [n.f_cond_expr for n in node.f_alternatives.children].to_list) -] +fun same_tests(unit) = + |" Flags condition expressions in ``if`` statements or ``if`` expressions if + |" a statement or expression contains another condition expression that is + |" syntactically equivalent to the first one. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1, 5 + |" + |" if Str = A then -- FLAG: same test at line 5 + |" Put_Line("Hello, tata!"); + |" elsif Str = B then + |" Put_Line("Hello, titi!"); + |" elsif Str = A then + |" Put_Line("Hello, toto!"); + |" else + |" Put_Line("Hello, world!"); + |" end if; + [ + message(n) + for n in from unit.root select + node@(IfStmt | IfExpr) + when check_list([node.f_cond_expr] & + [n.f_cond_expr for n in node.f_alternatives.children].to_list) + ] diff --git a/lkql_checker/share/lkql/separate_numeric_error_handlers.lkql b/lkql_checker/share/lkql/separate_numeric_error_handlers.lkql index 698a16a8b..b78c10d2b 100644 --- a/lkql_checker/share/lkql/separate_numeric_error_handlers.lkql +++ b/lkql_checker/share/lkql/separate_numeric_error_handlers.lkql @@ -1,14 +1,24 @@ -# Flag each exception handler that contains a choice for the predefined -# Constraint_Error exception, but does not contain the choice for the -# predefined Numeric_Error exception, or that contains the choice for -# Numeric_Error, but does not contain the choice for Constraint_Error. - fun decl_name(n) = n.p_referenced_defining_name().p_canonical_fully_qualified_name() @check(message="Constraint_Error is handled separately from Numeric_Error", category="Style", subcategory="Portability") fun separate_numeric_error_handlers(node) = + |" Flags each exception handler that contains a choice for + |" the predefined ``Constraint_Error`` exception, but does not contain + |" the choice for the predefined ``Numeric_Error`` exception, or + |" that contains the choice for ``Numeric_Error``, but does not contain the + |" choice for ``Constraint_Error``. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" exception + |" when Constraint_Error => -- FLAG + |" Clean_Up; + |" end; node is BaseId(parent: l @ AlternativesList(parent: ExceptionHandler)) when ( decl_name(node) == "standard.constraint_error" diff --git a/lkql_checker/share/lkql/separates.lkql b/lkql_checker/share/lkql/separates.lkql index 073e8d27d..2fb439ebf 100644 --- a/lkql_checker/share/lkql/separates.lkql +++ b/lkql_checker/share/lkql/separates.lkql @@ -1,4 +1,22 @@ -# Flag each occurrence of a separate unit - @check(message="separate unit", category="Feature") -fun separates(node) = node is Subunit +fun separates(node) = + |" Flags subunits. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 7 + |" + |" package body P is + |" + |" procedure Sep is separate; + |" + |" end P; + |" + |" separate(P) -- FLAG + |" procedure Sep is + |" procedure Q is separate; + |" begin + |" null; + |" end Sep; + node is Subunit diff --git a/lkql_checker/share/lkql/side_effect_parameters.lkql b/lkql_checker/share/lkql/side_effect_parameters.lkql index 29f8b7002..7602ecb42 100644 --- a/lkql_checker/share/lkql/side_effect_parameters.lkql +++ b/lkql_checker/share/lkql/side_effect_parameters.lkql @@ -1,8 +1,3 @@ -# Flag subprogram calls and generic instantiations that have in their -# parameters at least two calls to the same function, taking into account -# renamings. -# `functions` is a list of fully qualified function names to check. - import stdlib fun check_list(l, functions) = @@ -18,6 +13,45 @@ fun check_list(l, functions) = @check(message="call with side effects", category="Style", subcategory="Programming Practice") fun side_effect_parameters(node, functions=[]) = + |" Flag subprogram calls and generic instantiations that have at least two actual + |" parameters that are expressions containing a call to the same function as a + |" subcomponent. Only calls to the functions specified as a rule parameter are + |" considered. + |" + |" The rule has an optional parameter(s) for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Functions: list[string]* + |" A list of fully expanded Ada names of functions to flag parameters from. + |" + |" Note that a rule parameter should be a function name but not the name defined + |" by a function renaming declaration. Note also, that if a rule parameter does not + |" denote the name of an existing function or if it denotes a name defined by + |" a function renaming declaration, the parameter itself is (silently) ignored + |" and does not have any effect. + |" + |" Note also, that the rule does not make any overload resolution, so if + |" a rule parameter refers to more than one overloaded functions with the same + |" name, the rule will treat calls to all these function as the calls to the + |" same function. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 12 + |" + |" -- Suppose the rule is activated as +RSide_Effect_Parameters:P.Fun + |" package P is + |" function Fun return Integer; + |" function Fun (I : Integer) return Integer; + |" function Fun1 (I : Integer) return Integer; + |" end P; + |" + |" with P; use P; + |" with Bar; + |" procedure Foo is + |" begin + |" Bar (Fun, 1, Fun1 (Fun)); -- FLAG node is (GenericInstantiation when check_list(node.p_inst_params(), functions) | diff --git a/lkql_checker/share/lkql/silent_exception_handlers.lkql b/lkql_checker/share/lkql/silent_exception_handlers.lkql index b02e1735f..c233df9d7 100644 --- a/lkql_checker/share/lkql/silent_exception_handlers.lkql +++ b/lkql_checker/share/lkql/silent_exception_handlers.lkql @@ -1,34 +1,91 @@ -# Flag any exception handler in which there exists an execution path that -# performs no raise/re-raise and no call to a given list of subprograms -# (as listed by the parameter subprograms) and subprogram regexps (as listed -# by subprogram_regexps). For gnatcheck users: each parameter given is a fully -# qualified name of a subprogram. If the parameter is quoted ("") then it is -# handled as a case insensitive regular expression as defined in s-regpat.ads, -# otherwise a case insensitive comparison is performed. - import stdlib import control_flow @check(message="silent exception handler", category="Style", subcategory="Programming Practice") -fun silent_exception_handlers(node, subprograms=[], subprogram_regexps=[]) = { - fun is_raise_or_log(stmt) = - stmt is (RaiseStmt - | n@BaseId(p_is_call(): true) - when n.p_referenced_decl() is decl@BasicDecl - when match decl.p_canonical_fully_qualified_name() - | "^ada.exceptions.(raise_exception|reraise_occurrence)$" => true - | n => [s for s in subprograms if n == s] or - [r for r in subprogram_regexps - if n.contains(pattern(r, case_sensitive=false))]); +fun silent_exception_handlers(node, subprograms=[], subprogram_regexps=[]) = + |" Flag any exception handler in which there exists at least one an execution path + |" that does not raise an exception by a ``raise`` statement or a call to + |" ``Ada.Exceptions.Raise_Exception`` or to ``Ada.Exceptions.Reraise_Occurrence`` + |" nor contains a call to some subprogram specified by the rule parameter + |" *Subprograms*. + |" + |" The rule has the following parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Subprograms: list[string]* + |" List of names of subprograms. An exception handler is not flagged if it + |" contains a call to a subprogram that has a fully expanded Ada names that + |" matches an element of this list. + |" This list may contains fully expanded Ada names *AND* case-insensitive + |" regular expression. From a ``+R`` option, you can specify a regular + |" expression by providing an Ada string literal, and from an LKQL rule options + |" file, you have to append the ``|`` character at the beginning of your regular + |" expression. For example: + |" :: + |" + |" +RSilent_Exception_Handlers:My.Expanded.Name,"My\.Regex\..*" + |" + |" maps to: + |" + |" .. code-block:: lkql + |" + |" val rules = @{ + |" Silent_Exception_Handlers: {Subprograms: ["My.Expanded.Name", "|My\.Regex\..*"]} + |" } + |" + |" Note that if you specify the rule with parameters in a command shell, you may + |" need to escape its parameters. The best and the safest way of using this rule + |" is to place it into a rule file and to use this rule file as a parameter of the + |" ``-from=`` option, no escaping is needed in this case. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 12 + |" + |" with Ada.Exceptions; use Ada.Exceptions; + |" + |" procedure Exc is + |" procedure Log (Msg : String) with Import; + |" -- Suppose the rule parameters are: + |" -- ada.exceptions.exception_message,"\.Log$" + |" I : Integer := 0; + |" begin + |" begin + |" I := I + 1; + |" exception + |" when others => -- FLAG + |" null; + |" end; + |" + |" exception + |" when Constraint_Error => -- NO FLAG + |" raise; + |" when Program_Error => -- NO FLAG + |" Log (""); + |" when E : others => -- NO FLAG + |" I := 0; + |" Log (Exception_Message (E)); + |" end Exc; + { + fun is_raise_or_log(stmt) = + stmt is (RaiseStmt + | n@BaseId(p_is_call(): true) + when n.p_referenced_decl() is decl@BasicDecl + when match decl.p_canonical_fully_qualified_name() + | "^ada.exceptions.(raise_exception|reraise_occurrence)$" => true + | n => [s for s in subprograms if n == s] or + [r for r in subprogram_regexps + if n.contains(pattern(r, case_sensitive=false))]); - # Run a `must` control-flow analysis on the given exception handler to check - # that *all* execution paths contain a raise statement or a call to an - # appropriate subprogram, and flag if it is *not* the case. - node is ExceptionHandler - when not control_flow.analyze( - node.f_stmts, - is_raise_or_log, - control_flow.must - ) -} + # Run a `must` control-flow analysis on the given exception handler to check + # that *all* execution paths contain a raise statement or a call to an + # appropriate subprogram, and flag if it is *not* the case. + node is ExceptionHandler + when not control_flow.analyze( + node.f_stmts, + is_raise_or_log, + control_flow.must + ) + } diff --git a/lkql_checker/share/lkql/simple_loop_statements.lkql b/lkql_checker/share/lkql/simple_loop_statements.lkql index 427cd2d6e..d32be39c8 100644 --- a/lkql_checker/share/lkql/simple_loop_statements.lkql +++ b/lkql_checker/share/lkql/simple_loop_statements.lkql @@ -1,5 +1,19 @@ -# Flag each occurrence of a simple loop statement, excluding while and for -# loops. - @check(message="simple loop statement", category="Feature") -fun simple_loop_statements(node) = node is LoopStmt +fun simple_loop_statements(node) = + |" Flags simple loop statements (loop statements that do not + |" have iteration schemes). + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" loop -- FLAG + |" I := I + 1; + |" exit when I > 10; + |" end loop; + |" + |" while I > 0 loop -- NO FLAG + |" I := I - 1; + |" end loop; + node is LoopStmt diff --git a/lkql_checker/share/lkql/single_value_enumeration_types.lkql b/lkql_checker/share/lkql/single_value_enumeration_types.lkql index 986b3d282..00667ab42 100644 --- a/lkql_checker/share/lkql/single_value_enumeration_types.lkql +++ b/lkql_checker/share/lkql/single_value_enumeration_types.lkql @@ -1,7 +1,14 @@ -# Flag an enumeration type definition if it contains a single enumeration -# literal specification. - @check(message="enumeration type definition with a single enumeration literal", category="Style", subcategory="Programming Practice") fun single_value_enumeration_types(node) = + |" Flag an enumeration type definition if it contains a single enumeration + |" literal specification + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" type Enum3 is (A, B, C); + |" type Enum1 is (D); -- FLAG node is EnumTypeDef when not node.f_enum_literals[2] diff --git a/lkql_checker/share/lkql/size_attribute_for_types.lkql b/lkql_checker/share/lkql/size_attribute_for_types.lkql index 4451085d2..b99bea3ea 100644 --- a/lkql_checker/share/lkql/size_attribute_for_types.lkql +++ b/lkql_checker/share/lkql/size_attribute_for_types.lkql @@ -1,10 +1,21 @@ -# Flag any 'Size attribute reference if its prefix denotes a type or a subtype. -# Attribute references that are subcomponents of attribute definition clauses -# or aspect specifications are not flagged. - @check(message="Size attribute for type", category="Style", subcategory="Programming Practice") fun size_attribute_for_types(node) = + |" Flag any 'Size attribute reference if its prefix denotes a type or a subtype. + |" Attribute references that are subcomponents of attribute definition clauses of + |" aspect specifications are not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 6 + |" + |" type T is record + |" I : Integer; + |" B : Boolean; + |" end record; + |" + |" Size_Of_T : constant Integer := T'Size -- FLAG node is AttributeRef when node.f_attribute?.p_name_is("Size") and node.f_prefix?.p_referenced_decl() is BaseTypeDecl diff --git a/lkql_checker/share/lkql/slices.lkql b/lkql_checker/share/lkql/slices.lkql index 564791a4c..d605a97c7 100644 --- a/lkql_checker/share/lkql/slices.lkql +++ b/lkql_checker/share/lkql/slices.lkql @@ -1,4 +1,13 @@ -# Flag all uses of array slicing. - @check(message="slice", category="SPARK") -fun slices(node) = node is CallExpr(p_is_array_slice(): true) +fun slices(node) = + |" Flag all uses of array slicing + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" procedure Proc (S : in out String; L, R : Positive) is + |" Tmp : String := S (L .. R); -- FLAG + |" begin + node is CallExpr(p_is_array_slice(): true) diff --git a/lkql_checker/share/lkql/spark_procedures_without_globals.lkql b/lkql_checker/share/lkql/spark_procedures_without_globals.lkql index 0b16622c2..25155755e 100644 --- a/lkql_checker/share/lkql/spark_procedures_without_globals.lkql +++ b/lkql_checker/share/lkql/spark_procedures_without_globals.lkql @@ -1,9 +1,30 @@ import stdlib @check(message="SPARK procedure doesn't have a Global aspect", - category="Style", subcategory="Programming Practice") + category="Style", subcategory="Programming Practice", + rule_name="SPARK_Procedures_Without_Globals") fun spark_procedures_without_globals(node) = - |" Check that every SPARK subprogram has a Global aspect + |" Flags SPARK procedures that don't have a global aspect. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" + |" package Test is + |" procedure P with SPARK_Mode => On; -- FLAG + |" + |" procedure Q is null; -- NOFLAG + |" + |" function Foo return Integer -- NOFLAG + |" is (12) + |" with SPARK_Mode => On; + |" + |" V : Integer; + |" + |" procedure T with Global => V; -- NOFLAG + |" + |" function Bar return Integer with SPARK_Mode => On; -- NOFLAG + |" end Test; (node is BasicSubpDecl(p_has_spark_mode_on(): true, p_subp_decl_spec(): BaseSubpSpec(p_return_type(): null))) and not node.p_has_aspect("Global") diff --git a/lkql_checker/share/lkql/specific_parent_type_invariant.lkql b/lkql_checker/share/lkql/specific_parent_type_invariant.lkql index 47c8b89e4..b5be97ae7 100644 --- a/lkql_checker/share/lkql/specific_parent_type_invariant.lkql +++ b/lkql_checker/share/lkql/specific_parent_type_invariant.lkql @@ -1,8 +1,3 @@ -# Flag any record extension definition or private extension definition if a -# parent type has a Type_Invariant aspect defined for it. A record extension -# definition is not flagged if it is a part of a completion of a private -# extension declaration. - fun check_aspect(n, aspect) = n != null and n.p_has_aspect(aspect) fun base_type(t) = match t @@ -12,6 +7,43 @@ fun base_type(t) = match t @check(message="parent type has specific Type_Invariant aspect", category="Style", subcategory="Object Orientation") fun specific_parent_type_invariant(node) = + |" Flag any record extension definition or private extension definition if + |" a parent type has a Type_Invariant aspect defined for it. A record + |" extension definition is not flagged if it is a part of a completion of a + |" private extension declaration. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 18, 23 + |" + |" package Pack1 is + |" type PT1 is tagged private; + |" type PT2 is tagged private + |" with Type_Invariant => Invariant_2 (PT2); + |" + |" function Invariant_2 (X : PT2) return Boolean; + |" + |" private + |" type PT1 is tagged record + |" I : Integer; + |" end record; + |" + |" type PT2 is tagged record + |" I : Integer; + |" end record; + |" + |" type PT1_N is new PT1 with null record; + |" type PT2_N is new PT2 with null record; -- FLAG + |" end Pack1; + |" + |" package Pack2 is + |" type N_PT1 is new Pack1.PT1 with private; + |" type N_PT2 is new Pack1.PT2 with private; -- FLAG + |" private + |" type N_PT1 is new Pack1.PT1 with null record; + |" type N_PT2 is new Pack1.PT2 with null record; + |" end Pack2; # Flag any tagged type extension node is DerivedTypeDef(parent: p@BaseTypeDecl(p_is_tagged_type(): true)) # exclude private completions diff --git a/lkql_checker/share/lkql/specific_pre_post.lkql b/lkql_checker/share/lkql/specific_pre_post.lkql index becb8bc4e..62361c0fd 100644 --- a/lkql_checker/share/lkql/specific_pre_post.lkql +++ b/lkql_checker/share/lkql/specific_pre_post.lkql @@ -1,9 +1,37 @@ -# Flag a declaration of a primitive operation of a tagged type if this -# declaration contains specification of Pre or/and Post aspect. - @check(message="definition of non class-wide aspect", category="Style", subcategory="Object Orientation") fun specific_pre_post(node) = + |" Flag a declaration of a primitive operation of a tagged type if this + |" declaration contains specification of Pre or/and Post aspect. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5, 8, 11, 19 + |" + |" type T is tagged private; + |" function Check1 (X : T) return Boolean; + |" function Check2 (X : T) return Boolean; + |" + |" procedure Proc1 (X : in out T) -- FLAG + |" with Pre => Check1 (X); + |" + |" procedure Proc2 (X : in out T) -- FLAG + |" with Post => Check2 (X); + |" + |" function Fun1 (X : T) return Integer -- FLAG + |" with Pre => Check1 (X), + |" Post => Check2 (X); + |" + |" function Fun2 (X : T) return Integer + |" with Pre'Class => Check1 (X), + |" Post'Class => Check2 (X); + |" + |" function Fun3 (X : T) return Integer -- FLAG + |" with Pre'Class => Check1 (X), + |" Post'Class => Check2 (X), + |" Pre => Check1 (X), + |" Post => Check2 (X); node is (BasicSubpDecl | BaseSubpBody(p_previous_part(): null) | SubpBodyStub(p_previous_part(): null)) diff --git a/lkql_checker/share/lkql/specific_type_invariants.lkql b/lkql_checker/share/lkql/specific_type_invariants.lkql index 7b3834025..9ad7265fe 100644 --- a/lkql_checker/share/lkql/specific_type_invariants.lkql +++ b/lkql_checker/share/lkql/specific_type_invariants.lkql @@ -1,11 +1,28 @@ -# Flag any definition of (non-class-wide) Type_Invariant aspect that is a part -# of a declaration of a tagged type or a tagged extension. Definitions of -# Type_Invariant aspect that are parts of declarations of non-tagged types are -# not flagged. - @check(message="definition of non class-wide Type_Invariant aspect", category="Style", subcategory="Object Orientation") fun specific_type_invariants(node) = + |" Flag any definition of (non-class-wide) Type_Invariant aspect that is + |" a part of a declaration of a tagged type or a tagged extension. Definitions + |" of Type_Invariant'Class aspects are not flagged. Definitions of (non-class-wide) + |" Type_Invariant aspect that are parts of declarations of non-tagged types + |" are not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 6 + |" + |" type PT is private + |" with Type_Invariant => Test_PT (PT); + |" function Test_PT (X : PT) return Boolean; + |" + |" type TPT1 is tagged private + |" with Type_Invariant => Test_TPT1 (TPT1); -- FLAG + |" function Test_TPT1 (X : TPT1) return Boolean; + |" + |" type TPT2 is tagged private + |" with Type_Invariant'Class => Test_TPT2 (TPT2); + |" function Test_TPT2 (X : TPT2) return Boolean; node is AspectAssoc( f_id: Identifier(p_name_is("Type_Invariant"): true), any parent(depth=3): BaseTypeDecl(p_is_tagged_type(): true)) diff --git a/lkql_checker/share/lkql/subprogram_access.lkql b/lkql_checker/share/lkql/subprogram_access.lkql index 7134d9a8e..e1a9dbbb9 100644 --- a/lkql_checker/share/lkql/subprogram_access.lkql +++ b/lkql_checker/share/lkql/subprogram_access.lkql @@ -1,5 +1,17 @@ -# Flag all constructs that belong to access_to_subprogram_definition syntax -# category, and all access definitions that define access to subprogram. - @check(message="access to subprogram definition", category="Feature") -fun subprogram_access(node) = node is AccessToSubpDef +fun subprogram_access(node) = + |" Flag all constructs that belong to access_to_subprogram_definition + |" syntax category, and all access definitions that define access to + |" subprogram. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1, 5 + |" + |" type Proc_A is access procedure ( I : Integer); -- FLAG + |" + |" procedure Proc + |" (I : Integer; + |" Process : access procedure (J : in out Integer)); -- FLAG + node is AccessToSubpDef diff --git a/lkql_checker/share/lkql/suspicious_equalities.lkql b/lkql_checker/share/lkql/suspicious_equalities.lkql index 7232a83b9..01d7cb528 100644 --- a/lkql_checker/share/lkql/suspicious_equalities.lkql +++ b/lkql_checker/share/lkql/suspicious_equalities.lkql @@ -1,7 +1,3 @@ -# Flag 'or' expressions whose two operands are inequality expressions comparing -# a same variable against two literals and 'and' expressions whose two operands -# are equality expressions comparing a same variable against two literals. - import stdlib fun name_of(bin_op) = @@ -56,6 +52,25 @@ fun is_sus_eq(bin_op, logic_op_predicate, comp_op_predicate) = @check(message="suspicious equality", category="Style", subcategory="Programming Practice") fun suspicious_equalities(node) = + |" Flag 'or' expressions whose left and right operands are unequalities + |" referencing the same entity and a literal and 'and' expressions whose left and + |" right operands are equalities referencing the same entity and a literal. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4, 7 + |" + |" procedure tmp is + |" X : Integer := 0; + |" begin + |" if X /= 1 or x /= 2 then -- FLAG + |" null; + |" end; + |" if x = 1 and then X = 2 then -- Flag + |" null; + |" end; + |" end; node is BinOp when is_sus_eq(node, (op) => op is (OpAnd | OpAndThen), (op) => op is OpEq) or is_sus_eq(node, (op) => op is (OpOr | OpOrElse), (op) => op is OpNeq) diff --git a/lkql_checker/share/lkql/too_many_dependencies.lkql b/lkql_checker/share/lkql/too_many_dependencies.lkql index 2ca7bcb64..7f0819916 100644 --- a/lkql_checker/share/lkql/too_many_dependencies.lkql +++ b/lkql_checker/share/lkql/too_many_dependencies.lkql @@ -1,10 +1,3 @@ -# Flag a library item or a subunit that immediately depends on more than N -# library units (N is a rule parameter). In case of a dependency on child -# units, implicit or explicit dependencies on all their parents are not -# counted. -# This rule has the N parameter: Positive integer specifying the maximal -# number of dependencies when the library item or subunit is not flagged. - fun is_not_starter(name, l) = |" Given a list of strings l, return 1 if none of the strings start with |" name, 0 otherwise. @@ -37,14 +30,40 @@ fun num_deps(unit, parent) = { @unit_check(help="unit has too many dependencies", remediation="MAJOR", category="Feature") -fun too_many_dependencies(unit, n : int = 5) = [ - {message: "unit has too many dependencies (" & - img(if node is LibraryItem - then num_deps(node.parent, node.f_item.p_semantic_parent()) - else num_deps(node.parent, node.p_semantic_parent())) & ")", - loc: node} - for node in from unit.root select - (lib@(LibraryItem when num_deps(lib.parent, - lib.f_item.p_semantic_parent()) > n) | - sub@Subunit when num_deps(sub.parent, sub.p_semantic_parent()) > n) -] +fun too_many_dependencies(unit, n : int = 5) = + |" Flag a library item or a subunit that immediately depends on more than + |" N library units (N is a rule parameter). In case of a dependency on + |" child units, implicit or explicit dependencies on all their parents are + |" not counted. + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Positive integer specifying the maximal number of dependencies when + |" the library item or subunit is not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 8 + |" + |" -- if rule parameter is 5 or smaller: + |" with Pack1; + |" with Pack2; + |" with Pack3; + |" with Pack4; + |" with Pack5; + |" with Pack6; + |" procedure Main is -- FLAG + [ + {message: "unit has too many dependencies (" & + img(if node is LibraryItem + then num_deps(node.parent, node.f_item.p_semantic_parent()) + else num_deps(node.parent, node.p_semantic_parent())) & ")", + loc: node} + for node in from unit.root select + (lib@(LibraryItem when num_deps(lib.parent, + lib.f_item.p_semantic_parent()) > n) | + sub@Subunit when num_deps(sub.parent, sub.p_semantic_parent()) > n) + ] diff --git a/lkql_checker/share/lkql/too_many_generic_dependencies.lkql b/lkql_checker/share/lkql/too_many_generic_dependencies.lkql index eee9352a0..f49e8904b 100644 --- a/lkql_checker/share/lkql/too_many_generic_dependencies.lkql +++ b/lkql_checker/share/lkql/too_many_generic_dependencies.lkql @@ -1,8 +1,3 @@ -# Flag each generic unit in a with clause that depends on a chain of more -# than N generic library units (including itself). -# This rule has the N parameter: Positive integer specifying the maximal -# number of dependencies. - fun check_deps(node, n : int) = |" Return true if node has a chain of at least n generic units withed n == 0 or @@ -17,6 +12,47 @@ fun check_deps(node, n : int) = @unit_check(help="too many generic dependencies", remediation="MAJOR", category="Style", subcategory="Program Structure") fun too_many_generic_dependencies(unit, n : int = 3) = + |" Flags a ``with`` clause that mentions a + |" generic unit that in turn directly depends (mentions in its ``with`` + |" clause) on another generic unit, and so on, and the length of the + |" chain of these dependencies on generics is more than N where N is + |" a rule parameter. + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Non-negative integer specifying the maximal allowed length of the + |" chain of dependencies on generic units. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 20 + |" + |" generic + |" package D is + |" end D; + |" + |" with D; + |" generic + |" package C is + |" end C; + |" + |" with C; + |" generic + |" package B is + |" end B; + |" + |" with B; + |" generic + |" package A is + |" end A; + |" + |" with A; -- FLAG (if N <= 3) + |" package P is + |" procedure Proc; + |" end P; if unit.root is CompilationUnit then [{message: "too many generic dependencies", loc: x} for x in diff --git a/lkql_checker/share/lkql/too_many_parents.lkql b/lkql_checker/share/lkql/too_many_parents.lkql index 76c61d78b..a80431b7f 100644 --- a/lkql_checker/share/lkql/too_many_parents.lkql +++ b/lkql_checker/share/lkql/too_many_parents.lkql @@ -1,16 +1,37 @@ -# Flag any tagged type declaration, interface type declaration, single task -# declaration or single protected declaration that has more than n -# parents. A parent here is either a (sub)type denoted by the subtype mark from -# the parent_subtype_indication (in case of a derived type declaration), or any -# of the progenitors from the interface list (if any). -# This rule has the following parameter: n: Positive integer -# specifying the maximal allowed number of parents/progenitors. - import stdlib @check(message="type has too many parents", remediation="MAJOR", category="Style", subcategory="Object Orientation") fun too_many_parents(node, n : int = 5) = + |" Flag any tagged type declaration, interface type declaration, single task + |" declaration or single protected declaration that has more than *N* + |" *parents*, where *N* is a parameter of the rule. + |" A *parent* here is either a (sub)type denoted by the subtype mark from the + |" parent_subtype_indication (in case of a derived type declaration), or + |" any of the progenitors from the interface list (if any). + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Positive integer specifying the maximal allowed number of parents/progenitors. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 11 + |" + |" type I1 is interface; + |" type I2 is interface; + |" type I3 is interface; + |" type I4 is interface; + |" + |" type T_Root is tagged private; + |" + |" type T_1 is new T_Root with private; + |" type T_2 is new T_Root and I1 with private; + |" type T_3 is new T_Root and I1 and I2 with private; + |" type T_4 is new T_Root and I1 and I2 and I3 with private; -- FLAG (if rule parameter is 3 or less) node is (TypeDecl(p_is_tagged_type(): true) | TaskTypeDecl | ProtectedTypeDecl | SingleProtectedDecl) when ({ diff --git a/lkql_checker/share/lkql/too_many_primitives.lkql b/lkql_checker/share/lkql/too_many_primitives.lkql index b38a3e70d..772f2eacd 100644 --- a/lkql_checker/share/lkql/too_many_primitives.lkql +++ b/lkql_checker/share/lkql/too_many_primitives.lkql @@ -1,22 +1,57 @@ -# Flag any tagged type declaration that has more than N user-defined primitive -# operations (counting both inherited and not overridden and explicitly -# declared, not counting predefined operators). Only types declared in visible -# parts of packages, generic packages and package instantiations are flagged. -# This rule has the parameter N: Positive integer specifying the maximal number -# of primitives when the type is not flagged. - @memoized fun num_primitives(t) = t.p_get_primitives().length @unit_check(help="tagged type has too many primitives", remediation="MAJOR", category="Style", subcategory="Object Orientation") -fun too_many_primitives(unit, n : int = 5) = [ - {message: "tagged type has too many primitives (" & - img(num_primitives(n)) & ")", - loc: n.p_defining_name()} - for n in from unit.root through follow_generics - select node@TypeDecl - when node.p_is_tagged_type() and node.parent.parent is PublicPart - and num_primitives(node) > n -] +fun too_many_primitives(unit, n : int = 5) = + |" Flag any tagged type declaration that has more than N user-defined + |" primitive operations (counting both inherited and not overridden and + |" explicitly declared, not counting predefined operators). Only types + |" declared in visible parts of packages, generic packages and package + |" instantiations are flagged. + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Positive integer specifying the maximal number of primitives when + |" the type is not flagged. + |" + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2, 14 + |" + |" package Foo is + |" type PT is tagged private; -- FLAG (if rule parameter is 3 or less) + |" + |" procedure P1 (X : in out PT); + |" procedure P2 (X : in out PT) is null; + |" function F1 (X : PT) return Integer; + |" function F2 (X : PT) return Integer is (F1 (X) + 1); + |" + |" type I1 is interface; + |" + |" procedure P1 (X : in out I1) is abstract; + |" procedure P2 (X : in out I1) is null; + |" + |" type I2 is interface and I1; -- FLAG (if rule parameter is 3 or less) + |" function F1 (X : I2) return Integer is abstract; + |" function F2 (X : I2) return Integer is abstract; + |" + |" private + |" type PT is tagged record + |" I : Integer; + |" end record; + |" end Foo; + [ + {message: "tagged type has too many primitives (" & + img(num_primitives(n)) & ")", + loc: n.p_defining_name()} + for n in from unit.root through follow_generics + select node@TypeDecl + when node.p_is_tagged_type() and node.parent.parent is PublicPart + and num_primitives(node) > n + ] diff --git a/lkql_checker/share/lkql/trivial_exception_handlers.lkql b/lkql_checker/share/lkql/trivial_exception_handlers.lkql index 0681e3eb5..7681ac2f9 100644 --- a/lkql_checker/share/lkql/trivial_exception_handlers.lkql +++ b/lkql_checker/share/lkql/trivial_exception_handlers.lkql @@ -1,10 +1,26 @@ -# Flag each occurrence of an exception handler which contains as first -# statement a raise with no exception name, unless there is also a handler for -# others with more than just a raise statement. - @check(message="trivial exception handler", category="Style", subcategory="Programming Practice") fun trivial_exception_handlers(node) = + |" Flag exception handlers that contain a raise statement with no exception name + |" as their first statement unless the enclosing handled sequence of + |" statements also contains a handler with ``OTHERS`` exception choice that + |" starts with any statement but not a raise statement with no exception name. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" exception + |" when My_Exception => -- FLAG + |" raise; + |" end; + |" exception + |" when Constraint_Error => -- NO FLAG + |" raise; + |" when others => + |" null; + |" end; node is ExceptionHandler when node.f_stmts[1] is RaiseStmt(f_exception_name: null) and { diff --git a/lkql_checker/share/lkql/unassigned_out_parameters.lkql b/lkql_checker/share/lkql/unassigned_out_parameters.lkql index b2f47d21c..e57084500 100644 --- a/lkql_checker/share/lkql/unassigned_out_parameters.lkql +++ b/lkql_checker/share/lkql/unassigned_out_parameters.lkql @@ -1,22 +1,3 @@ -# Flag subprogram' out parameters that are not assigned. -# An out parameter is flagged if the sequence of statements of the subprogram -# body (before the subprogram body's exception part, if any) contains no -# assignment to the parameter. -# An out parameter is also flagged if an exception handler contains neither an -# assignment to the parameter nor a raise statement nor a call to a procedure -# marked No_Return. -# Bodies of generic subprograms are also considered. -# -# The following are treated as assignments to an out parameter: -# - an assignment statement, with the parameter or some component as the target -# - passing the parameter (or one of its components) as an out or in out -# parameter. -# -# This rule has an optional parameter: -# - Ignore_Component_Assignments: ignore component assignments when determining -# whether a composite parameter is initialized, only consider full -# assignments. - import stdlib # Return true if `id` matches `param` (the ParamDecl of `name`), taking @@ -52,23 +33,71 @@ fun check_exception_handler(param, name, h, ignore_comp) = check_stmts(param, name, h, ignore_comp) @unit_check(help="OUT parameters do not get values in subprogram bodies", - category="Feature") -fun unassigned_out_parameters(unit, ignore_component_assignments=false) = [ - {message: "unassigned OUT parameter " & n.f_name.text, loc: n} - for n in from unit.root - # Look for out parameters of subprogram bodies only - select node@DefiningName(parent: DefiningNameList(parent: - decl@ParamSpec(f_mode: ModeOut, - parent: ParamSpecList(parent: Params(parent: - SubpSpec(parent: body@SubpBody)))))) - when not ( - check_stmts(decl, node.f_name, body.f_decls, - ignore_component_assignments) - or check_stmts(decl, node.f_name, body.f_stmts.f_stmts, - ignore_component_assignments) - ) or stdlib.any([ - m for m in (from body.f_stmts.f_exceptions select h@ExceptionHandler - when not check_exception_handler(decl, node.f_name, h, - ignore_component_assignments)) - ]) -] + rule_name="Unassigned_OUT_Parameters", category="Feature") +fun unassigned_out_parameters(unit, ignore_component_assignments=false) = + |" Flag subprograms' ``out`` parameters that are not assigned. + |" + |" An ``out`` parameter is flagged if neither the *declarative part* nor the + |" *sequence of statements* of the subprogram body (before the subprogram body's + |" exception part, if any) contain an assignment to the parameter. + |" + |" An ``out`` parameter is flagged if an *exception handler* contains neither an + |" assignment to the parameter nor a raise statement nor a call to a procedure + |" marked No_Return. + |" + |" Bodies of generic subprograms are also considered. + |" + |" The following are treated as assignments to an ``out`` parameter: + |" + |" * an assignment statement, with the parameter or some component as the target + |" * passing the parameter (or one of its components) as an ``out`` or + |" ``in out`` parameter. + |" + |" The rule has an optional parameter for the ``+R`` option and for LKQL rule + |" options files: + |" + |" *Ignore_Component_Assignments: bool* + |" Whether to ignore assignments to subcomponents of an ``out`` parameter when + |" detecting if the parameter is assigned. + |" + |" .. note:: An assignment to a subprogram's parameter can occur in the subprogram + |" body's *declarative part* in the presence of a nested subprogram declaration + |" which itself contains an assignment to the enclosing subprogram's parameter. + |" + |" .. warning:: This rule only detects the described cases of unassigned variables + |" and doesn't provide a full guarantee that there is no uninitialized access. + |" It is only a partial replacement for the validity checks provided by + |" CodePeer. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" procedure Proc -- FLAG + |" (I : Integer; + |" Out1 : out Integer; + |" Out2 : out Integer) + |" is + |" begin + |" Out1 := I + 1; + |" end Proc; + [ + {message: "unassigned OUT parameter " & n.f_name.text, loc: n} + for n in from unit.root + # Look for out parameters of subprogram bodies only + select node@DefiningName(parent: DefiningNameList(parent: + decl@ParamSpec(f_mode: ModeOut, + parent: ParamSpecList(parent: Params(parent: + SubpSpec(parent: body@SubpBody)))))) + when not ( + check_stmts(decl, node.f_name, body.f_decls, + ignore_component_assignments) + or check_stmts(decl, node.f_name, body.f_stmts.f_stmts, + ignore_component_assignments) + ) or stdlib.any([ + m for m in (from body.f_stmts.f_exceptions select h@ExceptionHandler + when not check_exception_handler(decl, node.f_name, h, + ignore_component_assignments)) + ]) + ] diff --git a/lkql_checker/share/lkql/unavailable_body_calls.lkql b/lkql_checker/share/lkql/unavailable_body_calls.lkql index 67022e6cf..56672602d 100644 --- a/lkql_checker/share/lkql/unavailable_body_calls.lkql +++ b/lkql_checker/share/lkql/unavailable_body_calls.lkql @@ -1,13 +1,34 @@ -# Flag each occurrence of a subprogram call whose body is not available. -# Indirect calls are flagged only when Indirect_Calls is enabled. -# This rule can be useful when using the recursive_subprograms rule to flag -# potentially missing recursion detection and identify potential missing -# checks. - @check(help="call to unavailable body (global analysis required)", message="call to unavailable body", category="Style", subcategory="Programming Practice") fun unavailable_body_calls(node, indirect_calls = false) = + |" Flag any subprogram call if the set of argument sources does not + |" contain a body of the called subprogram because of any reason. + |" Calls to formal subprograms in generic bodies are not flagged. + |" This rule can be useful as a complementary rule for the + |" *Recursive_Subprograms* rule - it flags potentially missing recursion + |" detection and identify potential missing checks. + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *Indirect_Calls: bool* + |" Whether to flag all the indirect calls (that is, calls through + |" access-to-subprogram values). + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 7,8 + |" + |" procedure Calls is + |" procedure Unknown with Import; + |" + |" type Proc_A is access procedure (X : Integer); + |" X : Proc_A := Some_Proc'Access; + |" begin + |" Unknown; -- FLAG + |" X (1); -- FLAG (if Indirect_Calls is enabled) node is Name when (indirect_calls and node.p_is_access_call()) or node is BaseId(p_is_static_call(): true, diff --git a/lkql_checker/share/lkql/unchecked_address_conversions.lkql b/lkql_checker/share/lkql/unchecked_address_conversions.lkql index ef523833a..5086a8e08 100644 --- a/lkql_checker/share/lkql/unchecked_address_conversions.lkql +++ b/lkql_checker/share/lkql/unchecked_address_conversions.lkql @@ -1,15 +1,3 @@ -# Flag instantiations of Ada.Unchecked_Conversion if the actual for the formal -# type Source is the System.Address type (or a type derived from it), and the -# actual for the formal type Target is an access type (including types derived -# from access types). This includes cases when the actual for Source is a -# private type and its full declaration is a type derived from System.Address, -# and cases when the actual for Target is a private type and its full -# declaration is an access type. The rule is checked inside expanded generics -# by default, unless the parameter `No_Instantiations` is set. -# -# If the parameter `ALL` is set, all instantiations of Unchecked_Conversion -# to or from System.Address are flagged. - import stdlib fun is_address(param) = @@ -28,6 +16,43 @@ fun check_uc_params(source, target, all) = follow_generic_instantiations=true, category="Style", subcategory="Programming Practice") fun unchecked_address_conversions(node, all=false, no_instantiations=false) = + |" Flag instantiations of ``Ada.Unchecked_Conversion`` if the actual for the + |" formal type Source is the ``System.Address`` type (or a type derived from + |" it), and the actual for the formal type ``Target`` is an access type + |" (including types derived from access types). This include cases when the + |" actual for ``Source`` is a private type and its full declaration is a type + |" derived from ``System.Address``, and cases when the actual for ``Target`` is + |" a private type and its full declaration is an access type. The rule is + |" checked inside expanded generics unless the ``No_Instantiations`` parameter + |" is set. + |" + |" The rule has the following optional parameters for the ``+R`` option and for + |" LKQL rule options files: + |" + |" *All: bool* + |" If ``true``, all instantiations of Unchecked_Conversion to or from System.Address are + |" flagged. + |" + |" *No_Instantiations: bool* + |" If ``true``, Do not check inside expanded generics. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 9 + |" + |" with Ada.Unchecked_Conversion; + |" with System; + |" package Foo is + |" type My_Address is new System.Address; + |" + |" type My_Integer is new Integer; + |" type My_Access is access all My_Integer; + |" + |" function Address_To_Access is new Ada.Unchecked_Conversion -- FLAG + |" (Source => My_Address, + |" Target => My_Access); + |" end Foo; node is GenericSubpInstantiation when not (no_instantiations and stdlib.in_generic_instance(node)) and stdlib.is_unchecked_conversion(node) diff --git a/lkql_checker/share/lkql/unchecked_conversions_as_actuals.lkql b/lkql_checker/share/lkql/unchecked_conversions_as_actuals.lkql index a80d184a3..c8af0ea07 100644 --- a/lkql_checker/share/lkql/unchecked_conversions_as_actuals.lkql +++ b/lkql_checker/share/lkql/unchecked_conversions_as_actuals.lkql @@ -1,18 +1,48 @@ -# Flag call to instantiation of Ada.Unchecked_Conversion if it is an actual in -# procedure or entry call or if it is a default value in a subprogram or entry -# parameter specification. - import stdlib @unit_check(message="instance of Unchecked_Conversion as actual parameter", category="Style", subcategory="Programming Practice") -fun unchecked_conversions_as_actuals(unit) = [ - {message: "instance of Unchecked_Conversion as " & - (if n is CallExpr(any parent: CallStmt) - then "actual parameter" else "default parameter value"), - loc: n} - for n in from unit.root - select node@CallExpr(any parent: CallStmt | SubpSpec) - when stdlib.is_unchecked_conversion( - stdlib.ultimate_subprogram_alias(node.p_referenced_decl()) - )] +fun unchecked_conversions_as_actuals(unit) = + |" Flag call to instantiation of ``Ada.Unchecked_Conversion`` if it is an actual in + |" procedure or entry call or if it is a default value in a subprogram or + |" entry parameter specification. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 11, 22 + |" + |" with Ada.Unchecked_Conversion; + |" procedure Bar (I : in out Integer) is + |" type T1 is array (1 .. 10) of Integer; + |" type T2 is array (1 .. 10) of Integer; + |" + |" function UC is new Ada.Unchecked_Conversion (T1, T2); + |" + |" Var1 : T1 := (others => 1); + |" Var2 : T2 := (others => 2); + |" + |" procedure Init (X : out T2; Y : T2 := UC (Var1)) is -- FLAG + |" begin + |" X := Y; + |" end Init; + |" + |" procedure Ident (X : T2; Y : out T2) is + |" begin + |" Y := X; + |" end Ident; + |" + |" begin + |" Ident (UC (Var1), Var2); -- FLAG + |" end Bar; + [ + {message: "instance of Unchecked_Conversion as " & + (if n is CallExpr(any parent: CallStmt) + then "actual parameter" else "default parameter value"), + loc: n} + for n in from unit.root + select node@CallExpr(any parent: CallStmt | SubpSpec) + when stdlib.is_unchecked_conversion( + stdlib.ultimate_subprogram_alias(node.p_referenced_decl()) + ) + ] diff --git a/lkql_checker/share/lkql/uncommented_begin.lkql b/lkql_checker/share/lkql/uncommented_begin.lkql index 134e449ab..deb5d8067 100644 --- a/lkql_checker/share/lkql/uncommented_begin.lkql +++ b/lkql_checker/share/lkql/uncommented_begin.lkql @@ -1,21 +1,35 @@ -# Flags each body with declarations and a statement part that does not -# include a trailing comment on the line containing the begin keyword; this -# trailing comment needs to specify the entity name and nothing else. The -# begin is not flagged if the body does not contain any declarations. - import stdlib @unit_check(help="BEGIN not marked with entity name comment", - remediation="EASY", category="Style", subcategory="Readability") -fun uncommented_begin(unit) = [ - {message: "mark BEGIN with -- " & n.parent.p_defining_name().text, - loc: n.token_start().previous(exclude_trivia=true)} - for n in from unit.root - select node@HandledStmts(parent: p@(PackageBody | SubpBody | - EntryBody | ProtectedBody | - TaskBody)) - when p.f_decls.f_decls is l - when l[1] - and not stdlib.find_comment(node.token_start().previous(), - p.p_defining_name().text) -] + rule_name="Uncommented_BEGIN", remediation="EASY", + category="Style", subcategory="Readability") +fun uncommented_begin(unit) = + |" Flags ``BEGIN`` keywords in program unit bodies if the body contains + |" both declarations and a statement part and if there is no trailing + |" comment just after the keyword (on the same line) with the unit + |" name as the only content of the comment, the casing of the unit + |" name in the comment should be the same as the casing of the defining + |" unit name in the unit body declaration. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" procedure Proc (I : out Integer) is + |" B : Boolean; + |" begin + |" I := Var; + |" end Proc; + [ + {message: "mark BEGIN with -- " & n.parent.p_defining_name().text, + loc: n.token_start().previous(exclude_trivia=true)} + for n in from unit.root + select node@HandledStmts(parent: p@(PackageBody | SubpBody | + EntryBody | ProtectedBody | + TaskBody)) + when p.f_decls.f_decls is l + when l[1] + and not stdlib.find_comment(node.token_start().previous(), + p.p_defining_name().text) + ] diff --git a/lkql_checker/share/lkql/uncommented_begin_in_package_bodies.lkql b/lkql_checker/share/lkql/uncommented_begin_in_package_bodies.lkql index 9cee32db9..6218f9b92 100644 --- a/lkql_checker/share/lkql/uncommented_begin_in_package_bodies.lkql +++ b/lkql_checker/share/lkql/uncommented_begin_in_package_bodies.lkql @@ -1,18 +1,44 @@ -# Flags each package body with declarations and a statement part that does not -# include a trailing comment on the line containing the begin keyword; this -# trailing comment needs to specify the package name and nothing else. The -# begin is not flagged if the package body does not contain any declarations. - import stdlib @unit_check(help="BEGIN in package bodies not marked with package name comment", + rule_name="Uncommented_BEGIN_In_Package_Bodies", remediation="EASY", category="Style", subcategory="Readability") -fun uncommented_begin_in_package_bodies(unit) = [ - {message: "mark BEGIN with package name", - loc: n.token_start().previous(exclude_trivia=true)} - for n in from unit.root - select node@HandledStmts(parent: p@PackageBody(f_decls: *(f_decls: l))) - when l[1] - and not stdlib.find_comment(node.token_start().previous(), - p.f_package_name.text) -] +fun uncommented_begin_in_package_bodies(unit) = + |" Flags ``BEGIN`` keywords in package bodies if the body contains + |" both declarations and a statement part and if there is no trailing + |" comment just after the keyword (on the same line) with the package + |" name as the only content of the comment, the casing of the package + |" name in the comment should be the same as the casing of the defining + |" unit name in the package body. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 15 + |" + |" package body Foo is + |" procedure Proc (I : out Integer) is + |" begin + |" I := Var; + |" end Proc; + |" + |" package body Inner is + |" procedure Inner_Proc (I : out Integer) is + |" begin + |" I := Inner_Var; + |" end ; + |" begin -- Inner + |" Inner_Var := 1; + |" end Inner; + |" begin -- FLAG + |" Var := Inner.Inner_Var + 1; + |" end Foo; + [ + {message: "mark BEGIN with package name", + loc: n.token_start().previous(exclude_trivia=true)} + for n in from unit.root + select node@HandledStmts(parent: p@PackageBody(f_decls: *(f_decls: l))) + when l[1] + and not stdlib.find_comment(node.token_start().previous(), + p.f_package_name.text) + ] diff --git a/lkql_checker/share/lkql/uncommented_end_record.lkql b/lkql_checker/share/lkql/uncommented_end_record.lkql index c01994e7b..ffaab8d4c 100644 --- a/lkql_checker/share/lkql/uncommented_end_record.lkql +++ b/lkql_checker/share/lkql/uncommented_end_record.lkql @@ -1,9 +1,3 @@ -# Flags each record definition that does not include a trailing comment on the -# line containing the "[end] record" keyword(s) if the record definition is -# longer than N lines; this trailing comment needs to specify the record name -# and some extra information can be provided after the name, provided it is -# separated from the name by a space or a comma. - fun find_comment(token, name, line) = |" Return true if `token` is a comment and contains only the given `name` |" possibly followed by some extra text after a space or comma, and on @@ -16,13 +10,49 @@ fun find_comment(token, name, line) = @unit_check(help="END RECORD not marked with type name comment", remediation="EASY", category="Style", subcategory="Readability") -fun uncommented_end_record(unit, n: int = 10) = [ - {message: "mark END RECORD with -- " & - n.p_semantic_parent().p_defining_name().text, - loc: n.token_end()} - for n in from unit.root select node@RecordDef - when node.token_end().end_line - node.token_start().start_line >= n - and not find_comment(node.token_end().next().next().next(), - node.p_semantic_parent().p_defining_name().text, - node.token_end().end_line) -] +fun uncommented_end_record(unit, n: int = 10) = + |" Flags ``END`` keywords that are trailing keywords in record definitions + |" if a record definition is longer than N lines where N is a rule parameter, + |" and the line that contains the ``END`` keyword does not contain a trailing + |" comment immediately after this ``END``. This trailing comment should start + |" with the name of the type that contains this record definition as (a part of) + |" its type definition, and it may contain any other information separated from + |" the type name by a space or a comma. + |" + |" This rule has the following (mandatory) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Non-negative integer specifying the maximum size (in source code lines) + |" of a record definition that does not require the type name as a trailing + |" comment. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 14 + |" + |" -- If the rule parameter is 3: + |" type R1 is record + |" I : Integer; + |" end record; -- NO FLAG + |" + |" type R2 is record + |" I : Integer; + |" B : Boolean; + |" end record; -- R2 NO FLAG + |" + |" type R3 is record + |" C : Character; + |" F : Float; + |" end record; -- FLAG + [ + {message: "mark END RECORD with -- " & + n.p_semantic_parent().p_defining_name().text, + loc: n.token_end()} + for n in from unit.root select node@RecordDef + when node.token_end().end_line - node.token_start().start_line >= n + and not find_comment(node.token_end().next().next().next(), + node.p_semantic_parent().p_defining_name().text, + node.token_end().end_line) + ] diff --git a/lkql_checker/share/lkql/unconditional_exits.lkql b/lkql_checker/share/lkql/unconditional_exits.lkql index 119ccda7d..c1aa19b76 100644 --- a/lkql_checker/share/lkql/unconditional_exits.lkql +++ b/lkql_checker/share/lkql/unconditional_exits.lkql @@ -1,5 +1,21 @@ -# Flag unconditional exit statements. - @check(message="exit statement does not contain condition", category="Feature") fun unconditional_exits(node) = + |" Flag unconditional ``exit`` statements. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 8 + |" + |" procedure Find_A (S : String; Idx : out Natural) is + |" begin + |" Idx := 0; + |" + |" for J in S'Range loop + |" if S (J) = 'A' then + |" Idx := J; + |" exit; -- FLAG + |" end if; + |" end loop; + |" end Find_A; node is ExitStmt when not node.f_cond_expr diff --git a/lkql_checker/share/lkql/unconstrained_array_returns.lkql b/lkql_checker/share/lkql/unconstrained_array_returns.lkql index 54420dd7f..303485012 100644 --- a/lkql_checker/share/lkql/unconstrained_array_returns.lkql +++ b/lkql_checker/share/lkql/unconstrained_array_returns.lkql @@ -1,14 +1,3 @@ -# Flag each function returning an unconstrained array. Function declarations, -# function bodies (and body stubs) having no separate specifications, and -# generic function instantiations are flagged. Function calls and function -# renamings are not flagged. -# Generic function declarations, and function declarations in generic packages, -# are not flagged. Instead, this rule flags the results of generic -# instantiations (that is, expanded specification and expanded body -# corresponding to an instantiation). -# This rule has the parameter Except_String: Do not flag functions that return -# the predefined String type or a type derived from it, directly or indirectly. - import stdlib fun unconstrained_array_type(type, except_string) = @@ -28,6 +17,34 @@ fun unconstrained_array_type(type, except_string) = @check(message="function returns unconstrained array", follow_generic_instantiations=true, category="Feature") fun unconstrained_array_returns(node, except_string = false) = + |" Flag each function returning an unconstrained array. Function declarations, + |" function bodies (and body stubs) having no separate specifications, + |" and generic function instantiations are flagged. + |" Function calls and function renamings are + |" not flagged. + |" + |" Generic function declarations, and function declarations in generic + |" packages, are not flagged. Instead, this rule flags the results of + |" generic instantiations (that is, expanded specification and expanded + |" body corresponding to an instantiation). + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *Except_String: bool* + |" If ``true``, do not flag functions that return the predefined ``String`` type + |" or a type derived from it, directly or indirectly. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4 + |" + |" type Arr is array (Integer range <>) of Integer; + |" subtype Arr_S is Arr (1 .. 10); + |" + |" function F1 (I : Integer) return Arr; -- FLAG + |" function F2 (I : Integer) return Arr_S; node is (AbstractSubpDecl | SubpDecl | GenericSubpInternal | BaseSubpBody(p_previous_part(): null) | SubpBodyStub(p_previous_part(): null)) diff --git a/lkql_checker/share/lkql/unconstrained_arrays.lkql b/lkql_checker/share/lkql/unconstrained_arrays.lkql index f594579c0..4b173c6e0 100644 --- a/lkql_checker/share/lkql/unconstrained_arrays.lkql +++ b/lkql_checker/share/lkql/unconstrained_arrays.lkql @@ -1,6 +1,15 @@ -# Unconstrained array definitions are flagged. - @check(message="unconstrained array definition", category="Feature") fun unconstrained_arrays(node) = + |" Unconstrained array definitions are flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" type Idx is range -100 .. 100; + |" + |" type U_Arr is array (Idx range <>) of Integer; -- FLAG + |" type C_Arr is array (Idx) of Integer; node is ArrayTypeDef(f_indices: UnconstrainedArrayIndices, all parent(depth=2): not GenericFormalTypeDecl) diff --git a/lkql_checker/share/lkql/uninitialized_global_variables.lkql b/lkql_checker/share/lkql/uninitialized_global_variables.lkql index 10176e6fa..0211c9551 100644 --- a/lkql_checker/share/lkql/uninitialized_global_variables.lkql +++ b/lkql_checker/share/lkql/uninitialized_global_variables.lkql @@ -1,14 +1,22 @@ -# Flag an object declaration that does not have an explicit initialization if -# it is located in a library-level package or generic package or bodies of -# library-level package or generic package (including packages and generic -# packages nested in those). -# Do not flag deferred constant declarations. - import stdlib @check(message="uninitialized global variable", category="Style", subcategory="Programming Practice") fun uninitialized_global_variables(node) = + |" Flag an object declaration that does not have an explicit initialization if it is + |" located in a library-level package or generic package or bodies of library-level package + |" or generic package (including packages and generic packages nested in those). + |" Do not flag deferred constant declarations. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" package Foo is + |" Var1 : Integer; -- FLAG + |" Var2 : Integer := 0; + |" end Foo; node is ObjectDecl when node.f_default_expr == null and (not node.f_has_constant?.p_as_bool()) diff --git a/lkql_checker/share/lkql/universal_ranges.lkql b/lkql_checker/share/lkql/universal_ranges.lkql index 65ea78d2d..73b6e833e 100644 --- a/lkql_checker/share/lkql/universal_ranges.lkql +++ b/lkql_checker/share/lkql/universal_ranges.lkql @@ -1,15 +1,24 @@ -# Flag discrete ranges that are a part of an index constraint, constrained -# array definition, or for-loop parameter specification, and whose bounds are -# both of type universal_integer. Ranges that have at least one bound of a -# specific type (such as 1 .. N, where N is a variable or an expression of -# non-universal type) are not flagged. - # In the context of a range constraint, a NumberDecl is always an int fun is_universal_int(i) = i is IntLiteral or i is Name(p_referenced_decl(): NumberDecl) @check(message="range with universal integer bounds", category="SPARK") fun universal_ranges(node) = + |" Flag discrete ranges that are a part of an index constraint, constrained + |" array definition, or ``for``-loop parameter specification, and whose bounds + |" are both of type *universal_integer*. Ranges that have at least one + |" bound of a specific type (such as ``1 .. N``, where ``N`` is a variable + |" or an expression of non-universal type) are not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 4 + |" + |" L : Positive := 1; + |" + |" S1 : String (L .. 10); + |" S2 : String (1 .. 10); -- FLAG node is (( # index constraint or constrained array definition CompositeConstraint(p_is_index_constraint(): true) diff --git a/lkql_checker/share/lkql/unnamed_blocks_and_loops.lkql b/lkql_checker/share/lkql/unnamed_blocks_and_loops.lkql index 8bab6c5cc..0142e8e58 100644 --- a/lkql_checker/share/lkql/unnamed_blocks_and_loops.lkql +++ b/lkql_checker/share/lkql/unnamed_blocks_and_loops.lkql @@ -1,17 +1,47 @@ -# Flag each unnamed block statement. Flag a unnamed loop statement if this -# statement is enclosed by another loop statement or if it encloses another -# loop statement. - @unit_check(help="compound statements naming", remediation="EASY", category="Style", subcategory="Programming Practice") -fun unnamed_blocks_and_loops(unit) = [ - {message: "non-named " & - (if n is BlockStmt then "block" - else (if n is BaseLoopStmt(any children: BaseLoopStmt) - then "nesting " else "nested ") & "loop") & " statement", - loc: n} - for n in from unit.root select node@CompositeStmt - when (not node.parent is NamedStmt) - and node is (BlockStmt | - BaseLoopStmt (any children: BaseLoopStmt) | - BaseLoopStmt (any parent: BaseLoopStmt))] +fun unnamed_blocks_and_loops(unit) = + |" Flag each unnamed block statement. Flag a unnamed loop statement if this + |" statement is enclosed by another loop statement or if it encloses another + |" loop statement. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 5, 10, 14 + |" + |" procedure Bar (S : in out String) is + |" I : Integer := 1; + |" begin + |" if S'Length > 10 then + |" declare -- FLAG + |" S1 : String (S'Range); + |" Last : Positive := S1'Last; + |" Idx : Positive := 0; + |" begin + |" for J in S'Range loop -- FLAG + |" S1 (Last - Idx) := S (J); + |" Idx := Idx + 1; + |" + |" for K in S'Range loop -- FLAG + |" S (K) := Character'Succ (S (K)); + |" end loop; + |" + |" end loop; + |" + |" S := S1; + |" end; + |" end if; + |" end Bar; + [ + {message: "non-named " & + (if n is BlockStmt then "block" + else (if n is BaseLoopStmt(any children: BaseLoopStmt) + then "nesting " else "nested ") & "loop") & " statement", + loc: n} + for n in from unit.root select node@CompositeStmt + when (not node.parent is NamedStmt) + and node is (BlockStmt | + BaseLoopStmt (any children: BaseLoopStmt) | + BaseLoopStmt (any parent: BaseLoopStmt)) + ] diff --git a/lkql_checker/share/lkql/unnamed_exits.lkql b/lkql_checker/share/lkql/unnamed_exits.lkql index 6337c058c..23a0978f4 100644 --- a/lkql_checker/share/lkql/unnamed_exits.lkql +++ b/lkql_checker/share/lkql/unnamed_exits.lkql @@ -1,7 +1,20 @@ -# Flag each exit statement with no name directly within a named loop. - @check(message="unnamed exit statement", remediation="EASY", category="Style", subcategory="Programming Practice") fun unnamed_exits(node) = + |" Flags exit statements with no loop names that exit from named loops. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 7 + |" + |" Named: for I in 1 .. 10 loop + |" while J < 0 loop + |" J := J + K; + |" exit when J = L; -- NO FLAG + |" end loop; + |" + |" exit when J > 10; -- FLAG + |" end loop Named; node is ExitStmt(f_loop_name: null) when (from node through parent select first BaseLoopStmt)?.f_end_name is EndName diff --git a/lkql_checker/share/lkql/use_array_slices.lkql b/lkql_checker/share/lkql/use_array_slices.lkql index a7b19240f..b1617b933 100644 --- a/lkql_checker/share/lkql/use_array_slices.lkql +++ b/lkql_checker/share/lkql/use_array_slices.lkql @@ -1,9 +1,3 @@ -# Flag for loop statements used instead of array slicing. -# Specifically detect loops of the form: -# for X in ... loop -# Array_Object (X) := *or* Another_Array (X); -# end loop; - fun array_index(call, var) = call is CallExpr( f_suffix: l@AssocList @@ -16,6 +10,29 @@ fun array_index(call, var) = @check(message="FOR loop may be replaced by an array slice", category="Style", subcategory="Programming Practice") fun use_array_slices(node) = + |" Flag ``for`` loops if a loop contains a single assignment statement, and + |" this statement is an assignment between array components or between an + |" array component and a constant value, and such a loop can + |" be replaced by a single assignment statement with array slices or + |" array objects as the source and the target of the assignment. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 6, 10 + |" + |" type Table_Array_Type is array (1 .. 10) of Integer; + |" Primary_Table : Table_Array_Type; + |" Secondary_Table : Table_Array_Type; + |" + |" begin + |" for I in Table_Array_Type'Range loop -- FLAG + |" Secondary_Table (I) := Primary_Table (I); + |" end loop; + |" + |" for I in 2 .. 5 loop -- FLAG + |" Secondary_Table (I) := 1; + |" end loop; node is ForLoopStmt when node.f_stmts.children_count == 1 and node.f_stmts[1] is stmt@AssignStmt diff --git a/lkql_checker/share/lkql/use_case_statements.lkql b/lkql_checker/share/lkql/use_case_statements.lkql index d6a8a876c..f2773ea49 100644 --- a/lkql_checker/share/lkql/use_case_statements.lkql +++ b/lkql_checker/share/lkql/use_case_statements.lkql @@ -1,11 +1,3 @@ -# Flag if statements which could be replaced by a case statement. -# That is, if statements of the form: -# if Id then -# elsif Id then -# [...] -# end if; -# -# where is a predefined relational operator. # TODO: extend with use_membership.check_expr to recognize more cases. import stdlib @@ -25,6 +17,28 @@ fun check_alternatives(list, id) = @check(message="IF statement may be replaced by a CASE statement", category="Style", subcategory="Programming Practice") fun use_case_statements(node) = + |" Flag an ``if`` statement if this statement could be replaced by a + |" ``case`` statement. An ``if`` statement is considered as being + |" replaceable by a ``case`` statement if: + |" + |" * it contains at least one ``elsif`` alternative; + |" * all the conditions are infix calls to some predefined relation operator, + |" for all of them one operand is the reference to the same variable of some + |" discrete type; + |" * for calls to relation operator another operand is some static expression; + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" if I = 1 then -- FLAG + |" I := I + 1; + |" elsif I > 2 then + |" I := I + 2; + |" else + |" I := 0; + |" end if; node is IfStmt( f_alternatives: l@ElsifStmtPartList when l[1], f_cond_expr: r@RelationOp diff --git a/lkql_checker/share/lkql/use_clauses.lkql b/lkql_checker/share/lkql/use_clauses.lkql index c549938ec..ffd4f204b 100644 --- a/lkql_checker/share/lkql/use_clauses.lkql +++ b/lkql_checker/share/lkql/use_clauses.lkql @@ -22,18 +22,46 @@ fun decls_not_only_operator(pkg) = stdlib.any([s for s in decls if not is_operator(s)]) } -@unit_check(help="use clause", category="Feature") +@unit_check(help="use clause", category="Feature", rule_name="USE_Clauses") fun use_clauses(unit, exempt_operator_packages=false, allowed=[]) = - |" Flag names mentioned in use clauses. Use type clauses and names mentioned in - |" them are not flagged. - |" This rule has two optional parameter: - |" * exempt_operator_packages: If true, do not flag a package name in a - |" package use clause if it refers to a package that only declares operators - |" in its visible part. - |" * allowed: List of fully qualified names to describe packages allowed in - |" "use" clauses. If the "all_operator_packages" value is present in this - |" list, all packages declaring only operators in their visible part are - |" allowed. + |" Flag names mentioned in use clauses. Use type clauses and names mentioned + |" in them are not flagged. + |" + |" This rule has the following optional parameter for the ``+R`` option and for + |" LKQL rule options files: + |" + |" *Exempt_Operator_Packages: bool* + |" If ``true``, do not flag a package name in a package use clause if it refers + |" to a package that only declares operators in its visible part. + |" + |" .. note:: + |" This rule has another parameter, only available when using an LKQL rule + |" options file: ``allowed``. It is a list of Ada names describing packages + |" to exempt from begin flagged when used in "use" clauses. Strings in this + |" list are case insensitive. Example: + |" + |" .. code-block:: lkql + |" + |" val rules = @{ + |" Use_Clauses: {Allowed: ["Ada.Strings.Unbounded", "Other.Package"]} + |" } + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 10, 11 + |" + |" package Pack is + |" I : Integer; + |" end Pack; + |" + |" package Operator_Pack is + |" function "+" (L, R : Character) return Character; + |" end Operator_Pack; + |" + |" with Pack, Operator_Pack; + |" use Pack; -- FLAG if "Pack" is not in Allowed + |" use Operator_Pack; -- FLAG only if Exempt_Operator_Packages is false { val canonical_allowed = [s.to_lower_case for s in allowed].to_list; [ diff --git a/lkql_checker/share/lkql/use_for_loops.lkql b/lkql_checker/share/lkql/use_for_loops.lkql index a1dd01139..3f946886c 100644 --- a/lkql_checker/share/lkql/use_for_loops.lkql +++ b/lkql_checker/share/lkql/use_for_loops.lkql @@ -1,20 +1,3 @@ -# Flag while loops which could be replaced by a for loop -# This rule recognizes while loops of the form: -# Id : ...; -# [no write reference to Id] -# begin -# [...] -# while Id loop -# [no write reference to Id] -# Id := Id +/- 1; -# end loop; -# [no reference to Id] -# -# This rule has two parameters: -# - no_exit: flag only loops that do not include an exit statement that applies -# to them. -# - no_function: must not contain any non-operator function call. - import stdlib fun write_references(node, id) = @@ -50,6 +33,53 @@ fun enclosing_scope(node) = { @check(message="WHILE loop may be replaced by a FOR loop", category="Style", subcategory="Programming Practice") fun use_for_loops(node, no_exit = false, no_function = false) = + |" Flag ``while`` loops which could be replaced by a ``for`` loop. The rule detects + |" the following code patterns: + |" + |" .. code-block:: ada + |" + |" ... + |" Id : Some_Integer_Type ...; + |" ... -- no write reference to Id + |" begin + |" ... + |" while Id loop + |" ... -- no write reference to Id + |" Id := Id 1; + |" end loop; + |" ... -- no reference to Id + |" end; + |" + |" where relation operator in the loop condition should be some predefined + |" relation operator, and increment_operator should be a predefined "+" or + |" "-" operator. + |" + |" Note, that the rule only informs about a possibility to replace a + |" ``while`` loop by a ``for``, but does not guarantee that this is + |" really possible, additional human analysis is required for all the + |" loops marked by the rule. + |" + |" This rule has the following (optional) parameters for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *No_Exit: bool* + |" If ``true``, flag only loops that do not include an exit statement that + |" applies to them. + |" + |" *No_Function: bool* + |" If ``true``, must not contain any non-operator function call. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" Idx : Integer := 1; + |" begin + |" while Idx <= 10 loop -- FLAG + |" Idx := Idx + 1; + |" end loop; + |" end; # Find while loops of the form: while Id ... loop node is WhileLoopStmt(f_spec: WhileLoopSpec(f_expr: rel@RelationOp(f_left: id@Identifier) diff --git a/lkql_checker/share/lkql/use_for_of_loops.lkql b/lkql_checker/share/lkql/use_for_of_loops.lkql index 4c5a028f1..9aeec844b 100644 --- a/lkql_checker/share/lkql/use_for_of_loops.lkql +++ b/lkql_checker/share/lkql/use_for_of_loops.lkql @@ -1,15 +1,3 @@ -# Flag for ... in loops which could be replaced by a for ... of loop, -# that is, where the loop index is used only for indexing a single variable -# on a one dimension array. -# -# This rule recognizes loops of the form: -# for Index in 'Range loop -# [all references to Index are of the form (Index)] -# end loop; -# -# This rule has one parameter N: specifies the minimal number of references -# that will trigger the detection (defaults to 1). - import stdlib fun num_indices(type) = @@ -37,6 +25,40 @@ fun is_same_object(a, b) = @check(message="FOR loop may be replaced by a FOR OF loop", category="Style", subcategory="Programming Practice") fun use_for_of_loops(node, n : int = 1, ignore = false) = + |" Flag ``for ... in`` loops which could be replaced by a ``for ... of`` loop, + |" that is, where the loop index is used only for indexing a single object + |" on a one dimension array. + |" + |" The rule detects the following code patterns: + |" + |" .. code-block:: ada + |" + |" for Index in 'Range loop + |" -- where is an array object + |" [all references to Index are of the form (Index)] + |" end loop; + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *N: int* + |" Non-negative integer, indicates the minimal number of references of the form + |" `` (Index)`` in the loop to make the loop to be flagged. + |" + |" If no parameter is used for the rule, this corresponds to the parameter value 1. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3 + |" + |" for J in Arr'Range loop -- FLAG + |" Sum := Sum + Arr (J); + |" end loop; + |" + |" for K in Left'Range loop + |" Res := Left (J) + Right (J); + |" end loop; # Look for "for in 'Range" loops node is ForLoopStmt( f_spec: spec@ForLoopSpec( diff --git a/lkql_checker/share/lkql/use_if_expressions.lkql b/lkql_checker/share/lkql/use_if_expressions.lkql index e1092b4b5..a183ec4f3 100644 --- a/lkql_checker/share/lkql/use_if_expressions.lkql +++ b/lkql_checker/share/lkql/use_if_expressions.lkql @@ -1,21 +1,3 @@ -# Flag if statements which could be replaced by an if expression. -# This rule recognizes if statements of the form: -# if ... then -# return ...; -# [elsif ... then -# return ...;] -# else -# return ...; -# end if; -# and: -# if ... then -# := ...; -# [elsif ... then -# := ...;] -# else -# := ...; -# end if; - fun simple_return(l) = l.children_count == 1 and l[1] is ReturnStmt fun simple_assignment(l) = l.children_count == 1 and l[1] is AssignStmt(f_dest: Name) @@ -23,6 +5,51 @@ fun simple_assignment(l) = @check(message="IF statement may be replaced by an IF expression", category="Style", subcategory="Programming Practice") fun use_if_expressions(node) = + |" Flag ``if`` statements which could be replaced by an ``if`` expression. + |" This rule detects the following code patterns: + |" + |" .. code-block:: ada + |" + |" if ... then + |" return ...; + |" elsif ... then -- optional chain of elsif + |" return ...; + |" else + |" return ...; + |" end if; + |" + |" and: + |" + |" .. code-block:: ada + |" + |" if ... then + |" := ...; + |" elsif ... then -- optional chain of elsif + |" := ...; + |" else + |" := ...; -- same LHS on all branches + |" end if; + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1, 9 + |" + |" if X = 1 then -- FLAG + |" return 1; + |" elsif X = 2 then + |" return 2; + |" else + |" return 3; + |" end if; + |" + |" if X >= 2 then -- FLAG + |" X := X + 1; + |" elsif X <= 0 then + |" X := X - 1; + |" else + |" X := 0; + |" end if; node is IfStmt when (simple_return(node.f_then_stmts) and simple_return(node.f_else_part.f_stmts) and diff --git a/lkql_checker/share/lkql/use_memberships.lkql b/lkql_checker/share/lkql/use_memberships.lkql index 03ff7a0a3..d80a268d6 100644 --- a/lkql_checker/share/lkql/use_memberships.lkql +++ b/lkql_checker/share/lkql/use_memberships.lkql @@ -1,11 +1,3 @@ -# Flag each occurrence of a sequence of comparisons of a same variable that -# could be changed to a membership test with multiple values. Multiple -# comparisons for equality, membership tests, and range comparisons of -# the form X >= E1 and X <= E2, all connected by the predefined "or" operator -# and using predefined comparison operators. -# If `short_circuit` is true then also consider "or else" and "and then" -# operators. - import stdlib fun check_expr(expr, id, short_circuit) = @@ -39,6 +31,44 @@ fun check_expr(expr, id, short_circuit) = @check(message="expression may be replaced by a membership test", category="Style", subcategory="Programming Practice") fun use_memberships(node, short_circuit = false) = + |" Flag expressions that could be rewritten as membership tests. Only expressions + |" that are not subexpressions of other expressions are flagged. An expression + |" is considered to be replaceable with an equivalent membership test if it is + |" a logical expression consisting of a call to one or more predefined ``or`` + |" operation(s), each relation that is an operand of the ``or`` expression is + |" a comparison of the same variable of one of following forms: + |" + |" * a call to a predefined ``=`` operator, the variable is the left operand + |" of this call; + |" * a membership test applied to this variable; + |" * a range test of the form ``Var >= E1 and Var <= E2`` where ``Var`` is + |" the variable in question and ``>=``, ``and`` and ``<=`` are predefined + |" operators; + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *Short_Circuit: bool* + |" Whether to consider the short circuit ``and then`` and ``or else`` operations + |" along with the predefined logical ``and`` and ``or`` operators. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2,8 + |" + |" begin + |" Bool1 := A = 100 -- FLAG (if Short_Circuit is true) + |" or (A >= 1 and then A <= B); + |" + |" Bool2 := A = 100 -- NO FLAG + |" or B in S; + |" + |" Bool3 := A = 1 -- FLAG + |" or + |" A = B + |" or + |" A = B + A; node is BinOp(parent: not Expr, f_op: (op@OpOr when stdlib.is_predefined_op(op)) | OpOrElse when short_circuit) diff --git a/lkql_checker/share/lkql/use_package_clauses.lkql b/lkql_checker/share/lkql/use_package_clauses.lkql index 0a75d5dde..3494cfb9f 100644 --- a/lkql_checker/share/lkql/use_package_clauses.lkql +++ b/lkql_checker/share/lkql/use_package_clauses.lkql @@ -1,5 +1,15 @@ -# Flag all use clauses for packages; use type clauses are not flagged. - -@check(message="use clause for package", +@check(message="use clause for package", rule_name="USE_PACKAGE_Clauses", category="Style", subcategory="Programming Practice") -fun use_package_clauses(node) = node is UsePackageClause +fun use_package_clauses(node) = + |" Flag all ``use`` clauses for packages; ``use type`` clauses are + |" not flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" with Ada.Text_IO; + |" use Ada.Text_IO; -- FLAG + |" procedure Bar (S : in out String) is + node is UsePackageClause diff --git a/lkql_checker/share/lkql/use_ranges.lkql b/lkql_checker/share/lkql/use_ranges.lkql index 5b2fd0544..631041419 100644 --- a/lkql_checker/share/lkql/use_ranges.lkql +++ b/lkql_checker/share/lkql/use_ranges.lkql @@ -1,34 +1,52 @@ -# Flag expressions of the form xxx'First .. xxx'Last and xxx'Range that could be -# replaced by xxx'Range or xxx. - @unit_check(help="simplifiable 'First .. 'Last and 'Range", category="Style", subcategory="Programming Practice") -fun use_ranges(unit) = [ - {message: "expression may be replaced by " & - (if n is AttributeRef - then n.f_prefix.text - else if n.f_left.f_prefix.p_referenced_decl() is BaseTypeDecl - then n.f_left.f_prefix.text - else n.f_left.f_prefix.text & "'Range"), - loc: n} - for n in from unit.root select - # Find 'Range in membership tests, for loop spec or case statements/expr - (AttributeRef( - f_attribute: Identifier( - p_name_is("Range"): true), - parent: ForLoopSpec | - ExprAlternativesList | - AlternativesList( - parent: CaseStmtAlternative | CaseExprAlternative), - f_prefix: Name( - p_referenced_decl(): BaseTypeDecl( - p_is_discrete_type(): true))) | - # Find T'First .. T'Last - BinOp(f_op: OpDoubleDot, - f_left: AttributeRef( - f_attribute: Identifier(p_name_is("First"): true), - f_prefix: name@Name), - f_right: AttributeRef( - f_attribute: Identifier(p_name_is("Last"): true), - f_prefix: Name(p_name_matches(name): true)))) -] +fun use_ranges(unit) = + |" Flag expressions of the form ``Name'First .. Name'Last`` that can be replaced + |" by ``Name'Range`` or simply ``Name``. Also flag expressions of the form + |" ``Name'Range`` that can be replaced with ``Name``. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3, 5 + |" + |" procedure Proc (S : String; I : in out Integer) is + |" begin + |" for J in Integer'First .. Integer'Last loop -- FLAG + |" + |" if I in Natural'Range then -- FLAG + |" for K in S'Range loop -- NO FLAG + |" I := I + K; + |" end loop; + |" end if; + |" end loop; + |" end Proc; + [ + {message: "expression may be replaced by " & + (if n is AttributeRef + then n.f_prefix.text + else if n.f_left.f_prefix.p_referenced_decl() is BaseTypeDecl + then n.f_left.f_prefix.text + else n.f_left.f_prefix.text & "'Range"), + loc: n} + for n in from unit.root select + # Find 'Range in membership tests, for loop spec or case statements/expr + (AttributeRef( + f_attribute: Identifier( + p_name_is("Range"): true), + parent: ForLoopSpec | + ExprAlternativesList | + AlternativesList( + parent: CaseStmtAlternative | CaseExprAlternative), + f_prefix: Name( + p_referenced_decl(): BaseTypeDecl( + p_is_discrete_type(): true))) | + # Find T'First .. T'Last + BinOp(f_op: OpDoubleDot, + f_left: AttributeRef( + f_attribute: Identifier(p_name_is("First"): true), + f_prefix: name@Name), + f_right: AttributeRef( + f_attribute: Identifier(p_name_is("Last"): true), + f_prefix: Name(p_name_matches(name): true)))) + ] diff --git a/lkql_checker/share/lkql/use_record_aggregates.lkql b/lkql_checker/share/lkql/use_record_aggregates.lkql index 3bb1181ea..624c39053 100644 --- a/lkql_checker/share/lkql/use_record_aggregates.lkql +++ b/lkql_checker/share/lkql/use_record_aggregates.lkql @@ -1,8 +1,3 @@ -# Flag each set of consecutive assignment (not intersperced with other -# statements) to record components when all components of the record are -# assigned, unless the record type has a single component, or has discriminants, -# or is tagged. - fun assign_stmts(n, prefix) = |" Return all consecutive AssignStmt starting at n and following siblings |" when the destination is a DottedName whose prefix matches prefix. @@ -14,6 +9,32 @@ fun assign_stmts(n, prefix) = @check(message="component assignments may be replaced by an aggregate", category="Style", subcategory="Programming Practice") fun use_record_aggregates(node) = + |" Flag the first statement in the sequence of assignment statements if the targets + |" of all these assignment statements are components of the same record objects, + |" all the components of this objects get assigned as the result of such a + |" sequence, and the type of the record object does not have discriminants. + |" This rule helps to detect cases when a sequence of assignment statements + |" can be replaced with a single assignment statement with a record aggregate + |" as an expression being assigned, there is no guarantee that it detects all + |" such sequences. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 7 + |" + |" type Rec is record + |" Comp1, Comp2 : Integer; + |" end record; + |" + |" Var1, Var2 : Rec; + |" begin + |" Var1.Comp1 := 1; -- FLAG + |" Var1.Comp2 := 2; + |" + |" Var2.Comp1 := 1; -- NO FLAG + |" I := 1; + |" Var2.Comp2 := 2; node is AssignStmt( f_dest: DottedName( f_prefix: prefix@Name, diff --git a/lkql_checker/share/lkql/use_simple_loops.lkql b/lkql_checker/share/lkql/use_simple_loops.lkql index ebbf92226..7c34656b6 100644 --- a/lkql_checker/share/lkql/use_simple_loops.lkql +++ b/lkql_checker/share/lkql/use_simple_loops.lkql @@ -1,9 +1,18 @@ -# Flag while loops where the condition is statically known to be True and which -# could be replaced by a simple loop. - @check(message="WHILE loop may be replaced by a simple LOOP", category="Style", subcategory="Programming Practice") fun use_simple_loops(node) = + |" Flag ``while`` loop statements that have a condition statically known + |" to be ``TRUE``. Such loop statements can be replaced by simple loops. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" while True loop -- FLAG + |" I := I + 10; + |" exit when I > 0; + |" end loop; # Find while loops whose condition is statically known to be True (= 1) node is WhileLoopStmt( f_spec: WhileLoopSpec(f_expr: e@Expr(p_is_static_expr(): true) diff --git a/lkql_checker/share/lkql/use_while_loops.lkql b/lkql_checker/share/lkql/use_while_loops.lkql index 98ba476c4..974cf0116 100644 --- a/lkql_checker/share/lkql/use_while_loops.lkql +++ b/lkql_checker/share/lkql/use_while_loops.lkql @@ -1,9 +1,19 @@ -# Flag simple loops where the first statement is an exit (for the same loop) -# and which could be replaced by a while loop. - @check(message="simple LOOP may be replaced by a WHILE loop", category="Style", subcategory="Programming Practice") fun use_while_loops(node) = + |" Flag simple loop statements that have the exit statement completing + |" execution of such a loop as the first statement in their sequence of + |" statements. Such loop statements can be replaced by ``WHILE`` loops. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 1 + |" + |" loop -- FLAG + |" exit when I > 0; + |" I := I + 10; + |" end loop; node is LoopStmt when node.f_stmts[1] is e@ExitStmt when (e.f_loop_name == null or diff --git a/lkql_checker/share/lkql/variable_scoping.lkql b/lkql_checker/share/lkql/variable_scoping.lkql index f92f9739e..1aa859e3f 100644 --- a/lkql_checker/share/lkql/variable_scoping.lkql +++ b/lkql_checker/share/lkql/variable_scoping.lkql @@ -1,7 +1,3 @@ -# Flag local object declarations for which all uses are inside the same more -# nested declare-block in the same subprogram, not part of a loop, and with no -# initializing expression. - import stdlib fun get_block(list) = @@ -27,23 +23,47 @@ fun check_references(list, subp) = { @unit_check(help="variables that can be moved to an inner block", category="Style", subcategory="Programming Practice") -fun variable_scoping(unit) = [ - {message: n.text & " can be moved to inner block at line " & - img(get_block(n.p_find_refs(stdlib.enclosing_body(n))) - ?.token_start().start_line + 1), - loc: n} - - # Look for defining names part of an object declaration with no default - # initialization and not a renaming, directly declared in the declarative - # part of a subprogram. - - for n in from unit.root select - node@DefiningName( - parent: DefiningNameList( - parent: decl@ObjectDecl( - f_default_expr: null, - f_renaming_clause: null, - parent: AdaNodeList( - parent: DeclarativePart(parent: subp@SubpBody))))) - when check_references(node.p_find_refs(subp), subp) -] +fun variable_scoping(unit) = + |" Flag local object declarations that can be moved into declare blocks + |" nested into the declaration scope. A declaration is considered as movable + |" into a nested scope if: + |" + |" * The declaration does not contain an initialization expression; + |" * The declared object is used only in a nested block statement, + |" and this block statement has a declare part; + |" * the block statement is not enclosed into a loop statement. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 2 + |" + |" procedure Scope is + |" X : Integer; -- FLAG + |" begin + |" declare + |" Y : Integer := 42; + |" begin + |" X := Y; + |" end; + |" end; + [ + {message: n.text & " can be moved to inner block at line " & + img(get_block(n.p_find_refs(stdlib.enclosing_body(n))) + ?.token_start().start_line + 1), + loc: n} + + # Look for defining names part of an object declaration with no default + # initialization and not a renaming, directly declared in the declarative + # part of a subprogram. + + for n in from unit.root select + node@DefiningName( + parent: DefiningNameList( + parent: decl@ObjectDecl( + f_default_expr: null, + f_renaming_clause: null, + parent: AdaNodeList( + parent: DeclarativePart(parent: subp@SubpBody))))) + when check_references(node.p_find_refs(subp), subp) + ] diff --git a/lkql_checker/share/lkql/visible_components.lkql b/lkql_checker/share/lkql/visible_components.lkql index d974c6181..ab3b5e6f1 100644 --- a/lkql_checker/share/lkql/visible_components.lkql +++ b/lkql_checker/share/lkql/visible_components.lkql @@ -1,16 +1,3 @@ -# Flag all the type declarations located in the visible part of a library -# package or a library generic package that can declare a visible component. A -# visible component can be declared in a record definition which appears on its -# own or as part of a record extension. The record definition is flagged even -# if it contains no components. -# -# Record definitions located in private parts of library (generic) packages or -# in local (generic) packages are not flagged. Record definitions in private -# packages, in package bodies, and in the main subprogram body are not flagged. -# -# This rule has the optional parameter Tagged_Only: only declarations of tagged -# types are flagged. - fun has_visible_components(t) = match t | RecordTypeDef => true @@ -20,6 +7,57 @@ fun has_visible_components(t) = @check(message="type defines publicly accessible components", category="Style", subcategory="Object Orientation") fun visible_components(node, tagged_only=false) = + |" Flag all the type declarations located in the visible part of a library + |" package or a library generic package that can declare a visible component. + |" A visible component can be declared in a *record definition* which appears + |" on its own or as part of a record extension. The *record definition* is + |" flagged even if it contains no components. + |" + |" *Record definitions* located in private parts of library (generic) packages + |" or in local (generic) packages are not flagged. *Record definitions* in + |" private packages, in package bodies, and in the main subprogram body are not + |" flagged. + |" + |" This rule has the following (optional) parameter for the ``+R`` option and + |" for LKQL rule options files: + |" + |" *Tagged_Only: bool* + |" If ``true``, only declarations of tagged types are flagged. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 3, 5, 10, 17 + |" + |" with Types; + |" package Foo is + |" type Null_Record is null record; -- FLAG + |" + |" type Not_Null_Record is record -- FLAG + |" I : Integer; + |" B : Boolean; + |" end record; + |" + |" type Tagged_Not_Null_Record is tagged record -- FLAG + |" I : Integer; + |" B : Boolean; + |" end record; + |" + |" type Private_Extension is new Types.Tagged_Private with private; + |" + |" type NoN_Private_Extension is new Types.Tagged_Private with record -- FLAG + |" B : Boolean; + |" end record; + |" + |" private + |" type Rec is tagged record + |" I : Integer; + |" end record; + |" + |" type Private_Extension is new Types.Tagged_Private with record + |" C : Rec; + |" end record; + |" end Foo; node is TypeDecl(any parent(depth=2): PublicPart( parent: BasePackageDecl(any parent: LibraryItem( f_item: PackageDecl | GenericDecl, diff --git a/lkql_checker/share/lkql/volatile_objects_without_address_clauses.lkql b/lkql_checker/share/lkql/volatile_objects_without_address_clauses.lkql index dc6644463..0281317e0 100644 --- a/lkql_checker/share/lkql/volatile_objects_without_address_clauses.lkql +++ b/lkql_checker/share/lkql/volatile_objects_without_address_clauses.lkql @@ -1,11 +1,34 @@ -# Flag each volatile object that does not have an address specification. Only -# variable declarations are checked. -# An object is considered as being volatile if a pragma or aspect Volatile is -# applied to the object or to its type, or if the object is atomic. - @check(message="volatile object with no address clause", category="Style", subcategory="Tasking") fun volatile_objects_without_address_clauses(node) = + |" Flag each volatile object that does not have an address specification. + |" Only variable declarations are checked. + |" + |" An object is considered as being volatile if a pragma or aspect Volatile + |" is applied to the object or to its type, if the object is atomic or + |" if the GNAT compiler considers this object as volatile because of some + |" code generation reasons. + |" + |" .. rubric:: Example + |" + |" .. code-block:: ada + |" :emphasize-lines: 6, 11 + |" + |" with Interfaces, System, System.Storage_Elements; + |" package Foo is + |" Variable: Interfaces.Unsigned_8 + |" with Address => System.Storage_Elements.To_Address (0), Volatile; + |" + |" Variable1: Interfaces.Unsigned_8 -- FLAG + |" with Volatile; + |" + |" type My_Int is range 1 .. 32 with Volatile; + |" + |" Variable3 : My_Int; -- FLAG + |" + |" Variable4 : My_Int + |" with Address => Variable3'Address; + |" end Foo; node is o@ObjectDecl when ( o.p_has_aspect("volatile") or o.f_type_expr.p_designated_type_decl() is diff --git a/lkql_jit/cli/src/main/java/com/adacore/lkql_jit/LKQLDoc.java b/lkql_jit/cli/src/main/java/com/adacore/lkql_jit/LKQLDocAPI.java similarity index 95% rename from lkql_jit/cli/src/main/java/com/adacore/lkql_jit/LKQLDoc.java rename to lkql_jit/cli/src/main/java/com/adacore/lkql_jit/LKQLDocAPI.java index 5067b9462..d1b8ec5e4 100644 --- a/lkql_jit/cli/src/main/java/com/adacore/lkql_jit/LKQLDoc.java +++ b/lkql_jit/cli/src/main/java/com/adacore/lkql_jit/LKQLDocAPI.java @@ -15,8 +15,10 @@ import org.graalvm.polyglot.Source; import picocli.CommandLine; -@CommandLine.Command(name = "doc", description = "Generate API doc for LKQL modules, in RST format") -public class LKQLDoc implements Callable { +@CommandLine.Command( + name = "doc-api", + description = "Generate API doc for LKQL modules, in RST format") +public class LKQLDocAPI implements Callable { @CommandLine.Option( names = "--std", description = "Generate apidoc for the prelude & builtin functions") diff --git a/lkql_jit/cli/src/main/java/com/adacore/lkql_jit/LKQLDocRules.java b/lkql_jit/cli/src/main/java/com/adacore/lkql_jit/LKQLDocRules.java new file mode 100644 index 000000000..66e47f6b2 --- /dev/null +++ b/lkql_jit/cli/src/main/java/com/adacore/lkql_jit/LKQLDocRules.java @@ -0,0 +1,572 @@ +// +// Copyright (C) 2005-2024, AdaCore +// SPDX-License-Identifier: GPL-3.0-or-later +// + +package com.adacore.lkql_jit; + +import static com.adacore.liblkqllang.Liblkqllang.*; + +import java.io.File; +import java.io.FileWriter; +import java.util.ArrayList; +import java.util.Arrays; +import java.util.Collections; +import java.util.List; +import java.util.ListIterator; +import java.util.concurrent.Callable; +import java.util.function.Consumer; +import java.util.function.Predicate; +import java.util.stream.Collectors; +import picocli.CommandLine; + +@CommandLine.Command( + name = "doc-rules", + description = "Generate rules documentation, in RST format") +public class LKQLDocRules implements Callable { + @CommandLine.Parameters( + description = "Any number of rules directories for which to generate documentation") + private List rulesDirs = new ArrayList(); + + @CommandLine.Option( + names = {"-O", "--output-dir"}, + description = "Output directory for generated RST files (default to local directory)") + private File outputDir = new File("."); + + @CommandLine.Option( + names = {"-v", "--verbose"}, + description = "Verbose mode.") + private boolean verbose; + + /** + * Helper for findAll. Visit all children of 'node', calling 'cons' on each of them. TODO: Hoist + * in Java bindings + */ + private static void visitChildren(LkqlNode node, Consumer cons) { + if (node == null || node.isNone()) { + return; + } + + for (var c : node.children()) { + if (c != null && !c.isNone()) { + cons.accept(c); + visitChildren(c, cons); + } + } + } + + /** + * Helper for refactor writers: Find all nodes that are children of root and which satisfies the + * predicate 'pred' TODO: Hoist in Java bindings + */ + public static List findAll(LkqlNode root, Predicate pred) { + var result = new ArrayList(); + visitChildren( + root, + (c) -> { + if (pred.test(c)) { + result.add(c); + } + }); + return result; + } + + /** + * Internal method: return whether unit contains a LKQL checker (assuming an AnalysisUnit + * contains only one checker). + * + * @return The corresponding FunDecl if a check is found, null otherwise. + */ + private static FunDecl isCheck(AnalysisUnit unit) { + final LkqlNode root = unit.getRoot(); + + for (var fun : findAll(root, (n) -> n instanceof FunDecl)) { + final DeclAnnotation ann = ((FunDecl) fun).fAnnotation(); + if (ann != null && !ann.isNone() && ann.fName().pSym().text.endsWith("check")) + return (FunDecl) fun; + } + + return null; + } + + /** Get a formatted string corresponding to a RST heading named 'name'. */ + private static String rstHeading(String name, Character kind) { + final String heading = "``" + name + "``"; + return heading + "\n" + kind.toString().repeat(heading.length()); + } + + /** Get a formatted string for a RST anchor named 'name'. */ + private static String rstAnchor(String name) { + return ".. _" + name + ":"; + } + + /** Get a formatted string for a RST index named 'name'. */ + private static String rstIndex(String name) { + return ".. index:: " + name.replace(" ", "_"); + } + + /** Convert the LkqlNode 'literal' to RST (simply remove the leading '|" ' chararters). */ + private static String docStringLiteralToRST(LkqlNode literal) { + final String line = literal.getText(); + return line.substring(Math.min(3, line.length())); + } + + /** Object to represent a LKQL rule for easier documentation generation. */ + private record Rule(FunDecl check, String name, String category, String subcategory) + implements Comparable { + + public Rule(FunDecl check) { + this( + check, + getRuleName(check), + getAnnotationArgument(check, "category"), + getAnnotationArgument(check, "subcategory")); + } + + private static String getRuleName(FunDecl check) { + // Format the rule name. The rule name comes either verbatim from the 'rule_name' + // annotation's argument, or from the checker's own FunDecl name, reformatted in Ada + // casing. + String name = getAnnotationArgument(check, "rule_name"); + if (name == "") { + name = check.fName().pSym().text; + name = + Arrays.stream(name.split("[_]")) + .map(s -> s.substring(0, 1).toUpperCase() + s.substring(1)) + .collect(Collectors.joining("_")); + } + return name; + } + + /** Get the argument of annotation 'name' if it exists, empty string otherwise. */ + private static String getAnnotationArgument(FunDecl check, String name) { + var ann = check.fAnnotation(); + + if (ann != null && !ann.isNone() && ann.fName().pSym().text.endsWith("check")) { + var arg = ann.pArgWithName(Symbol.create(name)); + if (!arg.isNone() && arg.pExpr() instanceof StringLiteral) { + var raw = arg.pExpr().getText(); + return raw.substring(1, raw.length() - 1); + } + } + return ""; + } + + /** When compared, rules are sorted by names. */ + @Override + public int compareTo(Rule other) { + return this.name.compareToIgnoreCase(other.name); + } + + /** Generate the RST code corresponding to this rule. */ + public String toRST() { + StringBuilder docString = new StringBuilder(500); + + docString.append(rstAnchor(this.name) + "\n\n"); + docString.append(rstHeading(this.name, subcategory.isEmpty() ? '-' : '^') + "\n\n"); + docString.append(rstIndex(this.name) + "\n\n"); + + // Get the LkqlNode documentation node associated to this rule. + var doc = this.check.pDoc(); + if (doc instanceof StringLiteral) { + docString.append(docStringLiteralToRST(doc) + "\n"); + } else if (doc instanceof BlockStringLiteral) { + for (var subBlocks : ((BlockStringLiteral) doc).fDocs().children()) { + docString.append(docStringLiteralToRST(subBlocks) + "\n"); + } + } else { + System.out.println( + "Warning: wrong or missing documentation for " + + this.name + + " (doc_node: " + + doc + + ")"); + } + + docString.append("\n\n\n"); + + return docString.toString(); + } + + /** Return whether this rule is from category 'category' and subcategory 'subcategory'. */ + public Boolean isFromCategory(String category, String subcategory) { + return this.category.equals(category) && this.subcategory.equals(subcategory); + } + } + + /** + * Print the rules for the category named 'categoryName' in file 'file'. Also, print the RST + * string 'header' as section header. + */ + private static void printCategory( + FileWriter file, List rules, String categoryName, String header) + throws Exception { + final String title = categoryName + "-Related Rules"; + file.write(rstHeading(title, '=') + "\n\n"); + file.write(rstIndex(title) + "\n\n"); + file.write(header + "\n\n\n"); + + ListIterator iter = rules.listIterator(); + while (iter.hasNext()) { + var next = iter.next(); + if (next.isFromCategory(categoryName, "")) { + file.write(next.toRST()); + iter.remove(); + } + } + } + + /** + * Print the rules for the subcategory named 'subcategoryName' (from 'categoryName') in file + * 'file'. Also, print the RST string 'header' as section header. + */ + private static void printSubcategory( + FileWriter file, + List rules, + String categoryName, + String subcategoryName, + String header) + throws Exception { + file.write(rstAnchor(subcategoryName.replace(" ", "_")) + "\n\n"); + file.write(rstHeading(subcategoryName, '-') + "\n\n"); + file.write(rstIndex(subcategoryName + "-related rules") + "\n\n"); + file.write(header + "\n\n\n"); + + ListIterator iter = rules.listIterator(); + while (iter.hasNext()) { + var next = iter.next(); + if (next.isFromCategory(categoryName, subcategoryName)) { + file.write(next.toRST()); + iter.remove(); + } + } + } + + @Override + public Integer call() throws Exception { + final AnalysisContext context = AnalysisContext.create(); + + if (verbose) System.out.println("Analysing rule files in directories: " + rulesDirs); + + // Get all lkql files from directories to analyse. + List ruleDirectoryFiles = new ArrayList<>(); + for (var dir : rulesDirs) + ruleDirectoryFiles.addAll( + Arrays.asList( + dir.listFiles(f -> f.canRead() && f.getName().endsWith(".lkql")))); + + List units = new ArrayList<>(); + + // Parse all rule files. + for (var ruleFile : ruleDirectoryFiles) { + final AnalysisUnit unit = context.getUnitFromFile(ruleFile.getPath()); + if (verbose) System.out.println(" * " + unit.getFileName()); + + if (unit.getDiagnostics().length > 0) { + System.err.println("Error while parsing \"" + unit.getFileName() + "\":"); + for (var diag : unit.getDiagnostics()) System.err.println(diag); + } else units.add(unit); + } + + // Create rules objects, only keep check/unit_check FunDecls. We need to + // use Collectors.toList() here instead of a direct call to toList() + // because we rely on the fact that the list is muttable for the + // subsequent calls to printCategory/printSubcategory (mostly for + // performace). + List rules = new ArrayList<>(); + rules = + units.stream() + .map(u -> isCheck(u)) + .filter(u -> u != null) + .map(u -> new Rule(u)) + .collect(Collectors.toList()); + + if (verbose) System.out.println("Found " + rules.size() + " rules for documentation."); + + // Sort the rules alphabetically before generating documentation. + Collections.sort(rules); + + if (!outputDir.exists()) outputDir.mkdirs(); + + // Generate the list of rules. + FileWriter listOfRules = new FileWriter(outputDir + "/list_of_rules.rst"); + + listOfRules.write( + """ + .. _List_of_Rules: + + ************************** + Alphabetical List of Rules + ************************** + + This section contains an alphabetized list of all the predefined + GNATcheck rules. + + """); + for (var r : rules) listOfRules.write("* :ref:`" + r.name + "`\n"); + + listOfRules.close(); + + // Generate rules documentation. Warning: this will consume rules in + // `checks` in the following category/subcategory order: + // + // * Style-related rules + // * Tasking-related rules + // * Object-Orientation related rules + // * Portability-related rules + // * Program Structure related rules + // * Programming Practice related rules + // * Readability-related rules + // * Feature Usage Rules + // * Metrics-related rules + // * SPARK related rules + + FileWriter predefinedRules = new FileWriter(outputDir + "/predefined_rules.rst"); + + predefinedRules.write( + """ + .. _Predefined_Rules: + + **************** + Predefined Rules + **************** + + .. index:: Predefined Rules + + The description of the rules currently implemented in ``gnatcheck`` is + given in this chapter. + The rule identifier is used as a parameter of ``gnatcheck``'s ``+R`` or ``-R`` + switches. + + Be aware that most of these rules apply to specialized coding + requirements developed by individual users and may well not make sense in + other environments. In particular, there are many rules that conflict + with one another. Proper usage of gnatcheck involves selecting the rules + you wish to apply by looking at your independently developed coding + standards and finding the corresponding gnatcheck rules. + + Unless documentation is specifying some, rules don't have any parameters. + + If not otherwise specified, a rule does not do any check for the + results of generic instantiations. + + GNATcheck's predefined rules' parameters may have the following types: + + *bool* + The parameter represents a boolean value, toggling a rule behavior. + In a LKQL rule file you have to associate a boolean value to the parameter + name: + + .. code-block:: lkql + + val rules = @{ + My_Rule: {Bool_Param: true} + } + + To specify a boolean parameter through a ``+R`` option, you just have to provide + the parameter's name to set it to true: + + .. code-block:: ada + + +RMy_Rule:Bool_Param -- 'Bool_Param' value is set to true + + *int* + The parameter is an integer value. + In a LKQL rule options file, you have to associate an integer value to the + parameter name: + + .. code-block:: lkql + + val rules = @{ + My_Rule: {N: 5} # If the rule param is named 'N' + } + + To specify it with a ``+R`` option, you can write its value right after the + rule name: + + .. code-block:: ada + + +RMy_Rule:5 -- 'My_Rule' integer param is set to 5 + + *string* + The parameter value is a string, sometimes with formatting constraints. + In a LKQL rule options file, you just have to provide a string value: + + .. code-block:: lkql + + val rules = @{ + My_Rule: {Str: \"i_am_a_string\"} # If the rule param is named 'Str' + } + + You can specify it through the ``+R`` option also by passing a string right + after the rule name: + + .. code-block:: ada + + +RMy_Rule:i_am_a_string -- 'My_Rule' string param is set to "i_am_a_string" + + *list[string]* + The parameter value is a list of string. + In a LKQL rule options file, you can use the LKQL list type to specify the + parameter value: + + .. code-block:: lkql + + val rules = @{ + My_Rule: {Lst: [\"One\", \"Two\", \"Three\"]} # If the rule param is named 'Lst' + } + + Through the ``+R`` option, you can specify it as a collection of string + parameters separated by commas: + + .. code-block:: ada + + +RMy_Rule:One,Two,Three -- 'My_Rule' string list param is set to ["One", "Two", "Three"] + + + + """); + + printCategory( + predefinedRules, + rules, + "Style", + """ + The rules in this section may be used to enforce various feature usages + consistent with good software engineering, for example + as described in Ada 95 Quality and Style. + """); + + printSubcategory( + predefinedRules, + rules, + "Style", + "Tasking", + """ + The rules in this subsection may be used to enforce various + feature usages related to concurrency. + """); + + printSubcategory( + predefinedRules, + rules, + "Style", + "Object Orientation", + """ + The rules in this subsection may be used to enforce various + feature usages related to Object-Oriented Programming. + """); + + printSubcategory( + predefinedRules, + rules, + "Style", + "Portability", + """ + The rules in this subsection may be used to enforce various + feature usages that support program portability. + """); + + printSubcategory( + predefinedRules, + rules, + "Style", + "Program Structure", + """ + The rules in this subsection may be used to enforce feature usages + related to program structure. + """); + + printSubcategory( + predefinedRules, + rules, + "Style", + "Programming Practice", + """ + The rules in this subsection may be used to enforce feature usages that + relate to program maintainability. + """); + + printSubcategory( + predefinedRules, + rules, + "Style", + "Readability", + """ + The rules described in this subsection may be used to enforce feature usages + that contribute towards readability. + """); + + printCategory( + predefinedRules, + rules, + "Feature", + """ + The rules in this section can be used to enforce specific + usage patterns for a variety of language features. + """); + + printCategory( + predefinedRules, + rules, + "Metrics", + """ + The rules in this section can be used to enforce compliance with + specific code metrics, by checking that the metrics computed for a program + lie within user-specifiable bounds. + Depending on the metric, there may be a lower bound, an upper bound, or both. + A construct is flagged if the value of the metric exceeds the upper bound + or is less than the lower bound. + + The name of any metrics rule consists of the prefix ``Metrics_`` + followed by the name of the corresponding metric: + ``Essential_Complexity``, ``Cyclomatic_Complexity``, or + ``LSLOC``. + (The 'LSLOC' acronym stands for 'Logical Source Lines Of Code'.) + The meaning and the computed values of the metrics are + the same as in *gnatmetric*. + + For the ``+R`` option, each metrics rule has a numeric parameter + specifying the bound (integer or real, depending on a metric). + + *Example:* the rule + + :: + + +RMetrics_Cyclomatic_Complexity : 7 + + + means that all bodies with cyclomatic complexity exceeding 7 will be flagged. + + To turn OFF the check for cyclomatic complexity metric, + use the following option: + + :: + + -RMetrics_Cyclomatic_Complexity + """); + + printCategory( + predefinedRules, + rules, + "SPARK", + """ + The rules in this section can be used to enforce + compliance with the Ada subset allowed by the SPARK 2005 language. + + More recent versions of SPARK support these language constructs, + so if you want to further restrict the SPARK constructs allowed + in your coding standard, you can use some of the following rules. + """); + + predefinedRules.close(); + + if (!rules.isEmpty()) { + System.err.println("Error: " + rules.size() + " rules not documented!"); + + for (var r : rules) System.out.println(r.toString()); + } + + return 0; + } +} diff --git a/lkql_jit/cli/src/main/java/com/adacore/lkql_jit/LKQLMain.java b/lkql_jit/cli/src/main/java/com/adacore/lkql_jit/LKQLMain.java index 275564cef..5e2bcade5 100644 --- a/lkql_jit/cli/src/main/java/com/adacore/lkql_jit/LKQLMain.java +++ b/lkql_jit/cli/src/main/java/com/adacore/lkql_jit/LKQLMain.java @@ -17,7 +17,8 @@ LKQLLauncher.LKQLRun.class, LKQLChecker.Args.class, GNATCheckWorker.Args.class, - LKQLDoc.class, + LKQLDocAPI.class, + LKQLDocRules.class, LKQLRefactor.class }, description = diff --git a/lkql_jit/language/src/main/java/com/adacore/lkql_jit/utils/Constants.java b/lkql_jit/language/src/main/java/com/adacore/lkql_jit/utils/Constants.java index 60b23bca0..f0591d62f 100644 --- a/lkql_jit/language/src/main/java/com/adacore/lkql_jit/utils/Constants.java +++ b/lkql_jit/language/src/main/java/com/adacore/lkql_jit/utils/Constants.java @@ -87,10 +87,13 @@ public class Constants { "execution_cost", "parametric_exemption", "impact", - "target" + "target", + "rule_name" }; /** The default values for annotation parameters. */ public static final Object[] CHECKER_PARAMETER_DEFAULT_VALUES = - new Object[] {null, null, false, "Misc", "Misc", "MEDIUM", 0L, false, "", "amd64"}; + new Object[] { + null, null, false, "Misc", "Misc", "MEDIUM", 0L, false, "", "amd64", null + }; } diff --git a/testsuite/tests/gnatcheck/xml_help/test.out b/testsuite/tests/gnatcheck/xml_help/test.out index 2886ac353..990808104 100644 --- a/testsuite/tests/gnatcheck/xml_help/test.out +++ b/testsuite/tests/gnatcheck/xml_help/test.out @@ -62,6 +62,8 @@ testsuite_driver: No output file generated by gnatcheck + + @@ -154,8 +156,6 @@ testsuite_driver: No output file generated by gnatcheck - - @@ -569,6 +569,8 @@ testsuite_driver: No output file generated by gnatcheck + + @@ -661,8 +663,6 @@ testsuite_driver: No output file generated by gnatcheck - - diff --git a/user_manual/Makefile b/user_manual/Makefile index da0c9b310..ab2efdb71 100644 --- a/user_manual/Makefile +++ b/user_manual/Makefile @@ -19,5 +19,5 @@ ROOT_DIR:=$(shell dirname $(realpath $(firstword $(MAKEFILE_LIST)))) # Catch-all target: route all unknown targets to Sphinx using the new # "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). %: Makefile - LKQL_PATH=$(ROOT_DIR)/../lkql_checker/share/lkql lkql doc --std -O generated stdlib + LKQL_PATH=$(ROOT_DIR)/../lkql_checker/share/lkql lkql doc-api --std -O generated stdlib @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O)