diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -1000,7 +1000,7 @@ void Post(const parser::TypeBoundProcBinding &) { EndAttrs(); } void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &); void Post(const parser::TypeBoundProcedureStmt::WithInterface &); - void Post(const parser::FinalProcedureStmt &); + bool Pre(const parser::FinalProcedureStmt &); bool Pre(const parser::TypeBoundGenericStmt &); bool Pre(const parser::StructureDef &); // returns false bool Pre(const parser::Union::UnionStmt &); @@ -5615,24 +5615,31 @@ } } -void DeclarationVisitor::Post(const parser::FinalProcedureStmt &x) { +bool DeclarationVisitor::Pre(const parser::FinalProcedureStmt &x) { if (currScope().IsDerivedType() && currScope().symbol()) { if (auto *details{currScope().symbol()->detailsIf()}) { for (const auto &subrName : x.v) { - if (const auto *name{ResolveName(subrName)}) { - auto pair{ - details->finals().emplace(name->source, DEREF(name->symbol))}; - if (!pair.second) { // C787 - Say(name->source, - "FINAL subroutine '%s' already appeared in this derived type"_err_en_US, - name->source) - .Attach(pair.first->first, - "earlier appearance of this FINAL subroutine"_en_US); - } + Symbol *symbol{FindSymbol(subrName)}; + if (!symbol) { + // FINAL procedures must be module subroutines + symbol = &MakeSymbol( + currScope().parent(), subrName.source, Attrs{Attr::MODULE}); + Resolve(subrName, symbol); + symbol->set_details(ProcEntityDetails{}); + symbol->set(Symbol::Flag::Subroutine); + } + if (auto pair{details->finals().emplace(subrName.source, *symbol)}; + !pair.second) { // C787 + Say(subrName.source, + "FINAL subroutine '%s' already appeared in this derived type"_err_en_US, + subrName.source) + .Attach(pair.first->first, + "earlier appearance of this FINAL subroutine"_en_US); } } } } + return false; } bool DeclarationVisitor::Pre(const parser::TypeBoundGenericStmt &x) { @@ -7266,7 +7273,7 @@ Say(name, "No explicit type declared for '%s'"_err_en_US); return nullptr; } - // Create the symbol then ensure it is accessible + // Create the symbol, then ensure that it is accessible if (checkIndexUseInOwnBounds_ && *checkIndexUseInOwnBounds_ == name.source) { Say(name, "Implied DO index '%s' uses itself in its own bounds expressions"_err_en_US, diff --git a/flang/test/Semantics/symbol30.f90 b/flang/test/Semantics/symbol30.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/symbol30.f90 @@ -0,0 +1,19 @@ +! RUN: %python %S/test_symbols.py %s %flang_fc1 +!DEF: /m Module +module m + !DEF: /m/t PUBLIC DerivedType + type :: t + contains + !DEF: /m/forwardreferenced ELEMENTAL, IMPURE, MODULE, PUBLIC (Subroutine) Subprogram + final :: forwardreferenced + end type + interface + !REF: /m/forwardreferenced + !DEF: /m/forwardreferenced/this INTENT(INOUT) ObjectEntity TYPE(t) + impure elemental module subroutine forwardreferenced (this) + !REF: /m/t + !REF: /m/forwardreferenced/this + type(t), intent(inout) :: this + end subroutine + end interface +end module