Skip to content

Commit

Permalink
Merge branch 'mr/kp-18801' into 'master'
Browse files Browse the repository at this point in the history
Add KP detector for eng/toolchain/gnat#482

See merge request eng/libadalang/langkit-query-language!148
  • Loading branch information
ArnaudCharlet committed Nov 27, 2023
2 parents 32de4d0 + d97caa5 commit b59bd47
Show file tree
Hide file tree
Showing 7 changed files with 109 additions and 0 deletions.
53 changes: 53 additions & 0 deletions lkql_checker/share/lkql/kp/KP-18801.lkql
Original file line number Diff line number Diff line change
@@ -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)
24 changes: 24 additions & 0 deletions testsuite/tests/checks/KP-18801/g1.adb
Original file line number Diff line number Diff line change
@@ -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;
12 changes: 12 additions & 0 deletions testsuite/tests/checks/KP-18801/g1.ads
Original file line number Diff line number Diff line change
@@ -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;
2 changes: 2 additions & 0 deletions testsuite/tests/checks/KP-18801/prj.gpr
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
project Prj is
end Prj;
7 changes: 7 additions & 0 deletions testsuite/tests/checks/KP-18801/q.ads
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
package Q is

type S is new String (1 .. 10);

None : constant S := (others => ' ');

end Q;
8 changes: 8 additions & 0 deletions testsuite/tests/checks/KP-18801/test.out
Original file line number Diff line number Diff line change
@@ -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
| ^^^^^^^^^^^^^

3 changes: 3 additions & 0 deletions testsuite/tests/checks/KP-18801/test.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
driver: 'checker'
rule_name: KP_18801
project: 'prj.gpr'

0 comments on commit b59bd47

Please sign in to comment.