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 @@ -821,7 +821,8 @@ bool BeginSubprogram(const parser::Name &, Symbol::Flag, bool hasModulePrefix = false, - const parser::LanguageBindingSpec * = nullptr); + const parser::LanguageBindingSpec * = nullptr, + const ProgramTree::EntryStmtList * = nullptr); bool BeginMpSubprogram(const parser::Name &); void PushBlockDataScope(const parser::Name &); void EndSubprogram(); @@ -3373,12 +3374,16 @@ entryDetails.set_entryScope(inclusiveScope); if (inFunction) { // Create the entity to hold the function result, if necessary. - Symbol *resultSymbol{nullptr}; auto &effectiveResultName{*(resultName ? resultName : &name)}; - resultSymbol = FindInScope(currScope(), effectiveResultName); + Symbol *resultSymbol{FindInScope(currScope(), effectiveResultName)}; if (resultSymbol) { // C1574 common::visit( - common::visitors{[](EntityDetails &x) { x.set_funcResult(true); }, + common::visitors{[resultSymbol](UnknownDetails &) { + EntityDetails entity; + entity.set_funcResult(true); + resultSymbol->set_details(std::move(entity)); + }, + [](EntityDetails &x) { x.set_funcResult(true); }, [](ObjectEntityDetails &x) { x.set_funcResult(true); }, [](ProcEntityDetails &x) { x.set_funcResult(true); }, [&](const auto &) { @@ -3388,6 +3393,11 @@ context().SetError(*resultSymbol); }}, resultSymbol->details()); + // The Function flag will have been set if the ENTRY's symbol was created + // as a placeholder in BeginSubprogram. This prevents misuse of the ENTRY + // as a subroutine. Clear it now because it's inappropriate for a + // function result. + resultSymbol->set(Symbol::Flag::Function, false); } else if (!inSpecificationPart_) { ObjectEntityDetails entity; entity.set_funcResult(true); @@ -3509,7 +3519,8 @@ // A subprogram or interface declared with SUBROUTINE or FUNCTION bool SubprogramVisitor::BeginSubprogram(const parser::Name &name, Symbol::Flag subpFlag, bool hasModulePrefix, - const parser::LanguageBindingSpec *bindingSpec) { + const parser::LanguageBindingSpec *bindingSpec, + const ProgramTree::EntryStmtList *entryStmts) { if (hasModulePrefix && currScope().IsGlobal()) { // C1547 Say(name, "'%s' is a MODULE procedure which must be declared within a " @@ -3546,6 +3557,21 @@ } if (IsFunction(currScope())) { funcResultStack().Push(); + if (entryStmts) { + // It's possible to refer to the function result variable of an ENTRY + // statement that lacks an explicit RESULT in code that appears before the + // ENTRY. Create a placeholder symbol now for that case so that the name + // doesn't resolve instead to the ENTRY's symbol in the scope around the + // function. + for (const auto &ref : *entryStmts) { + const auto &suffix{std::get>(ref->t)}; + if (!(suffix && suffix->resultName)) { + Symbol &symbol{MakeSymbol(std::get(ref->t).source, + Attrs{}, UnknownDetails{})}; + symbol.set(Symbol::Flag::Function); + } + } + } } return true; } @@ -7364,7 +7390,7 @@ case ProgramTree::Kind::Function: case ProgramTree::Kind::Subroutine: return BeginSubprogram(node.name(), node.GetSubpFlag(), - node.HasModulePrefix(), node.bindingSpec()); + node.HasModulePrefix(), node.bindingSpec(), &node.entryStmts()); case ProgramTree::Kind::MpSubprogram: return BeginMpSubprogram(node.name()); case ProgramTree::Kind::Module: diff --git a/flang/test/Semantics/entry01.f90 b/flang/test/Semantics/entry01.f90 --- a/flang/test/Semantics/entry01.f90 +++ b/flang/test/Semantics/entry01.f90 @@ -108,8 +108,8 @@ entry ibadt4() result(alloc) !ERROR: Result of ENTRY is not compatible with result of containing function entry ibadt5() result(ptr) + !ERROR: Cannot call function 'isubr' like a subroutine call isubr - !ERROR: 'isubr' was previously called as a subroutine entry isubr() continue ! force transition to execution part entry implicit() @@ -204,3 +204,11 @@ !ERROR: No explicit type declared for 'implicitbad2' entry implicitbad2 end + +module m5 + contains + real function setBefore + ent = 1.0 + entry ent + end function +end module