diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp index ebc7aab3744d..b901080e2860 100644 --- a/flang/lib/Semantics/resolve-names-utils.cpp +++ b/flang/lib/Semantics/resolve-names-utils.cpp @@ -779,6 +779,7 @@ public: return false; } void MapSymbolExprs(Symbol &); + Symbol *CopySymbol(const Symbol *); private: void MapParamValue(ParamValue ¶m) const { (*this)(param.GetExplicit()); } @@ -797,16 +798,44 @@ private: SymbolAndTypeMappings &map_; }; -void SymbolMapper::MapSymbolExprs(Symbol &symbol) { - if (auto *object{symbol.detailsIf()}) { - if (const DeclTypeSpec *type{object->type()}) { - if (const DeclTypeSpec *newType{MapType(*type)}) { - object->ReplaceType(*newType); +Symbol *SymbolMapper::CopySymbol(const Symbol *symbol) { + if (symbol) { + if (auto *subp{symbol->detailsIf()}) { + if (subp->isInterface()) { + if (auto pair{scope_.try_emplace(symbol->name(), symbol->attrs())}; + pair.second) { + Symbol ©{*pair.first->second}; + map_.symbolMap[symbol] = © + copy.set(symbol->test(Symbol::Flag::Subroutine) + ? Symbol::Flag::Subroutine + : Symbol::Flag::Function); + Scope &newScope{scope_.MakeScope(Scope::Kind::Subprogram, ©)}; + copy.set_scope(&newScope); + copy.set_details(SubprogramDetails{}); + auto &newSubp{copy.get()}; + newSubp.set_isInterface(true); + newSubp.set_isDummy(subp->isDummy()); + newSubp.set_defaultIgnoreTKR(subp->defaultIgnoreTKR()); + MapSubprogramToNewSymbols(*symbol, copy, newScope, &map_); + return © + } } + } else if (Symbol * copy{scope_.CopySymbol(*symbol)}) { + map_.symbolMap[symbol] = copy; + return copy; } } + return nullptr; +} + +void SymbolMapper::MapSymbolExprs(Symbol &symbol) { common::visit( common::visitors{[&](ObjectEntityDetails &object) { + if (const DeclTypeSpec * type{object.type()}) { + if (const DeclTypeSpec * newType{MapType(*type)}) { + object.ReplaceType(*newType); + } + } for (ShapeSpec &spec : object.shape()) { MapShapeSpec(spec); } @@ -892,13 +921,7 @@ const Symbol *SymbolMapper::MapInterface(const Symbol *interface) { return interface; } else if (const auto *subp{interface->detailsIf()}; subp && subp->isInterface()) { - if (Symbol *newSymbol{scope_.CopySymbol(*interface)}) { - newSymbol->get().set_isInterface(true); - map_.symbolMap[interface] = newSymbol; - Scope &newScope{scope_.MakeScope(Scope::Kind::Subprogram, newSymbol)}; - MapSubprogramToNewSymbols(*interface, *newSymbol, newScope, &map_); - return newSymbol; - } + return CopySymbol(interface); } } return nullptr; @@ -913,10 +936,11 @@ void MapSubprogramToNewSymbols(const Symbol &oldSymbol, Symbol &newSymbol, mappings->symbolMap[&oldSymbol] = &newSymbol; const auto &oldDetails{oldSymbol.get()}; auto &newDetails{newSymbol.get()}; + SymbolMapper mapper{newScope, *mappings}; for (const Symbol *dummyArg : oldDetails.dummyArgs()) { if (!dummyArg) { newDetails.add_alternateReturn(); - } else if (Symbol *copy{newScope.CopySymbol(*dummyArg)}) { + } else if (Symbol * copy{mapper.CopySymbol(dummyArg)}) { copy->set(Symbol::Flag::Implicit, false); newDetails.add_dummyArg(*copy); mappings->symbolMap[dummyArg] = copy; @@ -924,12 +948,12 @@ void MapSubprogramToNewSymbols(const Symbol &oldSymbol, Symbol &newSymbol, } if (oldDetails.isFunction()) { newScope.erase(newSymbol.name()); - if (Symbol *copy{newScope.CopySymbol(oldDetails.result())}) { + const Symbol &result{oldDetails.result()}; + if (Symbol * copy{mapper.CopySymbol(&result)}) { newDetails.set_result(*copy); - mappings->symbolMap[&oldDetails.result()] = copy; + mappings->symbolMap[&result] = copy; } } - SymbolMapper mapper{newScope, *mappings}; for (auto &[_, ref] : newScope) { mapper.MapSymbolExprs(*ref); } diff --git a/flang/test/Semantics/separate-mp05.f90 b/flang/test/Semantics/separate-mp05.f90 new file mode 100644 index 000000000000..5b7e2523a228 --- /dev/null +++ b/flang/test/Semantics/separate-mp05.f90 @@ -0,0 +1,40 @@ +! RUN: %python %S/test_symbols.py %s %flang_fc1 +! Ensure that SMPs work with dummy procedures declared as interfaces +!DEF: /m Module +module m + implicit none + interface + !DEF: /m/smp MODULE, PUBLIC, PURE (Function) Subprogram REAL(4) + !DEF: /m/smp/f EXTERNAL, PURE (Function) Subprogram REAL(4) + !DEF: /m/smp/x INTENT(IN) ObjectEntity REAL(4) + !DEF: /m/smp/res (Implicit) ObjectEntity REAL(4) + pure module function smp(f, x) result(res) + interface + !REF: /m/smp/f + !DEF: /m/smp/f/x INTENT(IN) ObjectEntity REAL(4) + !DEF: /m/smp/f/r ObjectEntity REAL(4) + pure function f(x) result(r) + !REF: /m/smp/f/x + real, intent(in) :: x + !REF: /m/smp/f/r + real r + end function + end interface + !REF: /m/smp/x + real, intent(in) :: x + end function + end interface +end module +!REF: /m +!DEF: /m/sm Module +submodule (m)sm + implicit none +contains + !DEF: /m/sm/smp MODULE, PUBLIC, PURE (Function) Subprogram REAL(4) + module procedure smp + !DEF: /m/sm/smp/res (Implicit) ObjectEntity REAL(4) + !DEF: /m/sm/smp/f EXTERNAL, PURE (Function) Subprogram REAL(4) + !DEF: /m/sm/smp/x INTENT(IN) ObjectEntity REAL(4) + res = f(x) + end procedure +end submodule