diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -537,6 +537,7 @@ LocalityShared, // named in SHARED locality-spec InDataStmt, // initialized in a DATA statement, =>object, or /init/ InNamelist, // in a Namelist group + EntryDummyArgument, CompilerCreated, // A compiler created symbol // For compiler created symbols that are constant but cannot legally have // the PARAMETER attribute. 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 @@ -667,6 +667,7 @@ void AcquireIntrinsicProcedureFlags(Symbol &); const DeclTypeSpec *GetImplicitType( Symbol &, bool respectImplicitNoneType = true); + void CheckEntryDummyUse(SourceName, Symbol *); bool ConvertToObjectEntity(Symbol &); bool ConvertToProcEntity(Symbol &); @@ -873,7 +874,8 @@ Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag, const parser::LanguageBindingSpec * = nullptr); Symbol *GetSpecificFromGeneric(const parser::Name &); - SubprogramDetails &PostSubprogramStmt(); + Symbol &PostSubprogramStmt(); + void CreateDummyArgument(SubprogramDetails &, const parser::Name &); void CreateEntry(const parser::EntryStmt &stmt, Symbol &subprogram); void PostEntryStmt(const parser::EntryStmt &stmt); void HandleLanguageBinding(Symbol *, @@ -2489,6 +2491,16 @@ return type; } +void ScopeHandler::CheckEntryDummyUse(SourceName source, Symbol *symbol) { + if (!inSpecificationPart_ && symbol && + symbol->test(Symbol::Flag::EntryDummyArgument)) { + Say(source, + "Dummy argument '%s' may not be used before its ENTRY statement"_err_en_US, + symbol->name()); + symbol->set(Symbol::Flag::EntryDummyArgument, false); + } +} + // Convert symbol to be a ObjectEntity or return false if it can't be. bool ScopeHandler::ConvertToObjectEntity(Symbol &symbol) { if (symbol.has()) { @@ -3423,11 +3435,11 @@ Walk(std::get(stmt.t)); Walk(std::get>(stmt.t)); // Don't traverse the LanguageBindingSpec now; it's deferred to EndSubprogram. - auto &details{PostSubprogramStmt()}; + Symbol &symbol{PostSubprogramStmt()}; + SubprogramDetails &details{symbol.get()}; for (const auto &dummyArg : std::get>(stmt.t)) { if (const auto *dummyName{std::get_if(&dummyArg.u)}) { - Symbol &dummy{MakeSymbol(*dummyName, EntityDetails{true})}; - details.add_dummyArg(dummy); + CreateDummyArgument(details, *dummyName); } else { details.add_alternateReturn(); } @@ -3444,10 +3456,10 @@ void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) { const auto &name{std::get(stmt.t)}; - auto &details{PostSubprogramStmt()}; + Symbol &symbol{PostSubprogramStmt()}; + SubprogramDetails &details{symbol.get()}; for (const auto &dummyName : std::get>(stmt.t)) { - Symbol &dummy{MakeSymbol(dummyName, EntityDetails{true})}; - details.add_dummyArg(dummy); + CreateDummyArgument(details, dummyName); } const parser::Name *funcResultName; FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())}; @@ -3503,20 +3515,20 @@ // should be resolved to avoid internal errors. Resolve(*info.resultName, info.resultSymbol); } - name.symbol = currScope().symbol(); // must not be function result symbol + name.symbol = &symbol; // must not be function result symbol // Clear the RESULT() name now in case an ENTRY statement in the implicit-part // has a RESULT() suffix. info.resultName = nullptr; } -SubprogramDetails &SubprogramVisitor::PostSubprogramStmt() { +Symbol &SubprogramVisitor::PostSubprogramStmt() { Symbol &symbol{*currScope().symbol()}; SetExplicitAttrs(symbol, EndAttrs()); if (symbol.attrs().test(Attr::MODULE)) { symbol.attrs().set(Attr::EXTERNAL, false); symbol.implicitAttrs().set(Attr::EXTERNAL, false); } - return symbol.get(); + return symbol; } void SubprogramVisitor::Post(const parser::EntryStmt &stmt) { @@ -3527,6 +3539,30 @@ EndAttrs(); } +void SubprogramVisitor::CreateDummyArgument( + SubprogramDetails &details, const parser::Name &name) { + Symbol *dummy{FindInScope(name)}; + if (dummy) { + if (IsDummy(*dummy)) { + if (dummy->test(Symbol::Flag::EntryDummyArgument)) { + dummy->set(Symbol::Flag::EntryDummyArgument, false); + } else { + Say(name, + "'%s' appears more than once as a dummy argument name in this subprogram"_err_en_US, + name.source); + return; + } + } else { + SayWithDecl(name, *dummy, + "'%s' may not appear as a dummy argument name in this subprogram"_err_en_US); + return; + } + } else { + dummy = &MakeSymbol(name, EntityDetails{true}); + } + details.add_dummyArg(DEREF(dummy)); +} + void SubprogramVisitor::CreateEntry( const parser::EntryStmt &stmt, Symbol &subprogram) { const auto &entryName{std::get(stmt.t)}; @@ -3636,7 +3672,39 @@ assoc.set(Symbol::Flag::Subroutine); } Resolve(entryName, *entrySymbol); - Details details{std::move(entryDetails)}; + std::set dummies; + for (const auto &dummyArg : std::get>(stmt.t)) { + if (const auto *dummyName{std::get_if(&dummyArg.u)}) { + auto pair{dummies.insert(dummyName->source)}; + if (!pair.second) { + Say(*dummyName, + "'%s' appears more than once as a dummy argument name in this ENTRY statement"_err_en_US, + dummyName->source); + continue; + } + Symbol *dummy{FindInScope(*dummyName)}; + if (dummy) { + if (!IsDummy(*dummy)) { + evaluate::AttachDeclaration( + Say(*dummyName, + "'%s' may not appear as a dummy argument name in this ENTRY statement"_err_en_US, + dummyName->source), + *dummy); + continue; + } + } else { + dummy = &MakeSymbol(*dummyName, EntityDetails{true}); + dummy->set(Symbol::Flag::EntryDummyArgument); + } + entryDetails.add_dummyArg(DEREF(dummy)); + } else if (subpFlag == Symbol::Flag::Function) { // C1573 + Say(entryName, + "ENTRY in a function may not have an alternate return dummy argument"_err_en_US); + break; + } else { + entryDetails.add_alternateReturn(); + } + } entrySymbol->set_details(std::move(entryDetails)); } @@ -3674,33 +3742,19 @@ SetBindNameOn(entrySymbol); for (const auto &dummyArg : std::get>(stmt.t)) { if (const auto *dummyName{std::get_if(&dummyArg.u)}) { - Symbol *dummy{FindSymbol(*dummyName)}; - if (dummy) { - common::visit( - common::visitors{[](EntityDetails &x) { x.set_isDummy(); }, - [](ObjectEntityDetails &x) { x.set_isDummy(); }, - [](ProcEntityDetails &x) { x.set_isDummy(); }, - [](SubprogramDetails &x) { x.set_isDummy(); }, - [&](const auto &) { - Say2(dummyName->source, - "ENTRY dummy argument '%s' is previously declared as an item that may not be used as a dummy argument"_err_en_US, - dummy->name(), "Previous declaration of '%s'"_en_US); - }}, - dummy->details()); - } else { - dummy = &MakeSymbol(*dummyName, EntityDetails{true}); - if (!inSpecificationPart_) { - ApplyImplicitRules(*dummy); + if (Symbol * dummy{FindInScope(*dummyName)}) { + if (dummy->test(Symbol::Flag::EntryDummyArgument)) { + const auto *subp{dummy->detailsIf()}; + if (subp && subp->isInterface()) { // ok + } else if (!dummy->has() && + !dummy->has() && + !dummy->has()) { + SayWithDecl(*dummyName, *dummy, + "ENTRY dummy argument '%s' was previously declared as an item that may not be used as a dummy argument"_err_en_US); + } + dummy->set(Symbol::Flag::EntryDummyArgument, false); } } - entryDetails.add_dummyArg(*dummy); - } else { - if (entrySymbol.test(Symbol::Flag::Function)) { // C1573 - Say(name, - "ENTRY in a function may not have an alternate return dummy argument"_err_en_US); - break; - } - entryDetails.add_alternateReturn(); } } } @@ -4063,6 +4117,8 @@ symbol.ReplaceName(name.source); if (const auto &init{std::get>(x.t)}) { ConvertToObjectEntity(symbol) || ConvertToProcEntity(symbol); + symbol.set( + Symbol::Flag::EntryDummyArgument, false); // forestall excessive errors Initialization(name, *init, false); } else if (attrs.test(Attr::PARAMETER)) { // C882, C883 Say(name, "Missing initialization for parameter '%s'"_err_en_US); @@ -6741,6 +6797,7 @@ MakeHostAssocSymbol(name, *symbol); } else if (IsDummy(*symbol) || (!symbol->GetType() && FindCommonBlockContaining(*symbol))) { + CheckEntryDummyUse(name.source, symbol); ConvertToObjectEntity(*symbol); ApplyImplicitRules(*symbol); } @@ -6844,6 +6901,7 @@ } } } + CheckEntryDummyUse(base->source, base->symbol); auto &symbol{base->symbol->GetUltimate()}; if (!symbol.has() && !ConvertToObjectEntity(symbol)) { SayWithDecl(*base, symbol, @@ -7063,6 +7121,7 @@ MakeExternal(*symbol); } } + CheckEntryDummyUse(name.source, symbol); ConvertToProcEntity(*symbol); SetProcFlag(name, *symbol, flag); } else if (CheckUseError(name)) { @@ -7070,6 +7129,7 @@ } else { auto &nonUltimateSymbol{*symbol}; symbol = &Resolve(name, symbol)->GetUltimate(); + CheckEntryDummyUse(name.source, symbol); bool convertedToProcEntity{ConvertToProcEntity(*symbol)}; if (convertedToProcEntity && !symbol->attrs().test(Attr::EXTERNAL) && IsIntrinsic(symbol->name(), flag) && !IsDummy(*symbol)) { @@ -7586,11 +7646,13 @@ void ResolveNamesVisitor::Post(const parser::AssignStmt &x) { if (auto *name{ResolveName(std::get(x.t))}) { + CheckEntryDummyUse(name->source, name->symbol); ConvertToObjectEntity(DEREF(name->symbol)); } } void ResolveNamesVisitor::Post(const parser::AssignedGotoStmt &x) { if (auto *name{ResolveName(std::get(x.t))}) { + CheckEntryDummyUse(name->source, name->symbol); ConvertToObjectEntity(DEREF(name->symbol)); } } 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 @@ -59,8 +59,8 @@ entry okargs(goodarg1, goodarg2) !ERROR: RESULT(br1) may appear only in a function entry badresult() result(br1) ! C1572 - !ERROR: ENTRY dummy argument 'badarg2' is previously declared as an item that may not be used as a dummy argument - !ERROR: ENTRY dummy argument 'badarg4' is previously declared as an item that may not be used as a dummy argument + !ERROR: 'badarg2' is already declared in this scoping unit + !ERROR: 'badarg4' is already declared in this scoping unit entry badargs(badarg1,badarg2,badarg3,badarg4,badarg5) end subroutine @@ -244,3 +244,14 @@ external e end subroutine end module + +!ERROR: 'q' appears more than once as a dummy argument name in this subprogram +subroutine s7(q,q) + !ERROR: Dummy argument 'x' may not be used before its ENTRY statement + call x + entry foo(x) + !ERROR: 's7' may not appear as a dummy argument name in this ENTRY statement + entry bar(s7) + !ERROR: 'z' appears more than once as a dummy argument name in this ENTRY statement + entry baz(z,z) +end