maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Check for recursive EXTENDS() 

Original-commit: flang-compiler/f18@8d0a9bb360
Reviewed-on: https://github.com/flang-compiler/f18/pull/291
Tree-same-pre-rewrite: false
This commit is contained in:
peter klausler 2019-02-15 16:21:43 -08:00
parent 88631be8b4
commit 2793b663d6
2 changed files with 41 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
flang/lib/semantics/resolve-names.cc
View File

@ -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();

21
flang/test/semantics/resolve44.f90
View File

@ -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