Merge branch 'topic/lowercase_keywords_2' into 'master'

HugoGGuerrier · HugoGGuerrier · commit 0077283fed38 · 2025-07-15T13:16:18.000Z
Fix lowercase_keywords rule

See merge request eng/libadalang/langkit-query-language!469
diff --git a/lkql_checker/doc/generated/list_of_rules.rst b/lkql_checker/doc/generated/list_of_rules.rst
@@ -140,7 +140,7 @@ GNATcheck rules.
 * :ref:`Overloaded_Operators`
 * :ref:`Overly_Nested_Control_Structures`
 * :ref:`Overly_Nested_Scopes`
-* :ref:`Overriding_Marks`
+* :ref:`Overriding_Indicators`
 * :ref:`Parameters_Aliasing`
 * :ref:`Parameters_Out_Of_Order`
 * :ref:`POS_On_Enumeration_Types`
diff --git a/lkql_checker/doc/generated/predefined_rules.rst b/lkql_checker/doc/generated/predefined_rules.rst
@@ -6251,12 +6251,12 @@ first construct is flagged
 
 
 
-.. _Overriding_Marks:
+.. _Overriding_Indicators:
 
-``Overriding_Marks``
-^^^^^^^^^^^^^^^^^^^^
+``Overriding_Indicators``
+^^^^^^^^^^^^^^^^^^^^^^^^^
 
-.. index:: Overriding_Marks
+.. index:: Overriding_Indicators
 
 Check that overriding subprograms are explicitly marked as such.
 
diff --git a/lkql_checker/share/lkql/lowercase_keywords.lkql b/lkql_checker/share/lkql/lowercase_keywords.lkql
@@ -45,8 +45,10 @@ fun lowercase_keywords(unit, language_version="ada_2022") =
     |"    packagE Foo is -- FLAG
     |"    END Foo; -- FLAG
     [
-        {message: "Keyword should be lowercase", loc: tok}
+        {message: "reserved words should be lowercase", loc: tok}
         for tok in unit.tokens
         if tok.text.to_lower_case.contains(keyword_matcher(language_version))
+            and not tok.previous().kind == "tick"
             and tok.text.contains(match_uppercase)
+
     ]
diff --git a/lkql_checker/share/lkql/no_dependence.lkql b/lkql_checker/share/lkql/no_dependence.lkql
@@ -1,6 +1,6 @@
 import stdlib
 
-@check(category="Style", subcategory="Readability", message="Forbidden dependency")
+@check(category="Style", subcategory="Readability", message="forbidden dependence")
 fun no_dependence(node, unit_names=[]) =
     |" Flag every explicit dependency (with clause) to any of the library units
     |" designated by names passed as parameters.
diff --git a/lkql_checker/share/lkql/overriding_indicators.lkql b/lkql_checker/share/lkql/overriding_indicators.lkql
@@ -42,8 +42,23 @@ fun match_signature(child_prim, parent_prim, child_type, parent_type) =
     }
 }
 
-@check(category="Style", subcategory="Readability", message="Missing overriding mark")
-fun overriding_marks(node) =
+fun is_overriding_subprogram(node) =
+    |" Returns whether the node passed as argument corresponds to an overriding
+    |" subprogram
+    node is (BasicSubpDecl | BaseSubpBody) (
+        p_subp_spec_or_null(): BaseSubpSpec(
+            p_primitive_subp_first_type(): t@TypeDecl(
+                p_base_type(): bt@TypeDecl(
+                    p_get_primitives(): primitives@(not null)
+                    when stdlib.any([p for p in primitives if match_signature(node, p, t, bt)])
+                )
+            )
+        )
+    )
+
+
+@check(category="Style", subcategory="Readability", message="missing overriding indicator")
+fun overriding_indicators(node) =
     |" Check that overriding subprograms are explicitly marked as such.
     |"
     |" This applies to all subprograms of a derived type that override a
@@ -70,18 +85,15 @@ fun overriding_marks(node) =
     |"      procedure Prim (Self : B) is null; -- FLAG
     |"    end Foo;
     # Select primitives subprograms
