Skip to content

Commit 87103b6

Browse files
HugoGGuerrierHugoGGuerrier
committed
Merge branch 'topic/kp_19501' into 'master'
Update the KP-19501 detector Closes #333 See merge request eng/libadalang/langkit-query-language!318
2 parents 3a4d6ff + 2f50e0b commit 87103b6

File tree

3 files changed

+114
-40
lines changed

3 files changed

+114
-40
lines changed

‎lkql_checker/share/lkql/kp/KP-19501.lkql‎

Lines changed: 56 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -1,31 +1,67 @@
11
import stdlib
22

3-
fun is_static_int_attr_ref(expr) =
4-
|" Returns whether the given expression is an attribute reference which
5-
|" value is a static (compilation known) universal integer.
3+
fun is_static_int_attr(expr) =
4+
|" Returns whether the given expression is a universal-integer valued
5+
|" attribute reference known at compile time.
66
expr is AttributeRef
7-
when expr.p_expression_type() == expr.p_universal_int_type()
8-
and expr.p_is_static_expr()
7+
when expr.p_expression_type() == expr.p_universal_int_type() and
8+
expr.p_is_static_expr()
99

10-
fun is_dynamic_subtype_formal(formal) =
11-
|" Returns whether the given formal parameter DefiningName has a dynamic
10+
fun is_dynamic_subtyped_entity(name) =
11+
|" Returns whether the given name is a DefiningName and has a dynamic
1212
|" subtype.
13-
formal is DefiningName(p_basic_decl(): decl@BasicDecl)
14-
when decl.f_type_expr is (SubtypeIndication | Name)(
15-
p_is_static_subtype(): false
16-
)
13+
{
14+
val decl = match name
15+
| DefiningName => name.p_basic_decl()
16+
| Name => name.p_referenced_decl();
17+
decl is (ComponentDef | DiscriminantSpec | ObjectDecl | ParamSpec)
18+
when decl.f_type_expr is (SubtypeIndication | Name)(
19+
p_is_static_subtype(): false
20+
)
21+
}
22+
23+
fun array_index_has_kp(expr, array_decl, child_n) =
24+
|" Returns whether the given array indexing expression contains an index
25+
|" being a reference to the ``Length`` attribute, while dimension bounds
26+
|" aren't static. Recurse on all indexing expr params starting from
27+
|" ``child_n``.
28+
match expr.f_suffix[child_n]?.f_r_expr
29+
| e when is_static_int_attr(e) =>
30+
if array_decl.f_type_expr.p_is_static_subtype()
31+
then array_index_has_kp(expr, array_decl, child_n + 1)
32+
| null => false
33+
| * => array_index_has_kp(expr, array_decl, child_n + 1)
1734

1835
@check(help="possible occurrence of KP 19501",
1936
message="possible occurrence of KP 19501",
2037
impact="7.1.*,7.2.*,7.3.*,7.4.*,17.*,18.*,19.*,20.*,21.*,22.*,23.*,24.*")
2138
fun kp_19501(node) =
22-
|" Flag all call expressions which include at least one known problematic
23-
|" formal/actual parameter pair.
24-
node is CallExpr(p_is_call(): true)
25-
when stdlib.any(
26-
[
27-
is_static_int_attr_ref(p.actual) and
28-
is_dynamic_subtype_formal(p.param)
39+
|" Flag constructions involving an integer valued attribute reference known
40+
|" at compile time, when the attribute reference is:
41+
|" * an actual parameter in a call where the subtype of the corresponding
42+
|" formal parameter is subject to a constraint
43+
|" * the expression of an assignment where the subtype of the target object
44+
|" is subject to a constraint
45+
|" * the operand of a qualified expression where the subtype mark
46+
|" denotes a subtype that is subject to a constraint
47+
|" * an array index value in an indexed component name
48+
|"
49+
|" Additionally, at least one of the bounds of the applicable constraint
50+
|" must be unknown at compile time.
51+
match node
52+
| CallExpr(p_is_call(): true) =>
53+
stdlib.any([
54+
is_static_int_attr(p.actual) and
55+
is_dynamic_subtyped_entity(p.param)
2956
for p in node.p_call_params()
30-
]
31-
)
57+
])
58+
| CallExpr(p_kind(): "array_index") =>
59+
array_index_has_kp(node, node.f_name.p_referenced_decl(), 1)
60+
| AssignStmt =>
61+
is_static_int_attr(node.f_expr) and
62+
is_dynamic_subtyped_entity(node.f_dest)
63+
| QualExpr(f_suffix: ParenExpr(f_expr: operand)) =>
64+
is_static_int_attr(operand) and
65+
node.f_prefix is (SubtypeIndication | Name)(
66+
p_is_static_subtype(): false
67+
)

