Fix crash on invalid self derivation.

AdaCore · Oct 24, 2023 · e953a7d · e953a7d
1 parent f5151b2
commit e953a7d
Show file tree

Hide file tree

Showing 3 changed files with 21 additions and 1 deletion.
diff --git a/ada/ast.py b/ada/ast.py
@@ -8633,7 +8633,12 @@ class DerivedTypeDef(TypeDef):
         default_val=Entity.super()
     ))
 
-    base_type = Property(Entity.subtype_indication.designated_type)
+    base_type = Property(Entity.subtype_indication.designated_type.then(
+        # If the designated type is Self, it means there is an illegal
+        # cycle. Explicitly return an null node here, otherwise this may
+        # cause infinite recursions in caller properties.
+        lambda t: If(t.node == Self.parent, No(BaseTypeDecl.entity), t)
+    ))
 
     base_interfaces = Property(
         Entity.interfaces.map(lambda i: i.name_designated_type)

diff --git a/testsuite/tests/name_resolution/invalid_self_reference/test.adb b/testsuite/tests/name_resolution/invalid_self_reference/test.adb
@@ -6,6 +6,12 @@ procedure Test is
    Foo : Foo.T;
    --% node.f_type_expr.p_designated_type_decl
    -- This is invalid Ada but should not make LAL crash!
+
+   type X;
+   type X is new X;
+   --% node.p_base_type(node)
+   --% node.f_type_def.f_subtype_indication.p_designated_type_decl
+   -- Likewise, this should not make LAL crash
 begin
    null;
 end Test;
diff --git a/testsuite/tests/name_resolution/invalid_self_reference/test.out b/testsuite/tests/name_resolution/invalid_self_reference/test.out
@@ -3,3 +3,12 @@ Working on node <ObjectDecl ["Foo"] test.adb:6:4-6:16>
 
 Eval 'node.f_type_expr.p_designated_type_decl'
 Result: None
+
+Working on node <ConcreteTypeDecl ["X"] test.adb:11:4-11:20>
+============================================================
+
+Eval 'node.p_base_type(node)'
+Result: None
+
+Eval 'node.f_type_def.f_subtype_indication.p_designated_type_decl'
+Result: None