Merge branch 'topic/fix_kp_19142' into 'master'

Fix the KP-19142 detector

Closes #506

See merge request eng/libadalang/langkit-query-language!508

Author: HugoGGuerrier

lkql_checker/share/lkql/kp/KP-19142.lkql

@@ -8,41 +8,52 @@ fun is_assigned(id, body) =
     |" statement in the provided HandledStatements.
     {
         # Get the statements in the subp body and its exception handlers
-        val stmts = body.f_stmts.children
-            & concat([eh.f_stmts.children
-                    for eh in body.f_exceptions.children
-                    if eh is ExceptionHandler].to_list);
-        stdlib.any([s is AssignStmt when s.f_dest.p_referenced_defining_name == id
-                    for s in stmts])
+        val stmts = body.f_stmts.children & concat([
+            eh.f_stmts.children
+            for eh in body.f_exceptions.children
+            if eh is ExceptionHandler
+        ].to_list);
+        stdlib.any([
+            s.f_dest.p_referenced_defining_name() == id
+            for s in stmts
+            if s is AssignStmt
+        ])
     }
 
 fun is_unconstrained_discriminated(type_decl) =
     |" Get if the given BaseTypeDecl is an unconstrained type with a default valued
     |" discriminant.
     match type_decl
-    | SubtypeDecl  => not type_decl.f_subtype.p_subtype_constraint()
-                      and is_unconstrained_discriminated(type_decl.p_get_type())
-    | BaseTypeDecl(p_base_type(): not null)
-                   => not type_decl.f_type_def.f_subtype_indication.p_subtype_constraint()
-                      and is_unconstrained_discriminated(type_decl.p_base_type())
-    | BaseTypeDecl(p_private_completion(): not null)
-                   => is_unconstrained_discriminated(type_decl.p_private_completion())
+    | SubtypeDecl => not type_decl.f_subtype.p_subtype_constraint()
+                     and is_unconstrained_discriminated(type_decl.p_get_type())
+    | BaseTypeDecl(
+        p_base_type(): not null
+    ) => not type_decl.f_type_def.f_subtype_indication.p_subtype_constraint()
+         and is_unconstrained_discriminated(type_decl.p_base_type())
+    | BaseTypeDecl(
+        p_private_completion(): not null
+    ) => is_unconstrained_discriminated(type_decl.p_private_completion())
     # TODO: Remove the 'p_discriminants_list' parameter when langkit#776 will be resolved
-    | BaseTypeDecl => stdlib.any([d.f_default_expr != null
-                                  for d in type_decl.p_discriminants_list(type_decl.p_root_type())])
-    | *            => false
+    | BaseTypeDecl => stdlib.any([
+        d.f_default_expr != null
+        for d in type_decl.p_discriminants_list(type_decl.p_root_type())
+    ])
+    | * => false
 
 @check(help="possible occurrence of KP 19142",
        message="possible occurrence of KP 19142")
 fun kp_19142(node) =
     node is SubpBody
     # Check that the subprogram is overriding
     when node.p_root_subp_declarations()
-     # Check that the subprogram hasn't been declared earlier, otherwise the KP
-     # won't happen.
-     and not node.p_decl_part()
-     and stdlib.any([stdlib.any([is_assigned(id, node.f_stmts)
-                                 for id in p.f_ids.children])
-                     for p in node.f_subp_spec.p_params()
-                     if is_unconstrained_discriminated(p.p_formal_type())
-                        and p.f_mode is (ModeOut | ModeInOut)])
+    # Check that the subprogram hasn't been declared earlier, otherwise the KP
+    # won't happen.
+    and not node.p_decl_part()
+    and stdlib.any([
+        stdlib.any([
+            is_assigned(id, node.f_stmts) for id in p.f_ids.children
+        ])
+        for p in node.f_subp_spec.p_params()
+        if is_unconstrained_discriminated(p.p_formal_type())
+           and p.f_mode is (ModeOut | ModeInOut)
+    ])

testsuite/tests/checks/KP-19142/test.out

@@ -0,0 +1,28 @@
+main.adb:17:19: rule violation: possible occurrence of KP 19142
+17 |         procedure Test_Implicit (I : Implicit; Mut : out Mutable) is  -- FLAG
+   |                   ^^^^^^^^^^^^^
+
+main.adb:29:30: rule violation: possible occurrence of KP 19142
+29 |         overriding procedure Test_Explicit (I : Explicit; Mut : out Mutable) is  -- FLAG
+   |                              ^^^^^^^^^^^^^
+
+main.adb:44:19: rule violation: possible occurrence of KP 19142
+44 |         procedure Test_Subtype (I : Sub; Mut : out Sub_Mutable) is  -- FLAG
+   |                   ^^^^^^^^^^^^
+
+main.adb:51:19: rule violation: possible occurrence of KP 19142
+51 |         procedure Test_Derived (I : Derived; Mut : out Derived_Mutable) is  -- FLAG
+   |                   ^^^^^^^^^^^^
+
+main.adb:58:19: rule violation: possible occurrence of KP 19142
+58 |         procedure Test_Private (I : Priv; Mut: out Private_Mutable) is  -- FLAG
+   |                   ^^^^^^^^^^^^
+
+main.adb:65:19: rule violation: possible occurrence of KP 19142
+65 |         procedure Test_Read_And_Write (I : Read_And_Write; Mut : in out Mutable) is  -- FLAG
+   |                   ^^^^^^^^^^^^^^^^^^^
+
+main.adb:72:19: rule violation: possible occurrence of KP 19142
+72 |         procedure Test_Exc_Hand (I : Exc_Hand; Mut : out Mutable) is  -- FLAG
+   |                   ^^^^^^^^^^^^^
+

testsuite/tests/checks/KP-19142/test.yaml

@@ -1,5 +1,3 @@
 driver: checker
-rule_name: KP_19142
+rule_name: kp_19142
 project: prj.gpr
-control:
-  - ["XFAIL", "True", "KP detector is invalid (eng/libadalang/langkit-query-language#506)"]