diff --git a/flang/lib/Semantics/program-tree.h b/flang/lib/Semantics/program-tree.h --- a/flang/lib/Semantics/program-tree.h +++ b/flang/lib/Semantics/program-tree.h @@ -81,6 +81,13 @@ bool HasModulePrefix() const; // in function or subroutine stmt Scope *scope() const { return scope_; } void set_scope(Scope &); + const parser::LanguageBindingSpec *bindingSpec() const { + return bindingSpec_; + } + ProgramTree &set_bindingSpec(const parser::LanguageBindingSpec *spec) { + bindingSpec_ = spec; + return *this; + } void AddChild(ProgramTree &&); void AddEntry(const parser::EntryStmt &); void AddGeneric(const parser::GenericSpec &); @@ -108,6 +115,7 @@ Scope *scope_{nullptr}; const parser::CharBlock *endStmt_{nullptr}; bool isSpecificationPartResolved_{false}; + const parser::LanguageBindingSpec *bindingSpec_{nullptr}; }; } // namespace Fortran::semantics diff --git a/flang/lib/Semantics/program-tree.cpp b/flang/lib/Semantics/program-tree.cpp --- a/flang/lib/Semantics/program-tree.cpp +++ b/flang/lib/Semantics/program-tree.cpp @@ -137,14 +137,32 @@ const auto &stmt{std::get>(x.t)}; const auto &end{std::get>(x.t)}; const auto &name{std::get(stmt.statement.t)}; - return BuildSubprogramTree(name, x).set_stmt(stmt).set_endStmt(end); + const parser::LanguageBindingSpec *bindingSpec{}; + if (const auto &suffix{ + std::get>(stmt.statement.t)}) { + if (suffix->binding) { + bindingSpec = &*suffix->binding; + } + } + return BuildSubprogramTree(name, x) + .set_stmt(stmt) + .set_endStmt(end) + .set_bindingSpec(bindingSpec); } ProgramTree ProgramTree::Build(const parser::SubroutineSubprogram &x) { const auto &stmt{std::get>(x.t)}; const auto &end{std::get>(x.t)}; const auto &name{std::get(stmt.statement.t)}; - return BuildSubprogramTree(name, x).set_stmt(stmt).set_endStmt(end); + const parser::LanguageBindingSpec *bindingSpec{}; + if (const auto &binding{std::get>( + stmt.statement.t)}) { + bindingSpec = &*binding; + } + return BuildSubprogramTree(name, x) + .set_stmt(stmt) + .set_endStmt(end) + .set_bindingSpec(bindingSpec); } ProgramTree ProgramTree::Build(const parser::SeparateModuleSubprogram &x) { 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 @@ -818,8 +818,9 @@ bool Pre(const parser::Suffix &); bool Pre(const parser::PrefixSpec &); - bool BeginSubprogram( - const parser::Name &, Symbol::Flag, bool hasModulePrefix = false); + bool BeginSubprogram(const parser::Name &, Symbol::Flag, + bool hasModulePrefix = false, + const parser::LanguageBindingSpec * = nullptr); bool BeginMpSubprogram(const parser::Name &); void PushBlockDataScope(const parser::Name &); void EndSubprogram(); @@ -834,7 +835,8 @@ bool HandlePreviousCalls(const parser::Name &, Symbol &, Symbol::Flag); void CheckExtantProc(const parser::Name &, Symbol::Flag); // Create a subprogram symbol in the current scope and push a new scope. - Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag); + Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag, + const parser::LanguageBindingSpec * = nullptr); Symbol *GetSpecificFromGeneric(const parser::Name &); SubprogramDetails &PostSubprogramStmt(const parser::Name &); }; @@ -2176,8 +2178,9 @@ if (auto *symbol{scope.symbol()}) { // Create a dummy symbol so we can't create another one with the same // name. It might already be there if we previously pushed the scope. - if (!FindInScope(scope, symbol->name())) { - auto &newSymbol{MakeSymbol(symbol->name())}; + SourceName name{symbol->name()}; + if (!FindInScope(scope, name)) { + auto &newSymbol{MakeSymbol(name)}; if (kind == Scope::Kind::Subprogram) { // Allow for recursive references. If this symbol is a function // without an explicit RESULT(), this new symbol will be discarded @@ -2197,7 +2200,9 @@ for (auto &pair : currScope()) { ConvertToObjectEntity(*pair.second); } - SetScope(currScope_->parent()); + // If popping back into a global scope, pop back to the main global scope. + SetScope(currScope_->parent().IsGlobal() ? context().globalScope() + : currScope_->parent()); } void ScopeHandler::SetScope(Scope &scope) { currScope_ = &scope; @@ -3295,8 +3300,11 @@ SubprogramDetails &SubprogramVisitor::PostSubprogramStmt( const parser::Name &name) { Symbol &symbol{*currScope().symbol()}; - CHECK(name.source == symbol.name()); + auto &subp{symbol.get()}; SetBindNameOn(symbol); + CHECK(name.source == symbol.name() || + (subp.bindName() && symbol.owner().IsGlobal() && + context().IsTempName(symbol.name().ToString()))); symbol.attrs() |= EndAttrs(); if (symbol.attrs().test(Attr::MODULE)) { symbol.attrs().set(Attr::EXTERNAL, false); @@ -3487,8 +3495,9 @@ } // A subprogram or interface declared with SUBROUTINE or FUNCTION -bool SubprogramVisitor::BeginSubprogram( - const parser::Name &name, Symbol::Flag subpFlag, bool hasModulePrefix) { +bool SubprogramVisitor::BeginSubprogram(const parser::Name &name, + Symbol::Flag subpFlag, bool hasModulePrefix, + const parser::LanguageBindingSpec *bindingSpec) { if (hasModulePrefix && currScope().IsGlobal()) { // C1547 Say(name, "'%s' is a MODULE procedure which must be declared within a " @@ -3514,7 +3523,7 @@ } } } - Symbol &newSymbol{PushSubprogramScope(name, subpFlag)}; + Symbol &newSymbol{PushSubprogramScope(name, subpFlag, bindingSpec)}; if (moduleInterface) { newSymbol.get().set_moduleInterface(*moduleInterface); if (moduleInterface->attrs().test(Attr::PRIVATE)) { @@ -3580,15 +3589,23 @@ } } -Symbol &SubprogramVisitor::PushSubprogramScope( - const parser::Name &name, Symbol::Flag subpFlag) { - auto *symbol{GetSpecificFromGeneric(name)}; +Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name, + Symbol::Flag subpFlag, const parser::LanguageBindingSpec *bindingSpec) { + Symbol *symbol{GetSpecificFromGeneric(name)}; if (!symbol) { + if (bindingSpec && currScope().IsGlobal() && bindingSpec->v) { + // Create this new top-level subprogram with a binding label + // in a new global scope, so that its symbol's name won't clash + // with another symbol that has a distinct binding label. + PushScope(Scope::Kind::Global, + &MakeSymbol(context().GetTempName(currScope()), Attrs{}, + MiscDetails{MiscDetails::Kind::ScopeName})); + } CheckExtantProc(name, subpFlag); symbol = &MakeSymbol(name, SubprogramDetails{}); } - symbol->set(subpFlag); symbol->ReplaceName(name.source); + symbol->set(subpFlag); PushScope(Scope::Kind::Subprogram, symbol); auto &details{symbol->get()}; if (inInterfaceBlock()) { @@ -7326,8 +7343,8 @@ return true; case ProgramTree::Kind::Function: case ProgramTree::Kind::Subroutine: - return BeginSubprogram( - node.name(), node.GetSubpFlag(), node.HasModulePrefix()); + return BeginSubprogram(node.name(), node.GetSubpFlag(), + node.HasModulePrefix(), node.bindingSpec()); case ProgramTree::Kind::MpSubprogram: return BeginMpSubprogram(node.name()); case ProgramTree::Kind::Module: diff --git a/flang/test/Semantics/bind-c01.f90 b/flang/test/Semantics/bind-c01.f90 --- a/flang/test/Semantics/bind-c01.f90 +++ b/flang/test/Semantics/bind-c01.f90 @@ -6,11 +6,11 @@ !ERROR: Two symbols have the same BIND(C) name 'x1' integer, bind(c, name=" x1 ") :: x2 contains - !ERROR: Two symbols have the same BIND(C) name 'x3' subroutine x3() bind(c, name="x3") end subroutine end module +!ERROR: Two symbols have the same BIND(C) name 'x3' subroutine x4() bind(c, name=" x3 ") end subroutine @@ -23,3 +23,9 @@ end module subroutine x5() bind(c, name=" x5 ") end subroutine + +! Ensure no error in this situation +subroutine foo() bind(c, name="x6") +end subroutine +subroutine foo() bind(c, name="x7") +end subroutine