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 @@ -578,7 +578,9 @@ symbol->attrs() |= attrs; return *symbol; } else { - SayAlreadyDeclared(name, *symbol); + if (!CheckPossibleBadForwardRef(*symbol)) { + SayAlreadyDeclared(name, *symbol); + } // replace the old symbol with a new one with correct details EraseSymbol(*symbol); auto &result{MakeSymbol(name, attrs, std::move(details))}; @@ -600,8 +602,13 @@ TypeCategory, const std::optional &); const DeclTypeSpec &MakeLogicalType( const std::optional &); + void NotePossibleBadForwardRef(const parser::Name &); + std::optional HadForwardRef(const Symbol &) const; + bool CheckPossibleBadForwardRef(const Symbol &); bool inExecutionPart_{false}; + bool inSpecificationPart_{false}; + std::set specPartForwardRefs_; private: Scope *currScope_{nullptr}; @@ -982,7 +989,7 @@ SayWithDecl( name, symbol, "'%s' is already declared as an object"_err_en_US); } - } else { + } else if (!CheckPossibleBadForwardRef(symbol)) { SayAlreadyDeclared(name, symbol); } context().SetError(symbol); @@ -1880,15 +1887,17 @@ void ScopeHandler::SayAlreadyDeclared(const SourceName &name, Symbol &prev) { if (context().HasError(prev)) { // don't report another error about prev - } else if (const auto *details{prev.detailsIf()}) { - Say(name, "'%s' is already declared in this scoping unit"_err_en_US) - .Attach(details->location(), - "It is use-associated with '%s' in module '%s'"_err_en_US, - details->symbol().name(), GetUsedModule(*details).name()); } else { - SayAlreadyDeclared(name, prev.name()); + if (const auto *details{prev.detailsIf()}) { + Say(name, "'%s' is already declared in this scoping unit"_err_en_US) + .Attach(details->location(), + "It is use-associated with '%s' in module '%s'"_err_en_US, + details->symbol().name(), GetUsedModule(*details).name()); + } else { + SayAlreadyDeclared(name, prev.name()); + } + context().SetError(prev); } - context().SetError(prev); } void ScopeHandler::SayAlreadyDeclared( const SourceName &name1, const SourceName &name2) { @@ -2194,6 +2203,44 @@ } } +void ScopeHandler::NotePossibleBadForwardRef(const parser::Name &name) { + if (inSpecificationPart_ && name.symbol) { + auto kind{currScope().kind()}; + if ((kind == Scope::Kind::Subprogram && !currScope().IsStmtFunction()) || + kind == Scope::Kind::Block) { + bool isHostAssociated{&name.symbol->owner() == &currScope() + ? name.symbol->has() + : name.symbol->owner().Contains(currScope())}; + if (isHostAssociated) { + specPartForwardRefs_.insert(name.source); + } + } + } +} + +std::optional ScopeHandler::HadForwardRef( + const Symbol &symbol) const { + auto iter{specPartForwardRefs_.find(symbol.name())}; + if (iter != specPartForwardRefs_.end()) { + return *iter; + } + return std::nullopt; +} + +bool ScopeHandler::CheckPossibleBadForwardRef(const Symbol &symbol) { + if (!context().HasError(symbol)) { + if (auto fwdRef{HadForwardRef(symbol)}) { + Say(*fwdRef, + "Forward reference to '%s' is not allowed in the same specification part"_err_en_US, + *fwdRef) + .Attach(symbol.name(), "Later declaration of '%s'"_en_US, *fwdRef); + context().SetError(symbol); + return true; + } + } + return false; +} + void ScopeHandler::MakeExternal(Symbol &symbol) { if (!symbol.attrs().test(Attr::EXTERNAL)) { symbol.attrs().set(Attr::EXTERNAL); @@ -4686,6 +4733,8 @@ symbol.SetType(type); } else if (symbol.has()) { // error recovery case, redeclaration of use-associated name + } else if (HadForwardRef(symbol)) { + // error recovery after use of host-associated name } else if (!symbol.test(Symbol::Flag::Implicit)) { SayWithDecl( name, symbol, "The type of '%s' has already been declared"_err_en_US); @@ -5466,12 +5515,14 @@ const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) { FindSymbol(name); if (CheckForHostAssociatedImplicit(name)) { + NotePossibleBadForwardRef(name); return &name; } if (Symbol * symbol{name.symbol}) { if (CheckUseError(name)) { return nullptr; // reported an error } + NotePossibleBadForwardRef(name); symbol->set(Symbol::Flag::ImplicitOrError, false); if (IsUplevelReference(*symbol)) { MakeHostAssocSymbol(name, *symbol); @@ -5496,6 +5547,7 @@ } ConvertToObjectEntity(*symbol); ApplyImplicitRules(*symbol); + NotePossibleBadForwardRef(name); return &name; } @@ -5518,7 +5570,8 @@ Scope *host{GetHostProcedure()}; if (!host || isImplicitNoneType(*host)) { return false; - } else if (!name.symbol) { + } + if (!name.symbol) { hostSymbol = &MakeSymbol(*host, name.source, Attrs{}); ConvertToObjectEntity(*hostSymbol); ApplyImplicitRules(*hostSymbol); @@ -5989,12 +6042,15 @@ bool ResolveNamesVisitor::Pre(const parser::SpecificationPart &x) { const auto &[accDecls, ompDecls, compilerDirectives, useStmts, importStmts, implicitPart, decls] = x.t; + auto flagRestorer{common::ScopedSet(inSpecificationPart_, true)}; Walk(accDecls); Walk(ompDecls); Walk(compilerDirectives); Walk(useStmts); Walk(importStmts); Walk(implicitPart); + auto setRestorer{ + common::ScopedSet(specPartForwardRefs_, std::set{})}; for (const auto &decl : decls) { if (const auto *spec{ std::get_if(&decl.u)}) { @@ -6096,6 +6152,9 @@ symbol.set( symbol.GetType() ? Symbol::Flag::Function : Symbol::Flag::Subroutine); } + if (!symbol.has()) { + CheckPossibleBadForwardRef(symbol); + } } currScope().InstantiateDerivedTypes(context()); for (const auto &decl : decls) { diff --git a/flang/test/Semantics/resolve97.f90 b/flang/test/Semantics/resolve97.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/resolve97.f90 @@ -0,0 +1,94 @@ +! RUN: %S/test_errors.sh %s %t %f18 + +! Check errors from illegal (10.1.12 para 2) forward references +! in specification expressions to entities declared later in the +! same specification part. + +module m1 + integer :: m1j1, m1j2, m1j3, m1j4 + contains + subroutine s1 + !ERROR: Forward reference to 'm1j1' is not allowed in the same specification part + integer(kind=kind(m1j1)) :: t_s1m1j1 + integer(kind=kind(m1s1j1)) :: t_s1j1 ! implicitly typed in s1 + integer :: m1j1, m1s1j1, m1s1j2, m1s1j4 + block + !ERROR: Forward reference to 'm1j2' is not allowed in the same specification part + integer(kind=kind(m1j2)) :: t_s1bm1j2 + !ERROR: Forward reference to 'm1s1j2' is not allowed in the same specification part + integer(kind=kind(m1s1j2)) :: t_s1bm1s1j2 + !ERROR: Forward reference to 'm1s1j3' is not allowed in the same specification part + integer(kind=kind(m1s1j3)) :: t_m1s1j3 ! m1s1j3 implicitly typed in s1 + integer :: m1j2, m1s1j2, m1s1j3 + end block + contains + subroutine s2 + !ERROR: Forward reference to 'm1j3' is not allowed in the same specification part + integer(kind=kind(m1j3)) :: t_m1j3 + !ERROR: Forward reference to 'm1s1j3' is not allowed in the same specification part + integer(kind=kind(m1s1j3)) :: t_m1s1j3 + integer :: m1j3, m1s1j3, m1s2j1 + block + !ERROR: Forward reference to 'm1j4' is not allowed in the same specification part + integer(kind=kind(m1j4)) :: t_m1j4 + !ERROR: Forward reference to 'm1s1j4' is not allowed in the same specification part + integer(kind=kind(m1s1j4)) :: t_m1s1j4 + !ERROR: Forward reference to 'm1s2j1' is not allowed in the same specification part + integer(kind=kind(m1s2j1)) :: t_m1s2j1 + !ERROR: Forward reference to 'm1s2j2' is not allowed in the same specification part + integer(kind=kind(m1s2j2)) :: t_m1s2j2 ! m1s2j2 implicitly typed in s2 + integer :: m1j4, m1s1j4, m1s2j1, m1s2j2 + end block + end subroutine + end subroutine +end module + +module m2 + implicit none + integer :: m2j1, m2j2, m2j3, m2j4 + contains + subroutine s1 + !ERROR: Forward reference to 'm2j1' is not allowed in the same specification part + integer(kind=kind(m2j1)) :: t_s1m2j1 + !ERROR: No explicit type declared for 'm2s1j1' + integer(kind=kind(m2s1j1)) :: t_s1j1 + integer :: m2j1, m2s1j1, m2s1j2, m2s1j4 + block + !ERROR: Forward reference to 'm2j2' is not allowed in the same specification part + integer(kind=kind(m2j2)) :: t_s1bm2j2 + !ERROR: Forward reference to 'm2s1j2' is not allowed in the same specification part + integer(kind=kind(m2s1j2)) :: t_s1bm2s1j2 + !ERROR: No explicit type declared for 'm2s1j3' + integer(kind=kind(m2s1j3)) :: t_m2s1j3 + integer :: m2j2, m2s1j2, m2s1j3 + end block + contains + subroutine s2 + !ERROR: Forward reference to 'm2j3' is not allowed in the same specification part + integer(kind=kind(m2j3)) :: t_m2j3 + !ERROR: No explicit type declared for 'm2s1j3' + integer(kind=kind(m2s1j3)) :: t_m2s1j3 + integer :: m2j3, m2s1j3, m2s2j1 + block + !ERROR: Forward reference to 'm2j4' is not allowed in the same specification part + integer(kind=kind(m2j4)) :: t_m2j4 + !ERROR: Forward reference to 'm2s1j4' is not allowed in the same specification part + integer(kind=kind(m2s1j4)) :: t_m2s1j4 + !ERROR: Forward reference to 'm2s2j1' is not allowed in the same specification part + integer(kind=kind(m2s2j1)) :: t_m2s2j1 + !ERROR: No explicit type declared for 'm2s2j2' + integer(kind=kind(m2s2j2)) :: t_m2s2j2 + integer :: m2j4, m2s1j4, m2s2j1, m2s2j2 + end block + end subroutine + end subroutine +end module + +! Case that elicited bad errors +SUBROUTINE KEEL + INTEGER NODES + CONTAINS + SUBROUTINE SGEOM + REAL :: RADIUS(nodes) + END SUBROUTINE +END SUBROUTINE KEEL