‎testsuite/tests/checks/KP-19501/main.adb‎

Lines changed: 36 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -1,20 +1,16 @@
11
procedure Main is
2-
function Id (B : Boolean) return Boolean is (B);
32
function Id (I : Integer) return Integer is (I);
43

5-
type Rec (D : Boolean) is null record;
6-
subtype Stat_Const_Rec is Rec (True);
7-
subtype Dyn_Const_Rec is Rec (Id (True));
8-
94
type Arr is array (Integer range <>) of Integer;
10-
subtype Stat_Const_Arr is Arr (1 .. 3);
11-
subtype Dyn_Const_Arr is Arr (1 .. Id (3));
5+
subtype Stat_Arr is Arr (1 .. 10);
6+
subtype Dyn_Arr is Arr (1 .. Id (10));
7+
type Multidim_Dyn_Arr is array (1 .. 10, 1 .. Id (10)) of Integer;
128

13-
subtype Stat_Int is Integer range 1 .. 3;
14-
subtype Dyn_Int is Integer range Id (1) .. Id (3);
9+
subtype Stat_Int is Integer range 1 .. 10;
10+
subtype Dyn_Int is Integer range Id (1) .. Id (10);
1511

1612
subtype Stat_Pred_Int is Integer
17-
with Static_Predicate => Stat_Pred_Int in 1 .. 5;
13+
with Static_Predicate => Stat_Pred_Int in 1 .. 10;
1814
subtype Dyn_Pred_Int is Integer
1915
with Dynamic_Predicate => Dyn_Pred_Int < 50;
2016

