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
AdaCore · Jan 6, 2025 · 1f60a15 · 1f60a15
2 parents 9d605cf + c04a405
commit 1f60a15
Show file tree

Hide file tree

Showing 2 changed files with 43 additions and 30 deletions.
diff --git a/lkql_checker/share/lkql/integer_types_as_enum.lkql b/lkql_checker/share/lkql/integer_types_as_enum.lkql
@@ -20,14 +20,22 @@ fun instantiations() =
 fun types() =
     |" Return a list of TypeDecl matching all type conversions (both as source
     |" and target), subtype declarations and type derivations in the project.
-    unique(concat([[c.p_referenced_decl(),
-                    c.f_suffix[1].f_r_expr.p_expression_type()]
-                   for c in select CallExpr(p_referenced_decl(): TypeDecl)].
-                  to_list) &
-           [s.f_subtype.f_name.p_referenced_decl()
-            for s in select SubtypeDecl].to_list &
-           [c.f_type_def.f_subtype_indication?.f_name?.p_referenced_decl()
-            for c in select TypeDecl(f_type_def: DerivedTypeDef)].to_list)
+    unique(
+        concat(
+            [
+                [c.p_referenced_decl(), c.f_suffix[1].f_r_expr.p_expression_type()]
+                for c in select CallExpr(p_kind: "type_conversion")
+            ].to_list
+        ) &
+        [
+            s.f_subtype.f_name.p_referenced_decl()
+            for s in select SubtypeDecl
+        ].to_list &
+        [
+            c.f_type_def.f_subtype_indication?.f_name?.p_referenced_decl()
+            for c in select TypeDecl(f_type_def: DerivedTypeDef)
+        ].to_list
+    )
 
 @check(help="integer type may be replaced by an enumeration (global analysis required)",
        message="integer type may be replaced by an enumeration",

diff --git a/testsuite/tests/checks/integer_as_enum/subtyping.adb b/testsuite/tests/checks/integer_as_enum/subtyping.adb
@@ -1,35 +1,40 @@
 procedure Subtyping is
-    type Enum1 is range 1 .. 3;  --  NOFLAG
-    subtype Enum1_S is Enum1;
+   type Enum1 is range 1 .. 3;  --  NOFLAG
+   subtype Enum1_S is Enum1;
 
-    generic
-       type Int_F is range <>;
-    procedure Proc_G (X : in out Int_F);
+   generic
+      type Int_F is range <>;
+   procedure Proc_G (X : in out Int_F);
 
-    procedure Proc_G (X : in out Int_F) is
-    begin
-       X := X + 1;
-    end Proc_G;
+   procedure Proc_G (X : in out Int_F) is
+   begin
+      X := X + 1;
+   end Proc_G;
 
-    procedure Proc_I is new Proc_G (Enum1_S);
+   procedure Proc_I is new Proc_G (Enum1_S);
 
-    type Enum2 is range 1 .. 3;  --  NOFLAG
-    subtype Enum2_S is Enum2;
+   type Enum2 is range 1 .. 3;  --  NOFLAG
+   subtype Enum2_S is Enum2;
 
-    type Int is range 1 .. 10;   --  NOFLAG
+   type Int is range 1 .. 10;   --  NOFLAG
 
-    E : Enum2 := 1;
-    I : Int   := 1;
+   E : Enum2 := 1;
+   I : Int   := 1;
 
-    type Enum3 is range 1 .. 3;  --  NOFLAG
-    subtype Enum3_S is Enum3;
+   type Enum3 is range 1 .. 3;  --  NOFLAG
+   subtype Enum3_S is Enum3;
 
-    type Enum3_D is new Enum3_S; --  NOFLAG
-    X : Enum3_D := 1;
+   type Enum3_D is new Enum3_S; --  NOFLAG
+   X : Enum3_D := 1;
+
+   --  [CS0040230] Ensure GNATcheck rule is not crashing on such constructions
+   type D_String is new String;
+   S : constant String := "Hello";
+   D_S : D_String := D_String (S)(S'First .. S'Last); --  NOFLAG
 
 begin
-    E := Enum2_S (I);
+   E := Enum2_S (I);
 
-    I := I + 1;
-    X := X + 1;
+   I := I + 1;
+   X := X + 1;
 end Subtyping;