[flang] Check for recursive EXTENDS()

Original-commit: flang-compiler/f18@8d0a9bb36008fdbc5ad86d4857e6ea1a6da6d024
Reviewed-on: https://github.com/flang-compiler/f18/pull/291
Tree-same-pre-rewrite: false

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index f159c1f..34e9b8b 100644 (file)
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -2868,28 +2868,33 @@ bool DeclarationVisitor::Pre(const parser::DerivedTypeStmt &x) {
   return BeginAttrs();
 }
 void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) {
+  // Resolve the EXTENDS() clause before creating the derived
+  // type's symbol to foil attempts to recursively extend a type.
+  auto *extendsName{derivedTypeInfo_.extends};
+  const Symbol *extendsType{nullptr};
+  if (extendsName != nullptr) {
+    extendsType = ResolveDerivedType(*extendsName);
+  }
   auto &name{std::get<parser::Name>(x.t)};
   auto &symbol{MakeSymbol(name, GetAttrs(), DerivedTypeDetails{})};
   derivedTypeInfo_.type = &symbol;
   PushScope(Scope::Kind::DerivedType, &symbol);
-  if (auto *extendsName{derivedTypeInfo_.extends}) {
-    if (const Symbol * extends{ResolveDerivedType(*extendsName)}) {
-      // Declare the "parent component"; private if the type is
-      // Any symbol stored in the EXTENDS() clause is temporarily
-      // hidden so that a new symbol can be created for the parent
-      // component without producing spurious errors about already
-      // existing.
-      auto restorer{common::ScopedSet(extendsName->symbol, nullptr)};
-      if (OkToAddComponent(*extendsName, extends)) {
-        auto &comp{DeclareEntity<ObjectEntityDetails>(*extendsName, Attrs{})};
-        comp.attrs().set(Attr::PRIVATE, extends->attrs().test(Attr::PRIVATE));
-        comp.set(Symbol::Flag::ParentComp);
-        DeclTypeSpec &type{currScope().MakeDerivedType(*extends)};
-        type.derivedTypeSpec().set_scope(*extends->scope());
-        comp.SetType(type);
-        DerivedTypeDetails &details{symbol.get<DerivedTypeDetails>()};
-        details.add_component(comp);
-      }
+  if (extendsType != nullptr) {
+    // Declare the "parent component"; private if the type is
+    // Any symbol stored in the EXTENDS() clause is temporarily
+    // hidden so that a new symbol can be created for the parent
+    // component without producing spurious errors about already
+    // existing.
+    auto restorer{common::ScopedSet(extendsName->symbol, nullptr)};
+    if (OkToAddComponent(*extendsName, extendsType)) {
+      auto &comp{DeclareEntity<ObjectEntityDetails>(*extendsName, Attrs{})};
+      comp.attrs().set(Attr::PRIVATE, extendsType->attrs().test(Attr::PRIVATE));
+      comp.set(Symbol::Flag::ParentComp);
+      DeclTypeSpec &type{currScope().MakeDerivedType(*extendsType)};
+      type.derivedTypeSpec().set_scope(*extendsType->scope());
+      comp.SetType(type);
+      DerivedTypeDetails &details{symbol.get<DerivedTypeDetails>()};
+      details.add_component(comp);
     }
   }
   EndAttrs();

diff --git a/flang/test/semantics/resolve44.f90 b/flang/test/semantics/resolve44.f90
index 13bdf06..fe32325 100644 (file)
--- a/flang/test/semantics/resolve44.f90
+++ b/flang/test/semantics/resolve44.f90
@@ -17,24 +17,39 @@
 program main
   type :: recursive1
     !ERROR: Recursive use of the derived type requires POINTER or ALLOCATABLE
-    type(recursive1) :: bad
+    type(recursive1) :: bad1
     type(recursive1), pointer :: ok1
     type(recursive1), allocatable :: ok2
+    !ERROR: Recursive use of the derived type requires POINTER or ALLOCATABLE
+    class(recursive1) :: bad2
+    class(recursive1), pointer :: ok3
+    class(recursive1), allocatable :: ok4
   end type recursive1
   type :: recursive2(kind,len)
     integer, kind :: kind
     integer, len :: len
     !ERROR: Recursive use of the derived type requires POINTER or ALLOCATABLE
-    type(recursive2(kind,len)) :: bad
+    type(recursive2(kind,len)) :: bad1
     type(recursive2(kind,len)), pointer :: ok1
     type(recursive2(kind,len)), allocatable :: ok2
+    !ERROR: Recursive use of the derived type requires POINTER or ALLOCATABLE
+    class(recursive2(kind,len)) :: bad2
+    class(recursive2(kind,len)), pointer :: ok3
+    class(recursive2(kind,len)), allocatable :: ok4
   end type recursive2
   type :: recursive3(kind,len)
     integer, kind :: kind = 1
     integer, len :: len = 2
     !ERROR: Recursive use of the derived type requires POINTER or ALLOCATABLE
-    type(recursive3) :: bad
+    type(recursive3) :: bad1
     type(recursive3), pointer :: ok1
     type(recursive3), allocatable :: ok2
+    !ERROR: Recursive use of the derived type requires POINTER or ALLOCATABLE
+    class(recursive3) :: bad2
+    class(recursive3), pointer :: ok3
+    class(recursive3), allocatable :: ok4
   end type recursive3
+  !ERROR: Derived type 'recursive4' not found
+  type, extends(recursive4) :: recursive4
+  end type recursive4
 end program main