Skip to content

Commit fc10f98

Browse files
HugoGGuerrierHugoGGuerrier
committed
Merge branch 'topic/kp_19529' into 'master'
Implement KP detector for 19529 Closes #351 See merge request eng/libadalang/langkit-query-language!301
2 parents fa01356 + 73c84b3 commit fc10f98

File tree

8 files changed

+178
-0
lines changed

8 files changed

+178
-0
lines changed

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

Lines changed: 36 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
1+
import stdlib
2+
3+
fun is_declared_in_parent_subp(name, subp_body) =
4+
|" Returns whether the given name is declared in a parent subprogram of the
5+
|" given subprogram body. If the name is declared in a pacakge body, this
6+
|" function returns false.
7+
stdlib.ultimate_alias(name) is decl@BasicDecl
8+
when {
9+
val parent = from decl
10+
through stdlib.semantic_parent
11+
select first (BaseSubpBody);
12+
parent is BaseSubpBody and parent in stdlib.semantic_parent(subp_body)
13+
}
14+
15+
fun is_composite_object(name) =
16+
|" Returns whether the given name and its declaration refers to a composite
17+
|" object.
18+
{
19+
val name_expr = name.p_expression_type().p_root_type().p_full_view();
20+
name_expr.p_is_array_type() or name_expr.p_is_record_type()
21+
}
22+
23+
@check(help="possible occurrence of KP 19529",
24+
message="possible occurrence of KP 19529",
25+
impact="24.*")
26+
fun kp_19529(node) =
27+
|" Flag assign statement between two composite objects that are declared
28+
|" in a subprogram and assigned in a nested sub-program.
29+
node is AssignStmt
30+
when {
31+
val assign_subp = from node through stdlib.semantic_parent select first BaseSubpBody;
32+
stdlib.all([
33+
n is Name and is_composite_object(n) and is_declared_in_parent_subp(n, assign_subp)
34+
for n in [node.f_dest, node.f_expr]
35+
])
36+
}

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

Lines changed: 75 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,75 @@
1+
with Pkg; use Pkg;
2+
3+
procedure Main is
4+
type Int_Arr is array (1 .. 3) of Integer;
5+
type Rec is record
6+
I : Integer;
7+
B : Boolean;
8+
end record;
9+
subtype S_Rec is Rec;
10+
type D_Rec is new Rec;
11+
type Rec_Arr is record
12+
I : Integer;
13+
A : Int_Arr;
14+
end record;
15+
16+
I_1 : Integer := 1;
17+
I_2 : Integer;
18+
S_1 : String := "Hello";
19+
S_2 : String (1 .. 5);
20+
I_A_1 : Int_Arr := Int_Arr'(1, 2, 3);
21+
I_A_2 : Int_Arr;
22+
R_1 : Rec := Rec'(1, True);
23+
R_2 : Rec;
24+
P_R_1 : P_Rec := Create (1, True);
25+
P_R_2 : P_Rec;
26+
R_A_1 : Rec_Arr := Rec_Arr'(1, Int_Arr'(1, 2, 3));
27+
28+
procedure Inner is
29+
S_3 : String (1 .. 5);
30+
31+
procedure Inner_Inner is
32+
S_4 : String renames S_1;
33+
begin
34+
S_3 := S_1; -- FLAG
35+
S_3 := S_4; -- FLAG
36+
S_2 := S_3; -- FLAG
37+
end Inner_Inner;
38+
begin
39+
I_2 := 2; -- NOFLAG
40+
I_2 := I_1; -- NOFLAG
41+
S_2 := "Hello"; -- NOFLAG
42+
S_2 := S_1; -- FLAG
43+
S_3 := S_1; -- NOFLAG
44+
S_2 := S_3; -- NOFLAG
45+
I_A_2 := I_A_1; -- FLAG
46+
R_2 := R_1; -- FLAG
47+
P_R_2 := P_R_1; -- FLAG
48+
R_A_1.A := I_A_1; -- FLAG
49+
50+
declare
51+
S_4 : String (1 .. 5);
52+
begin
53+
S_2 := S_1; -- FLAG
54+
S_3 := S_1; -- NOFLAG
55+
S_4 := S_1; -- NOFLAG
56+
end;
57+
end Inner;
58+
59+
package Inner_Pkg is
60+
D_X : Rec;
61+
procedure Inner_Inner;
62+
end Inner_Pkg;
63+
64+
package body Inner_Pkg is
65+
B_X : Rec;
66+
67+
procedure Inner_Inner is
68+
begin
69+
D_X := D_X; -- FLAG
70+
B_X := B_X; -- FLAG
71+
end Inner_Inner;
72+
end Inner_Pkg;
73+
begin
74+
null;
75+
end Main;