@@ -50,28 +46,50 @@ procedure Main is
5046
begin
5147
null;
5248
end Process_Multiple;
49+
50+
Stat_Assign : Stat_Int;
51+
Dyn_Assign : Dyn_Int;
52+
53+
Stat_Index : Stat_Arr;
54+
Dyn_Index : Dyn_Arr;
55+
Mult_Index : Multidim_Dyn_Arr;
56+
57+
Qual_Expr_1 : Stat_Int := Stat_Int'(C_S'Length); -- NOFLAG
58+
Qual_Expr_2 : Dyn_Int := Dyn_Int'(S'Length); -- NOFLAG
59+
Qual_Expr_3 : Dyn_Int := Dyn_Int'(C_S'Length); -- FLAG
60+
Qual_Expr_4 : Dyn_Int := Dyn_Int'(C_S'Size); -- NOFLAG
5361
begin
5462
Process_Int (S'Length); -- NOFLAG
55-
Process_Int (S'Size); -- NOFLAG
5663
Process_Int (C_S'Length); -- NOFLAG
57-
Process_Int (C_S'Size); -- NOFLAG
5864
Process_Stat_Int (S'Length); -- NOFLAG
59-
Process_Stat_Int (S'Size); -- NOFLAG
6065
Process_Stat_Int (C_S'Length); -- NOFLAG
61-
Process_Stat_Int (C_S'Size); -- NOFLAG
6266
Process_Dyn_Int (S'Length); -- NOFLAG
63-
Process_Dyn_Int (S'Size); -- NOFLAG
6467
Process_Dyn_Int (C_S'Length); -- FLAG
6568
Process_Dyn_Int (C_S'Size); -- NOFLAG
6669
Process_Stat_Pred_Int (S'Length); -- NOFLAG
67-
Process_Stat_Pred_Int (S'Size); -- NOFLAG
6870
Process_Stat_Pred_Int (C_S'Length); -- NOFLAG
69-
Process_Stat_Pred_Int (C_S'Size); -- NOFLAG
7071
Process_Dyn_Pred_Int (S'Length); -- NOFLAG
71-
Process_Dyn_Pred_Int (S'Size); -- NOFLAG
7272
Process_Dyn_Pred_Int (C_S'Length); -- FLAG
7373
Process_Dyn_Pred_Int (C_S'Size); -- NOFLAG
7474

7575
Process_Multiple (S'Length, S'Size); -- NOFLAG
7676
Process_Multiple (C_S'Length, C_S'Size); -- FLAG
77+
78+
Stat_Assign := S'Length; -- NOFLAG
79+
Stat_Assign := C_S'Length; -- NOFLAG
80+
Dyn_Assign := S'Length; -- NOFLAG
81+
Dyn_Assign := C_S'Length; -- FLAG
82+
Dyn_Assign := C_S'Size; -- NOFLAG
83+
84+
Stat_Index (S'Length) := 10; -- NOFLAG
85+
Stat_Index (C_S'Length) := 10; -- NOFLAG
86+
Dyn_Index (S'Length) := 10; -- NOFLAG
87+
Dyn_Index (C_S'Length) := 10; -- FLAG
88+
Dyn_Index (C_S'Size) := 10; -- NOFLAG
89+
Dyn_Index (1) := 10; -- NOFLAG
90+
Mult_Index (1, S'Length) := 10; -- NOFLAG
91+
Mult_Index (1, C_S'Length) := 10; -- FLAG
92+
Mult_Index (1, C_S'Size) := 10; -- NOFLAG
93+
Mult_Index (C_S'Length, 1) := 10; -- FLAG
94+
Mult_Index (1, 1) := 10; -- NOFLAG
7795
end Main;

‎testsuite/tests/checks/KP-19501/test.out‎

Lines changed: 22 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,9 @@
1-
main.adb:64:4: rule violation: possible occurrence of KP 19501
2-
64 | Process_Dyn_Int (C_S'Length); -- FLAG
1+
main.adb:59:29: rule violation: possible occurrence of KP 19501
2+
59 | Qual_Expr_3 : Dyn_Int := Dyn_Int'(C_S'Length); -- FLAG
3+
| ^^^^^^^^^^^^^^^^^^^^
4+
5+
main.adb:67:4: rule violation: possible occurrence of KP 19501
6+
67 | Process_Dyn_Int (C_S'Length); -- FLAG
37
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
48

59
main.adb:72:4: rule violation: possible occurrence of KP 19501
@@ -10,3 +14,19 @@ main.adb:76:4: rule violation: possible occurrence of KP 19501
1014
76 | Process_Multiple (C_S'Length, C_S'Size); -- FLAG
1115
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1216

17+
main.adb:81:4: rule violation: possible occurrence of KP 19501
18+
81 | Dyn_Assign := C_S'Length; -- FLAG
19+
| ^^^^^^^^^^^^^^^^^^^^^^^^^^
20+
21+
main.adb:87:4: rule violation: possible occurrence of KP 19501
22+
87 | Dyn_Index (C_S'Length) := 10; -- FLAG
23+
| ^^^^^^^^^^^^^^^^^^^^^^
24+
25+
main.adb:91:4: rule violation: possible occurrence of KP 19501
26+
91 | Mult_Index (1, C_S'Length) := 10; -- FLAG
27+
| ^^^^^^^^^^^^^^^^^^^^^^^^^^
28+
29+
main.adb:93:4: rule violation: possible occurrence of KP 19501
30+
93 | Mult_Index (C_S'Length, 1) := 10; -- FLAG
31+
| ^^^^^^^^^^^^^^^^^^^^^^^^^^
32+

0 commit comments

Comments
 (0)