diff --git a/lkql_checker/share/lkql/kp/KP-18801.lkql b/lkql_checker/share/lkql/kp/KP-18801.lkql new file mode 100644 index 000000000..380ed00c7 --- /dev/null +++ b/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) diff --git a/testsuite/tests/checks/KP-18801/g1.adb b/testsuite/tests/checks/KP-18801/g1.adb new file mode 100644 index 000000000..ea6d235dd --- /dev/null +++ b/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; diff --git a/testsuite/tests/checks/KP-18801/g1.ads b/testsuite/tests/checks/KP-18801/g1.ads new file mode 100644 index 000000000..747f4f98a --- /dev/null +++ b/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; diff --git a/testsuite/tests/checks/KP-18801/prj.gpr b/testsuite/tests/checks/KP-18801/prj.gpr new file mode 100644 index 000000000..3abfff4af --- /dev/null +++ b/testsuite/tests/checks/KP-18801/prj.gpr @@ -0,0 +1,2 @@ +project Prj is +end Prj; diff --git a/testsuite/tests/checks/KP-18801/q.ads b/testsuite/tests/checks/KP-18801/q.ads new file mode 100644 index 000000000..cec30df62 --- /dev/null +++ b/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; diff --git a/testsuite/tests/checks/KP-18801/test.out b/testsuite/tests/checks/KP-18801/test.out new file mode 100644 index 000000000..91d357576 --- /dev/null +++ b/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 + | ^^^^^^^^^^^^^ + diff --git a/testsuite/tests/checks/KP-18801/test.yaml b/testsuite/tests/checks/KP-18801/test.yaml new file mode 100644 index 000000000..950fef969 --- /dev/null +++ b/testsuite/tests/checks/KP-18801/test.yaml @@ -0,0 +1,3 @@ +driver: 'checker' +rule_name: KP_18801 +project: 'prj.gpr'