‎testsuite/tests/checks/KP-19529/pkg.adb

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
package body Pkg is
2+
function Create (I : Integer; B : Boolean) return P_Rec is
3+
begin
4+
return P_Rec'(I, B);
5+
end Create;
6+
end Pkg;

‎testsuite/tests/checks/KP-19529/pkg.ads

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
package Pkg is
2+
type P_Rec is private;
3+
4+
function Create (I : Integer; B : Boolean) return P_Rec;
5+
private
6+
type P_Rec is record
7+
I : Integer;
8+
B : Boolean;
9+
end record;
10+
end Pkg;

‎testsuite/tests/checks/KP-19529/prj.gpr

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
project Prj is
2+
end Prj;

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

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,44 @@
1+
main.adb:34:10: rule violation: possible occurrence of KP 19529
2+
34 | S_3 := S_1; -- FLAG
3+
| ^^^^^^^^^^^
4+
5+
main.adb:35:10: rule violation: possible occurrence of KP 19529
6+
35 | S_3 := S_4; -- FLAG
7+
| ^^^^^^^^^^^
8+
9+
main.adb:36:10: rule violation: possible occurrence of KP 19529
10+
36 | S_2 := S_3; -- FLAG
11+
| ^^^^^^^^^^^
12+
13+
main.adb:42:7: rule violation: possible occurrence of KP 19529
14+
42 | S_2 := S_1; -- FLAG
15+
| ^^^^^^^^^^^
16+
17+
main.adb:45:7: rule violation: possible occurrence of KP 19529
18+
45 | I_A_2 := I_A_1; -- FLAG
19+
| ^^^^^^^^^^^^^^^
20+
21+
main.adb:46:7: rule violation: possible occurrence of KP 19529
22+
46 | R_2 := R_1; -- FLAG
23+
| ^^^^^^^^^^^
24+
25+
main.adb:47:7: rule violation: possible occurrence of KP 19529
26+
47 | P_R_2 := P_R_1; -- FLAG
27+
| ^^^^^^^^^^^^^^^
28+
29+
main.adb:48:7: rule violation: possible occurrence of KP 19529
30+
48 | R_A_1.A := I_A_1; -- FLAG
31+
| ^^^^^^^^^^^^^^^^^
32+
33+
main.adb:53:10: rule violation: possible occurrence of KP 19529
34+
53 | S_2 := S_1; -- FLAG
35+
| ^^^^^^^^^^^
36+
37+
main.adb:69:10: rule violation: possible occurrence of KP 19529
38+
69 | D_X := D_X; -- FLAG
39+
| ^^^^^^^^^^^
40+
41+
main.adb:70:10: rule violation: possible occurrence of KP 19529
42+
70 | B_X := B_X; -- FLAG
43+
| ^^^^^^^^^^^
44+

‎testsuite/tests/checks/KP-19529/test.yaml

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
driver: checker
2+
rule_name: kp_19529
3+
project: prj.gpr

‎testsuite/tests/gnatcheck/xml_help/test.out

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -83,6 +83,7 @@ testsuite_driver: No output file generated by gnatcheck
8383
<check switch="+Rkp_19423" label="possible occurrence of KP 19423"/>
8484
<check switch="+Rkp_19447" label="possible occurrence of KP 19447"/>
8585
<check switch="+Rkp_19501" label="possible occurrence of KP 19501"/>
86+
<check switch="+Rkp_19529" label="possible occurrence of KP 19529"/>
8687
<check switch="+Rkp_ob03_009" label="possible occurrence of KP OB03-009"/>
8788
<check switch="+Rkp_p226_024" label="possible occurrence of KP P226-024 - global analysis required"/>
8889
<check switch="+Rkp_q309_014" label="possible occurrence of KP Q309-014"/>
@@ -589,6 +590,7 @@ testsuite_driver: No output file generated by gnatcheck
589590
<check switch="+Rkp_19423" label="possible occurrence of KP 19423"/>
590591
<check switch="+Rkp_19447" label="possible occurrence of KP 19447"/>
591592
<check switch="+Rkp_19501" label="possible occurrence of KP 19501"/>
593+
<check switch="+Rkp_19529" label="possible occurrence of KP 19529"/>
592594
<check switch="+Rkp_ob03_009" label="possible occurrence of KP OB03-009"/>
593595
<check switch="+Rkp_p226_024" label="possible occurrence of KP P226-024 - global analysis required"/>
594596
<check switch="+Rkp_q309_014" label="possible occurrence of KP Q309-014"/>

0 commit comments

Comments
 (0)