Merge branch 'mr/kp-18801' into 'master'

Add KP detector for eng/toolchain/gnat#482

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

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

@@ -0,0 +1,53 @@
+# Flag equality operations in a generic package, where one of the operands is
+# a call to an overloaded function declared in the generic package whose
+# result type is declared outside the package.
+
+import stdlib
+
+fun is_overloaded(n) = {
+    val d    = if n is BodyNode then n.p_decl_part() else n;
+    val decl = if d == null then n else d;
+
+    decl is (ClassicSubpDecl or BaseSubpBody) and
+    decl.f_subp_spec.f_subp_name is name@DefiningName
+    when (decl is *(any prev_siblings is sib@SubpDecl
+                   when sib.f_subp_spec.f_subp_name.p_name_matches(name)) or
+          decl is *(any next_siblings is sib@SubpDecl
+                   when sib.f_subp_spec.f_subp_name.p_name_matches(name)))
+}
+
+fun is_wrong_call(n, pkg) =
+   # n is a function call
+   n is Name(p_is_call() is true,
+   # declared in pkg
+             any stdlib.semantic_parent() is
+                 p@GenericPackageDecl when p == pkg,
+             p_referenced_decl() is decl@*)
+   # and is overloaded
+   when is_overloaded(decl)
+   # and the result type is declared outside pkg
+    and n.p_expression_type() is not
+        BasicDecl(any stdlib.semantic_parent is p@GenericPackageDecl
+                  when p == pkg)
+
+fun check_params(n) = {
+    val pkg = [p for p in stdlib.semantic_parent(n)
+               if p is GenericPackageDecl]?[1];
+
+    # n is inside a generic package
+    pkg is AdaNode and
+    # and one of its operands is a problematic function call
+    match n
+    | BinOp    => is_wrong_call(n.f_right, pkg) or is_wrong_call(n.f_left, pkg)
+    | CallExpr => is_wrong_call(n.f_suffix[1].f_r_expr, pkg) or
+                  is_wrong_call(n.f_suffix[2].f_r_expr, pkg)
+    | *        => false
+}
+
+@check(help="possible occurrence of KP 18801",
+       message="possible occurrence of KP 18801",
+       impact="23.*,24.*")
+fun kp_18801(node) =
+    node is (BinOp(f_op is OpEq) or
+             CallExpr(p_kind() is "call") when node.f_name.p_name_is("\"=\""))
+    when check_params(node)

testsuite/tests/checks/KP-18801/g1.adb

@@ -0,0 +1,24 @@
+package body G1 is
+
+  function Get return String is
+  begin
+     return "";
+  end Get;
+
+  function Get return Natural is
+  begin
+    if Get = "" then           --  FLAG
+      return 0;
+    elsif "=" ("", Get) then   --  FLAG
+      return 0;
+    else
+      return 1;
+    end if;
+  end Get;
+
+  function Get return Q.S is
+  begin
+    return Q.None;
+  end Get;
+
+end G1;

testsuite/tests/checks/KP-18801/g1.ads

@@ -0,0 +1,12 @@
+with Q;
+
+generic
+package G1 is
+
+  function Get return String;
+
+  function Get return Natural;
+
+  function Get return Q.S;
+
+end G1;

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

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

testsuite/tests/checks/KP-18801/q.ads

@@ -0,0 +1,7 @@
+package Q is
+
+  type S is new String (1 .. 10);
+
+  None : constant S := (others => ' ');
+
+end Q;

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

@@ -0,0 +1,8 @@
+g1.adb:10:8: rule violation: possible occurrence of KP 18801
+10 |     if Get = "" then           --  FLAG
+   |        ^^^^^^^^
+
+g1.adb:12:11: rule violation: possible occurrence of KP 18801
+12 |     elsif "=" ("", Get) then   --  FLAG
+   |           ^^^^^^^^^^^^^
+

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

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