-    node is (BasicSubpDecl | BaseSubpBody) (
-        p_subp_spec_or_null(): BaseSubpSpec(
-            p_primitive_subp_first_type(): t@TypeDecl(
-                p_base_type(): bt@TypeDecl(
-                    p_get_primitives(): primitives@(not null)
-                    when stdlib.any([p for p in primitives if match_signature(node, p, t, bt)])
-                )
-            )
-        ),
-        f_overriding: OverridingUnspecified
+    (
+        node is (BasicSubpDecl | BaseSubpBody) (f_overriding: OverridingUnspecified)
+        when is_overriding_subprogram(node)
     )
 
     # Body stubs can also take an "overriding" indicator. In that case, check
     # the body.
-    or node is SubpBodyStub(p_previous_part_for_decl(): dcl) when overriding_marks(dcl)
+    or (
+        node is SubpBodyStub(p_previous_part_for_decl(): dcl,
+                            f_overriding: OverridingUnspecified)
+        when is_overriding_subprogram(dcl)
+    )
diff --git a/testsuite/tests/checks/lowercase_keywords/83/test.out b/testsuite/tests/checks/lowercase_keywords/83/test.out
@@ -0,0 +1,8 @@
+test_83.adb:1:1: rule violation: reserved words should be lowercase
+1 | procedurE Test_83 IS -- FLAG (2)
+  | ^^^^^^^^^
+
+test_83.adb:1:19: rule violation: reserved words should be lowercase
+1 | procedurE Test_83 IS -- FLAG (2)
+  |                   ^^
+
diff --git a/testsuite/tests/checks/lowercase_keywords/83/test.yaml b/testsuite/tests/checks/lowercase_keywords/83/test.yaml
@@ -0,0 +1,5 @@
+driver: 'checker'
+rule_name: lowercase_keywords
+input_sources: ['test_83.adb']
+rule_arguments:
+    lowercase_keywords.language_version: '"ada_83"'
diff --git a/testsuite/tests/checks/lowercase_keywords/83/test_83.adb b/testsuite/tests/checks/lowercase_keywords/83/test_83.adb
@@ -0,0 +1,6 @@
+procedurE Test_83 IS -- FLAG (2)
+   A : InterfacE;  -- NOFLAG
+   B : TaggeD;  -- NOFLAG
+begin
+   null;
+end Test_83;
diff --git a/testsuite/tests/checks/lowercase_keywords/95/test.out b/testsuite/tests/checks/lowercase_keywords/95/test.out
@@ -0,0 +1,8 @@
+test_95.adb:2:14: rule violation: reserved words should be lowercase
+2 |    type A is Abstract Tagged null record; -- FLAG (2)
+  |              ^^^^^^^^
+
+test_95.adb:2:23: rule violation: reserved words should be lowercase
+2 |    type A is Abstract Tagged null record; -- FLAG (2)
+  |                       ^^^^^^
+
diff --git a/testsuite/tests/checks/lowercase_keywords/95/test.yaml b/testsuite/tests/checks/lowercase_keywords/95/test.yaml
@@ -0,0 +1,5 @@
+driver: 'checker'
+rule_name: lowercase_keywords
+input_sources: ['test_95.adb']
+rule_arguments:
+    lowercase_keywords.language_version: '"ada_95"'
diff --git a/testsuite/tests/checks/lowercase_keywords/95/test_95.adb b/testsuite/tests/checks/lowercase_keywords/95/test_95.adb
@@ -0,0 +1,5 @@
+procedure Test_83 is
+   type A is Abstract Tagged null record; -- FLAG (2)
+begin
+   null;
+end Test_83;
diff --git a/testsuite/tests/checks/lowercase_keywords/default/test.adb b/testsuite/tests/checks/lowercase_keywords/default/test.adb
@@ -0,0 +1,9 @@
+procedurE Test is  -- FLAG
+   B : Integer;
+   A : access Integer := B'Access;  -- NOFLAG
+begin  -- NOFLAG
+   DECLARE  -- FLAG
+   begin
+      NULL;  -- FLAG
+   end;
+end Test; -- NOFLAG
diff --git a/testsuite/tests/checks/lowercase_keywords/default/test.out b/testsuite/tests/checks/lowercase_keywords/default/test.out
@@ -0,0 +1,12 @@
+test.adb:1:1: rule violation: reserved words should be lowercase
+1 | procedurE Test is  -- FLAG
+  | ^^^^^^^^^
+
+test.adb:5:4: rule violation: reserved words should be lowercase
+5 |    DECLARE  -- FLAG
+  |    ^^^^^^^
+
+test.adb:7:7: rule violation: reserved words should be lowercase
+7 |       NULL;  -- FLAG
+  |       ^^^^
+
diff --git a/testsuite/tests/checks/lowercase_keywords/default/test.yaml b/testsuite/tests/checks/lowercase_keywords/default/test.yaml
@@ -0,0 +1,3 @@
+driver: 'checker'
+rule_name: lowercase_keywords
+input_sources: ['test.adb']
diff --git a/testsuite/tests/checks/no_dependence/test.out b/testsuite/tests/checks/no_dependence/test.out
@@ -1,8 +1,8 @@
-test.adb:1:6: rule violation: Forbidden dependency
+test.adb:1:6: rule violation: forbidden dependence
 1 | with Ada.Unchecked_Conversion; -- FLAG
   |      ^^^^^^^^^^^^^^^^^^^^^^^^
 
-test.adb:2:6: rule violation: Forbidden dependency
+test.adb:2:6: rule violation: forbidden dependence
 2 | with Unchecked_Conversion; -- FLAG
   |      ^^^^^^^^^^^^^^^^^^^^
 
diff --git a/testsuite/tests/checks/overriding_indicators/test-prim3.adb b/testsuite/tests/checks/overriding_indicators/test-prim3.adb
diff --git a/testsuite/tests/checks/overriding_indicators/test.adb b/testsuite/tests/checks/overriding_indicators/test.adb
diff --git a/testsuite/tests/checks/overriding_indicators/test.ads b/testsuite/tests/checks/overriding_indicators/test.ads
diff --git a/testsuite/tests/checks/overriding_indicators/test.out b/testsuite/tests/checks/overriding_indicators/test.out
@@ -1,48 +1,48 @@
-test.ads:8:14: rule violation: Missing overriding mark
+test.ads:8:14: rule violation: missing overriding indicator
 8 |    procedure Prim1 (Self : T2; Other : Integer); -- FLAG
   |              ^^^^^
 
-test.ads:9:13: rule violation: Missing overriding mark
+test.ads:9:13: rule violation: missing overriding indicator
 9 |    function Prim2 (Self : T2; Other : Integer) return String; -- FLAG
   |             ^^^^^
 
-test.ads:11:13: rule violation: Missing overriding mark
+test.ads:11:13: rule violation: missing overriding indicator
 11 |    function Prim4 (Self : T2) return Integer is (12) --  FLAG;
    |             ^^^^^
 
-test.ads:30:14: rule violation: Missing overriding mark
+test.ads:30:14: rule violation: missing overriding indicator
 30 |    procedure Prim1 (Self : T6; Other : Integer);  -- FLAG
    |              ^^^^^
 
-test.ads:31:13: rule violation: Missing overriding mark
+test.ads:31:13: rule violation: missing overriding indicator
 31 |    function Prim2 (Self : T6; Other : Integer) return String; -- FLAG
    |             ^^^^^
 
-test.ads:32:14: rule violation: Missing overriding mark
+test.ads:32:14: rule violation: missing overriding indicator
 32 |    procedure Prim3 (Self : T6; Other : Integer);  -- FLAG
    |              ^^^^^
 
-test.adb:9:14: rule violation: Missing overriding mark
+test.adb:9:14: rule violation: missing overriding indicator
 9 |    procedure Prim1 (Self : T2; Other : Integer) is null;  -- FLAG
   |              ^^^^^
 
-test.adb:10:13: rule violation: Missing overriding mark
+test.adb:10:13: rule violation: missing overriding indicator
 10 |    function Prim2 (Self : T2; Other : Integer) return String   --  FLAG
    |             ^^^^^
 
-test.adb:39:14: rule violation: Missing overriding mark
+test.adb:39:14: rule violation: missing overriding indicator
 39 |    procedure Prim1 (Self : T6; Other : Integer) is null;  -- FLAG
    |              ^^^^^
 
-test.adb:40:13: rule violation: Missing overriding mark
+test.adb:40:13: rule violation: missing overriding indicator
 40 |    function Prim2 (Self : T6; Other : Integer) return String  --  FLAG
    |             ^^^^^
 
-test.adb:48:14: rule violation: Missing overriding mark
+test.adb:48:14: rule violation: missing overriding indicator
 48 |    procedure Prim3 (Self : T6; Other : Integer) is separate;  --  FLAG
    |              ^^^^^
 
-test-prim3.adb:2:11: rule violation: Missing overriding mark
+test-prim3.adb:2:11: rule violation: missing overriding indicator
 2 | procedure Prim3 (Self : T6; Other : Integer) is  --  FLAG
   |           ^^^^^
 
diff --git a/testsuite/tests/checks/overriding_indicators/test.yaml b/testsuite/tests/checks/overriding_indicators/test.yaml
@@ -1,3 +1,3 @@
 driver: 'checker'
-rule_name: overriding_marks
+rule_name: overriding_indicators
 input_sources: ['test.ads', 'test.adb', 'test-prim3.adb']
diff --git a/testsuite/tests/gnatcheck/xml_help/test.out b/testsuite/tests/gnatcheck/xml_help/test.out
@@ -395,11 +395,11 @@ testsuite_driver: No output file generated by gnatcheck
          <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"/>
          <field switch="+Rname_clashes" separator=":" label="use of forbidden identifier"/>
-         <field switch="+Rno_dependence" separator=":" label="Forbidden dependency"/>
+         <field switch="+Rno_dependence" separator=":" label="forbidden dependence"/>
          <check switch="+Rnumeric_format" label="incorrect format for numeric literal"/>
          <check switch="+Robject_declarations_out_of_order" label="object declarations should precede program unit declarations"/>
          <check switch="+Rone_construct_per_line" label="more than one construct on the same line"/>
-         <check switch="+Roverriding_marks" label="Missing overriding mark"/>
+         <check switch="+Roverriding_indicators" label="missing overriding indicator"/>
          <check switch="+Rprofile_discrepancies" label="parameter profile discrepancies"/>
          <check switch="+Runcommented_begin" label="BEGIN not marked with entity name comment"/>
          <check switch="+Runcommented_begin_in_package_bodies" label="BEGIN in package bodies not marked with package name comment"/>
@@ -915,11 +915,11 @@ testsuite_driver: No output file generated by gnatcheck
          <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"/>
          <field switch="+Rname_clashes" separator=":" label="use of forbidden identifier"/>
-         <field switch="+Rno_dependence" separator=":" label="Forbidden dependency"/>
+         <field switch="+Rno_dependence" separator=":" label="forbidden dependence"/>
          <check switch="+Rnumeric_format" label="incorrect format for numeric literal"/>
          <check switch="+Robject_declarations_out_of_order" label="object declarations should precede program unit declarations"/>
          <check switch="+Rone_construct_per_line" label="more than one construct on the same line"/>
-         <check switch="+Roverriding_marks" label="Missing overriding mark"/>
+         <check switch="+Roverriding_indicators" label="missing overriding indicator"/>
          <check switch="+Rprofile_discrepancies" label="parameter profile discrepancies"/>
          <check switch="+Runcommented_begin" label="BEGIN not marked with entity name comment"/>
          <check switch="+Runcommented_begin_in_package_bodies" label="BEGIN in package bodies not marked with package name comment"/>

Original file line number	Diff line number	Diff line change
`@@ -45,8 +45,10 @@ fun lowercase_keywords(unit, language_version="ada_2022") =`
`45`	`45`	`\|" packagE Foo is -- FLAG`
`46`	`46`	`\|" END Foo; -- FLAG`
`47`	`47`	`[`
`48`		`- {message: "Keyword should be lowercase", loc: tok}`
	`48`	`+ {message: "reserved words should be lowercase", loc: tok}`
`49`	`49`	`for tok in unit.tokens`
`50`	`50`	`if tok.text.to_lower_case.contains(keyword_matcher(language_version))`
	`51`	`+ and not tok.previous().kind == "tick"`
`51`	`52`	`and tok.text.contains(match_uppercase)`
	`53`	`+`
`52`	`54`	`]`