Merge branch 'mr/thevenoux/langkit-query-language#552' into 'master'

Add detector for KP-20112

Closes #552

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

Author: thvnx

lkql_checker/share/lkql/kp/kp_20112.lkql

@@ -0,0 +1,26 @@
+import stdlib
+
+fun has_convention(node, convention) =
+    |" Return whether ``node`` has the Convention aspect sets to ``convention``.
+    {
+        val aspect = node.p_get_aspect("Convention");
+
+        aspect.exists
+        and aspect.value.text.to_lower_case == convention.to_lower_case
+    }
+
+@check(help="possible occurrence of KP 20112",
+       message="possible occurrence of KP 20112")
+fun kp_20112(node) =
+    |" Flag a convention-C anonymous access-to-subprogram types with a profile
+    |" that includes a parameter of a type for which a convention of
+    |" C_Pass_By_Copy is specified.
+    node is AnonymousTypeDecl
+    when node.f_type_def is as@AccessToSubpDef
+        when stdlib.any([
+            p is BasicDecl and has_convention(p, "C") for p in node.parents()
+        ]) and stdlib.any([
+            p.f_type_expr.p_designated_type_decl() is td@BaseTypeDecl
+                when has_convention(td, "C_Pass_By_Copy")
+            for p in as.f_subp_spec.f_subp_params.f_params.children
+        ])

testsuite/tests/checks/KP-20112/prj.gpr

@@ -0,0 +1,2 @@
+project Prj is
+end Prj;

testsuite/tests/checks/KP-20112/test.ads

@@ -0,0 +1,23 @@
+package Test is
+   type T is record
+      I : Integer;
+   end record;
+
+   type S is record
+      V : Integer;
+   end record with Convention => C_Pass_By_Copy;
+
+   type R is record
+      Callback : access procedure (Val : S) with Convention => C;  --  FLAG
+   end record with Convention => C;
+
+   function Get return access procedure (Val : S);  --  NOFLAG
+
+   type Acc is access procedure (Val : S) with Convention => C;  --  NOFLAG
+
+   function Foo return access procedure (Val : T) with Convention => C;  --  NOGLAG
+
+   function Bar return access procedure (Val : S);  -- NOGLAG
+
+   function Baz return access procedure (Val : T; Vbl : S; Vcl : R) with Convention => C;  --  FLAG
+end Test;

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

@@ -0,0 +1,8 @@
+test.ads:11:18: rule violation: possible occurrence of KP 20112
+11 |       Callback : access procedure (Val : S) with Convention => C;  --  FLAG
+   |                  ^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+test.ads:22:24: rule violation: possible occurrence of KP 20112
+22 |    function Baz return access procedure (Val : T; Vbl : S; Vcl : R) with Convention => C;  --  FLAG
+   |                        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+

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

@@ -0,0 +1,3 @@
+driver: checker
+rule_name: kp_20112
+project: prj.gpr

testsuite/tests/gnatcheck/xml_help/test.out

@@ -98,6 +98,7 @@ testsuite_driver: No output file generated by gnatcheck
       <check switch="+Rkp_19997" label="possible occurrence of KP 19997"/>
       <check switch="+Rkp_20023" label="possible occurrence of KP 20023"/>
       <check switch="+Rkp_20089" label="possible occurrence of KP 20089"/>
+      <check switch="+Rkp_20112" label="possible occurrence of KP 20112"/>
       <check switch="+Rkp_20113" label="possible occurrence of KP 20113"/>
       <check switch="+Rkp_20186" label="possible occurrence of KP 20186"/>
       <check switch="+Rkp_ob03_009" label="possible occurrence of KP OB03-009"/>
@@ -623,6 +624,7 @@ testsuite_driver: No output file generated by gnatcheck
       <check switch="+Rkp_19997" label="possible occurrence of KP 19997"/>
       <check switch="+Rkp_20023" label="possible occurrence of KP 20023"/>
       <check switch="+Rkp_20089" label="possible occurrence of KP 20089"/>
+      <check switch="+Rkp_20112" label="possible occurrence of KP 20112"/>
       <check switch="+Rkp_20113" label="possible occurrence of KP 20113"/>
       <check switch="+Rkp_20186" label="possible occurrence of KP 20186"/>
       <check switch="+Rkp_ob03_009" label="possible occurrence of KP OB03-009"/>