[flang] Avoid crash in name resolution on erroneous type extension (#109312)

Don't crash when a bad Fortran program tries to extend a derived type
with previous legitimate forward references but no prior definition.

Fixes https://github.com/llvm/llvm-project/issues/109268.
This commit is contained in:
Peter Klausler 2024-09-20 13:53:12 -07:00 committed by GitHub
parent 751389218e
commit e8335aef06
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
2 changed files with 30 additions and 10 deletions

View File

@ -1204,7 +1204,7 @@ private:
const parser::Name &, const parser::Name *);
Symbol *MakeTypeSymbol(const SourceName &, Details &&);
Symbol *MakeTypeSymbol(const parser::Name &, Details &&);
bool OkToAddComponent(const parser::Name &, const Symbol * = nullptr);
bool OkToAddComponent(const parser::Name &, const Symbol *extends = nullptr);
ParamValue GetParamValue(
const parser::TypeParamValue &, common::TypeParamAttr attr);
void CheckCommonBlockDerivedType(
@ -5606,7 +5606,7 @@ void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) {
comp.set(Symbol::Flag::ParentComp);
DeclTypeSpec &type{currScope().MakeDerivedType(
DeclTypeSpec::TypeDerived, std::move(*extendsType))};
type.derivedTypeSpec().set_scope(*extendsSymbol.scope());
type.derivedTypeSpec().set_scope(DEREF(extendsSymbol.scope()));
comp.SetType(type);
DerivedTypeDetails &details{symbol.get<DerivedTypeDetails>()};
details.add_component(comp);
@ -6797,15 +6797,20 @@ std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveExtendsType(
const parser::Name &typeName, const parser::Name *extendsName) {
if (!extendsName) {
return std::nullopt;
} else if (typeName.source == extendsName->source) {
Say(extendsName->source,
"Derived type '%s' cannot extend itself"_err_en_US);
return std::nullopt;
} else {
return ResolveDerivedType(*extendsName);
if (extendsName) {
if (typeName.source == extendsName->source) {
Say(extendsName->source,
"Derived type '%s' cannot extend itself"_err_en_US);
} else if (auto dtSpec{ResolveDerivedType(*extendsName)}) {
if (!dtSpec->IsForwardReferenced()) {
return dtSpec;
}
Say(typeName.source,
"Derived type '%s' cannot extend type '%s' that has not yet been defined"_err_en_US,
typeName.source, extendsName->source);
}
}
return std::nullopt;
}
Symbol *DeclarationVisitor::NoteInterfaceName(const parser::Name &name) {

View File

@ -97,3 +97,18 @@ subroutine s10
type(undef), pointer :: y
end type
end subroutine s10
subroutine s11
!ERROR: Derived type 'undef1' not found
type(undef1), pointer :: p
type t1
!ERROR: The derived type 'undef2' has not been defined
type(undef2), pointer :: p
end type
!ERROR: Derived type 'undef1' not found
type, extends(undef1) :: t2
end type
!ERROR: Derived type 't3' cannot extend type 'undef2' that has not yet been defined
type, extends(undef2) :: t3
end type
end subroutine s11