Skip to content

Commit eb5fe61

Browse files
HugoGGuerrierHugoGGuerrier
committed
Merge branch 'topic/kp_20113' into 'master'
Add detector for KP 20113 Closes #554 See merge request eng/libadalang/langkit-query-language!580
2 parents c4d8de7 + 8589af9 commit eb5fe61

File tree

8 files changed

+158
-0
lines changed

8 files changed

+158
-0
lines changed

‎lkql_checker/share/lkql/kp/kp_20113.lkql‎

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,40 @@
1+
fun is_constrained_arr_subtype(type_decl) =
2+
|" Returns whether the provided BaseTypeDecl declares an array subtype with
3+
|" bound constraints.
4+
{
5+
fun is_subtype_indication_constrained(subtype_indication) =
6+
|" Returns whether the provided subtype indication caries a range
7+
|" constraint or the designated type already is a constrained array
8+
|" subtype.
9+
subtype_indication.f_constraint is not null
10+
or is_constrained_arr_subtype(subtype_indication.f_name.p_referenced_decl());
11+
12+
type_decl.p_full_view() is BaseTypeDecl(p_is_array_type(): true) when
13+
match type_decl
14+
| TypeDecl => (
15+
match type_decl.f_type_def
16+
| ArrayTypeDef(f_indices: ConstrainedArrayIndices) => true
17+
| d@DerivedTypeDef => is_subtype_indication_constrained(d.f_subtype_indication)
18+
| * => false
19+
)
20+
| SubtypeDecl => is_subtype_indication_constrained(type_decl.f_subtype)
21+
}
22+
23+
@check(help="possible occurrence of KP 20113",
24+
message="possible occurrence of KP 20113")
25+
fun kp_20113(node) =
26+
|" Flag all usages of the ``VADS_Size`` attribute, and all usages of the
27+
|" ``Size`` attribute when the pragma ``Use_VADS_Size`` is enabled, when
28+
|" the prefix may denote a constrained array subtype.
29+
node is AttributeRef when {
30+
val attribute_name = node.f_attribute;
31+
(
32+
attribute_name.p_name_is("vads_size")
33+
or (
34+
attribute_name.p_name_is("size")
35+
and node.unit.root.p_config_pragmas("use_vads_size").length > 0
36+
)
37+
) and node.f_prefix.p_referenced_decl().p_full_view() is td@BaseTypeDecl(
38+
p_is_array_type(): true
39+
) when is_constrained_arr_subtype(td)
40+
}

‎testsuite/tests/checks/KP-20113/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-20113/test.out‎

Lines changed: 52 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,52 @@
1+
with_use_vads.adb:6:35: rule violation: possible occurrence of KP 20113
2+
6 | Local_Sub_Size : Integer := Local_Sub'Size; -- FLAG
3+
| ^^^^^^^^^^^^^^
4+
5+
with_use_vads.ads:9:38: rule violation: possible occurrence of KP 20113
6+
9 | Constr_Arr_Size : Integer := Constr_Arr'Size; -- FLAG
7+
| ^^^^^^^^^^^^^^^
8+
9+
with_use_vads.ads:10:38: rule violation: possible occurrence of KP 20113
10+
10 | Constr_MD_Arr_Size : Integer := Constr_MD_Arr'Size; -- FLAG
11+
| ^^^^^^^^^^^^^^^^^^
12+
13+
with_use_vads.ads:11:38: rule violation: possible occurrence of KP 20113
14+
11 | Constr_Arr_VADS_Size : Integer := Constr_Arr'VADS_Size; -- FLAG
15+
| ^^^^^^^^^^^^^^^^^^^^
16+
17+
with_use_vads.ads:12:38: rule violation: possible occurrence of KP 20113
18+
12 | Constr_Sub_Size : Integer := Constr_Sub'Size; -- FLAG
19+
| ^^^^^^^^^^^^^^^
20+
21+
with_use_vads.ads:13:38: rule violation: possible occurrence of KP 20113
22+
13 | Constr_Derived_Size : Integer := Constr_Derived'Size; -- FLAG
23+
| ^^^^^^^^^^^^^^^^^^^
24+
25+
with_use_vads.ads:24:39: rule violation: possible occurrence of KP 20113
26+
24 | Unconstr_Sub_Size : Integer := Unconstr_Sub'Size; -- FLAG
27+
| ^^^^^^^^^^^^^^^^^
28+
29+
with_use_vads.ads:25:39: rule violation: possible occurrence of KP 20113
30+
25 | Unconstr_Sub_Sub_Size : Integer := Unconstr_Sub_Sub'Size; -- FLAG
31+
| ^^^^^^^^^^^^^^^^^^^^^
32+
33+
with_use_vads.ads:26:39: rule violation: possible occurrence of KP 20113
34+
26 | Unconstr_MD_Sub_Size : Integer := Unconstr_MD_Sub'Size; -- FLAG
35+
| ^^^^^^^^^^^^^^^^^^^^
36+
37+
with_use_vads.ads:27:39: rule violation: possible occurrence of KP 20113
38+
27 | Unconstr_Derived_Size : Integer := Unconstr_Derived'Size; -- FLAG
39+
| ^^^^^^^^^^^^^^^^^^^^^
40+
41+
with_use_vads.ads:32:33: rule violation: possible occurrence of KP 20113
42+
32 | String_Sub_Size : Integer := String_Sub'Size; -- FLAG
43+
| ^^^^^^^^^^^^^^^
44+
45+
without_use_vads.adb:6:38: rule violation: possible occurrence of KP 20113
46+
6 | Constr_Arr_VADS_Size : Integer := Constr_Arr'VADS_Size; -- FLAG
47+
| ^^^^^^^^^^^^^^^^^^^^
48+
49+
without_use_vads.adb:7:38: rule violation: possible occurrence of KP 20113
50+
7 | Constr_Arr_Priv_Size : Integer := Constr_Arr_Priv'VADS_Size; -- FLAG
51+
| ^^^^^^^^^^^^^^^^^^^^^^^^^
52+

