Add Lowercase_Keywords check

Author: raph-amiard

lkql_checker/doc/generated/list_of_rules.rst

@@ -87,6 +87,7 @@ GNATcheck rules.
 * :ref:`Local_Instantiations`
 * :ref:`Local_Packages`
 * :ref:`Local_USE_Clauses`
+* :ref:`Lowercase_Keywords`
 * :ref:`Max_Identifier_Length`
 * :ref:`Maximum_Expression_Complexity`
 * :ref:`Maximum_Lines`

lkql_checker/doc/generated/predefined_rules.rst

@@ -5963,6 +5963,31 @@ the definition of exemption sections are:
 
 
 
+.. _Lowercase_Keywords:
+
+``Lowercase_Keywords``
+^^^^^^^^^^^^^^^^^^^^^^
+
+.. index:: Lowercase_Keywords
+
+Flag Ada keywords that are not purely lowercase, such as ``BEGIN`` or
+``beGin``.
+
+Please note that this check is **not** language version sensitive. Every
+keyword from Ada 83 to Ada 2012 will be flagged. This means that this
+check might give false positives on usage of identifiers that are
+keywords in newer versions of Ada.
+
+.. rubric:: Example
+
+.. code-block:: ada
+   :emphasize-lines: 1,2
+
+   packagE Foo is -- FLAG
+   END Foo; -- FLAG
+
+
+
 .. _Max_Identifier_Length:
 
 ``Max_Identifier_Length``

lkql_checker/share/lkql/lowercase_keywords.lkql

@@ -0,0 +1,49 @@
+val re_83 =
+    "abort|abs|accept|access|aliased|all|and|array|"
+    & "at|begin|body|case|constant|declare|delay|delta|digits|"
+    & "do|else|elsif|end|entry|exception|exit|for|function|"
+    & "generic|goto|if|in|is|limited|loop|mod|new|"
+    & "not|null|others|out|of|or|package|pragma|"
+    & "private|procedure|raise|range|record|rem|"
+    & "renames|return|reverse|select|separate|"
+    & "subtype|task|terminate|then|type|"
+    & "use|when|while|with|xor"
+val re_95 = "abstract|protected|requeue|tagged|until"
+val re_2005 = "interface|overriding|synchronized"
+val re_2012 = "some"
+
+@memoized
+fun keyword_matcher(language_version) =
+    |" Return a regex matcher that matches keywords, given a language version
+    pattern("^(" & (match language_version
+                    | "ada_83" => re_83
+                    | "ada_95" => re_83 & "|" & re_95
+                    | "ada_2005" => re_83 & "|" & re_95 & "|" & re_2005
+                    | "ada_2012" => re_83 & "|" & re_95 & "|" & re_2005 & "|" & re_2012
+                    | "ada_2022" => re_83 & "|" & re_95 & "|" & re_2005 & "|" & re_2012) & ")$")
+
+val match_uppercase = pattern("[A-Z]+")
+
+@unit_check(category="Style", subcategory="Readability")
+fun lowercase_keywords(unit, language_version="ada_2022") =
+    |" Flag Ada keywords that are not purely lowercase, such as ``BEGIN`` or
+    |" ``beGin``.
+    |"
+    |" Please note that this check is **not** language version sensitive. Every
+    |" keyword from Ada 83 to Ada 2012 will be flagged. This means that this
+    |" check might give false positives on usage of identifiers that are
+    |" keywords in newer versions of Ada.
+    |"
+    |" .. rubric:: Example
+    |"
+    |" .. code-block:: ada
+    |"    :emphasize-lines: 1,2
+    |"
+    |"    packagE Foo is -- FLAG
+    |"    END Foo; -- FLAG
+    [
+        {message: "Keyword should be lowercase", loc: tok}
+        for tok in unit.tokens
+        if tok.text.to_lower_case.contains(keyword_matcher(language_version))
+            and tok.text.contains(match_uppercase)
+    ]

testsuite/tests/gnatcheck/xml_help/test.out

@@ -386,6 +386,7 @@ testsuite_driver: No output file generated by gnatcheck
          <default-value-dependency master-switch="+Ridentifier_suffixes:Default" slave-switch="+Ridentifier_suffixes:Access_Suffix=_A"/>
          <default-value-dependency master-switch="+Ridentifier_suffixes:Default" slave-switch="+Ridentifier_suffixes:Constant_Suffix=_C"/>
          <default-value-dependency master-switch="+Ridentifier_suffixes:Default" slave-switch="+Ridentifier_suffixes:Renaming_Suffix=_R"/>
+         <field switch="+Rlowercase_keywords" separator=":" label="lowercase_keywords"/>
          <spin switch="+Rmax_identifier_length" label="maximal identifier length" min="0" max="99999" default="-1" separator=":"/>
          <spin switch="+Rmin_identifier_length" label="identifier too short" min="0" max="99999" default="-1" separator=":"/>
          <check switch="+Rmisnamed_controlling_parameters" label="first parameter should have name 'This' and proper type"/>
@@ -899,6 +900,7 @@ testsuite_driver: No output file generated by gnatcheck
          <default-value-dependency master-switch="+Ridentifier_suffixes:Default" slave-switch="+Ridentifier_suffixes:Access_Suffix=_A"/>
          <default-value-dependency master-switch="+Ridentifier_suffixes:Default" slave-switch="+Ridentifier_suffixes:Constant_Suffix=_C"/>
          <default-value-dependency master-switch="+Ridentifier_suffixes:Default" slave-switch="+Ridentifier_suffixes:Renaming_Suffix=_R"/>
+         <field switch="+Rlowercase_keywords" separator=":" label="lowercase_keywords"/>
          <spin switch="+Rmax_identifier_length" label="maximal identifier length" min="0" max="99999" default="-1" separator=":"/>
          <spin switch="+Rmin_identifier_length" label="identifier too short" min="0" max="99999" default="-1" separator=":"/>
          <check switch="+Rmisnamed_controlling_parameters" label="first parameter should have name 'This' and proper type"/>