Skip to content

Commit 1f60a15

Browse files
committed
Merge branch 'topic/fix_integer_types_as_enum' into 'master'
Fix the "Integer_Types_As_Enum" rule Closes #417 See merge request eng/libadalang/langkit-query-language!376
2 parents 9d605cf + c04a405 commit 1f60a15

File tree

2 files changed

+43
-30
lines changed

2 files changed

+43
-30
lines changed

lkql_checker/share/lkql/integer_types_as_enum.lkql

Lines changed: 16 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -20,14 +20,22 @@ fun instantiations() =
2020
fun types() =
2121
|" Return a list of TypeDecl matching all type conversions (both as source
2222
|" and target), subtype declarations and type derivations in the project.
23-
unique(concat([[c.p_referenced_decl(),
24-
c.f_suffix[1].f_r_expr.p_expression_type()]
25-
for c in select CallExpr(p_referenced_decl(): TypeDecl)].
26-
to_list) &
27-
[s.f_subtype.f_name.p_referenced_decl()
28-
for s in select SubtypeDecl].to_list &
29-
[c.f_type_def.f_subtype_indication?.f_name?.p_referenced_decl()
30-
for c in select TypeDecl(f_type_def: DerivedTypeDef)].to_list)
23+
unique(
24+
concat(
25+
[
26+
[c.p_referenced_decl(), c.f_suffix[1].f_r_expr.p_expression_type()]
27+
for c in select CallExpr(p_kind: "type_conversion")
28+
].to_list
29+
) &
30+
[
31+
s.f_subtype.f_name.p_referenced_decl()
32+
for s in select SubtypeDecl
33+
].to_list &
34+
[
35+
c.f_type_def.f_subtype_indication?.f_name?.p_referenced_decl()
36+
for c in select TypeDecl(f_type_def: DerivedTypeDef)
37+
].to_list
38+
)
3139

3240
@check(help="integer type may be replaced by an enumeration (global analysis required)",
3341
message="integer type may be replaced by an enumeration",
Lines changed: 27 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -1,35 +1,40 @@
11
procedure Subtyping is
2-
type Enum1 is range 1 .. 3; -- NOFLAG
3-
subtype Enum1_S is Enum1;
2+
type Enum1 is range 1 .. 3; -- NOFLAG
3+
subtype Enum1_S is Enum1;
44

5-
generic
6-
type Int_F is range <>;
7-
procedure Proc_G (X : in out Int_F);
5+
generic
6+
type Int_F is range <>;
7+
procedure Proc_G (X : in out Int_F);
88

9-
procedure Proc_G (X : in out Int_F) is
10-
begin
11-
X := X + 1;
12-
end Proc_G;
9+
procedure Proc_G (X : in out Int_F) is
10+
begin
11+
X := X + 1;
12+
end Proc_G;
1313

14-
procedure Proc_I is new Proc_G (Enum1_S);
14+
procedure Proc_I is new Proc_G (Enum1_S);
1515

16-
type Enum2 is range 1 .. 3; -- NOFLAG
17-
subtype Enum2_S is Enum2;
16+
type Enum2 is range 1 .. 3; -- NOFLAG
17+
subtype Enum2_S is Enum2;
1818

19-
type Int is range 1 .. 10; -- NOFLAG
19+
type Int is range 1 .. 10; -- NOFLAG
2020

21-
E : Enum2 := 1;
22-
I : Int := 1;
21+
E : Enum2 := 1;
22+
I : Int := 1;
2323

24-
type Enum3 is range 1 .. 3; -- NOFLAG
25-
subtype Enum3_S is Enum3;
24+
type Enum3 is range 1 .. 3; -- NOFLAG
25+
subtype Enum3_S is Enum3;
2626

27-
type Enum3_D is new Enum3_S; -- NOFLAG
28-
X : Enum3_D := 1;
27+
type Enum3_D is new Enum3_S; -- NOFLAG
28+
X : Enum3_D := 1;
29+
30+
-- [CS0040230] Ensure GNATcheck rule is not crashing on such constructions
31+
type D_String is new String;
32+
S : constant String := "Hello";
33+
D_S : D_String := D_String (S)(S'First .. S'Last); -- NOFLAG
2934

3035
begin
31-
E := Enum2_S (I);
36+
E := Enum2_S (I);
3237

33-
I := I + 1;
34-
X := X + 1;
38+
I := I + 1;
39+
X := X + 1;
3540
end Subtyping;

0 commit comments

Comments
 (0)