‎testsuite/tests/checks/KP-20113/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_20113
3+
project: prj.gpr

‎testsuite/tests/checks/KP-20113/with_use_vads.adb‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
package body With_Use_VADS is
2+
procedure Test (X, Y : Integer) is
3+
type Local_Arr is array (Integer range <>) of Integer;
4+
subtype Local_Sub is Local_Arr (X .. Y);
5+
6+
Local_Sub_Size : Integer := Local_Sub'Size; -- FLAG
7+
begin
8+
null;
9+
end Test;
10+
end With_Use_VADS;

‎testsuite/tests/checks/KP-20113/with_use_vads.ads‎

Lines changed: 39 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,39 @@
1+
pragma Use_VADS_Size;
2+
3+
package With_Use_VADS is
4+
type Constr_Arr is array (1 .. 2) of Integer;
5+
type Constr_MD_Arr is array (1 .. 2, 1 .. 2) of Integer;
6+
subtype Constr_Sub is Constr_Arr;
7+
type Constr_Derived is new Constr_Arr;
8+
9+
Constr_Arr_Size : Integer := Constr_Arr'Size; -- FLAG
10+
Constr_MD_Arr_Size : Integer := Constr_MD_Arr'Size; -- FLAG
11+
Constr_Arr_VADS_Size : Integer := Constr_Arr'VADS_Size; -- FLAG
12+
Constr_Sub_Size : Integer := Constr_Sub'Size; -- FLAG
13+
Constr_Derived_Size : Integer := Constr_Derived'Size; -- FLAG
14+
15+
type Unconstr_Arr is array (Integer range <>) of Integer;
16+
type Unconstr_MD_Arr is
17+
array (Integer range <>, Integer range <>) of Integer;
18+
subtype Unconstr_Sub is Unconstr_Arr (1 .. 2);
19+
subtype Unconstr_Sub_Sub is Unconstr_Sub;
20+
subtype Unconstr_MD_Sub is Unconstr_MD_Arr (1 .. 2, 1 .. 2);
21+
type Unconstr_Derived is new Unconstr_Arr (1 .. 2);
22+
23+
Unconstr_Arr_Size : Integer := Unconstr_Arr'Size; -- NOFLAG
24+
Unconstr_Sub_Size : Integer := Unconstr_Sub'Size; -- FLAG
25+
Unconstr_Sub_Sub_Size : Integer := Unconstr_Sub_Sub'Size; -- FLAG
26+
Unconstr_MD_Sub_Size : Integer := Unconstr_MD_Sub'Size; -- FLAG
27+
Unconstr_Derived_Size : Integer := Unconstr_Derived'Size; -- FLAG
28+
29+
subtype String_Sub is String (1 .. 2);
30+
31+
Integer_Size : Integer := Integer'Size; -- NOFLAG
32+
String_Sub_Size : Integer := String_Sub'Size; -- FLAG
33+
34+
type Constr_Arr_Priv is private;
35+
36+
procedure Test (X, Y : Integer);
37+
private
38+
type Constr_Arr_Priv is array (1 .. 2) of Integer;
39+
end With_Use_VADS;

‎testsuite/tests/checks/KP-20113/without_use_vads.adb‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
with With_Use_Vads; use With_Use_Vads;
2+
3+
procedure Without_Use_Vads is
4+
type Constr_Arr is array (1 .. 2) of Integer;
5+
Constr_Arr_Size : Integer := Constr_Arr'Size; -- NOFLAG
6+
Constr_Arr_VADS_Size : Integer := Constr_Arr'VADS_Size; -- FLAG
7+
Constr_Arr_Priv_Size : Integer := Constr_Arr_Priv'VADS_Size; -- FLAG
8+
begin
9+
null;
10+
end Without_Use_Vads;

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

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -98,6 +98,7 @@ testsuite_driver: No output file generated by gnatcheck
9898
<check switch="+Rkp_19997" label="possible occurrence of KP 19997"/>
9999
<check switch="+Rkp_20023" label="possible occurrence of KP 20023"/>
100100
<check switch="+Rkp_20089" label="possible occurrence of KP 20089"/>
101+
<check switch="+Rkp_20113" label="possible occurrence of KP 20113"/>
101102
<check switch="+Rkp_ob03_009" label="possible occurrence of KP OB03-009"/>
102103
<check switch="+Rkp_p226_024" label="possible occurrence of KP P226-024 - global analysis required"/>
103104
<check switch="+Rkp_q309_014" label="possible occurrence of KP Q309-014"/>
@@ -621,6 +622,7 @@ testsuite_driver: No output file generated by gnatcheck
621622
<check switch="+Rkp_19997" label="possible occurrence of KP 19997"/>
622623
<check switch="+Rkp_20023" label="possible occurrence of KP 20023"/>
623624
<check switch="+Rkp_20089" label="possible occurrence of KP 20089"/>
625+
<check switch="+Rkp_20113" label="possible occurrence of KP 20113"/>
624626
<check switch="+Rkp_ob03_009" label="possible occurrence of KP OB03-009"/>
625627
<check switch="+Rkp_p226_024" label="possible occurrence of KP P226-024 - global analysis required"/>
626628
<check switch="+Rkp_q309_014" label="possible occurrence of KP Q309-014"/>

0 commit comments

Comments
 (0)