[flang-commits] [flang] 11d07d9 - [flang] Handle separate module procedures with INTERFACE dummy arguments (#67608)
via flang-commits
flang-commits at lists.llvm.org
Mon Oct 16 17:08:33 PDT 2023
Author: Peter Klausler
Date: 2023-10-16T17:08:28-07:00
New Revision: 11d07d9ef618497b825badee8b4f06a48575606b
URL: https://github.com/llvm/llvm-project/commit/11d07d9ef618497b825badee8b4f06a48575606b
DIFF: https://github.com/llvm/llvm-project/commit/11d07d9ef618497b825badee8b4f06a48575606b.diff
LOG: [flang] Handle separate module procedures with INTERFACE dummy arguments (#67608)
The code that duplicates the interface of a separate module procedure
into its definition doesn't allow for a dummy procedure with an explicit
INTERFACE declaration. Extend the code to handle this case.
Fixes https://github.com/llvm/llvm-project/issues/66631.
Added:
flang/test/Semantics/separate-mp05.f90
Modified:
flang/lib/Semantics/resolve-names-utils.cpp
Removed:
################################################################################
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index ebc7aab3744d540..b901080e2860c43 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -779,6 +779,7 @@ class SymbolMapper : public evaluate::AnyTraverse<SymbolMapper, bool> {
return false;
}
void MapSymbolExprs(Symbol &);
+ Symbol *CopySymbol(const Symbol *);
private:
void MapParamValue(ParamValue ¶m) const { (*this)(param.GetExplicit()); }
@@ -797,16 +798,44 @@ class SymbolMapper : public evaluate::AnyTraverse<SymbolMapper, bool> {
SymbolAndTypeMappings &map_;
};
-void SymbolMapper::MapSymbolExprs(Symbol &symbol) {
- if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
- 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<SubprogramDetails>()}) {
+ 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<SubprogramDetails>()};
+ 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<SubprogramDetails>()};
subp && subp->isInterface()) {
- if (Symbol *newSymbol{scope_.CopySymbol(*interface)}) {
- newSymbol->get<SubprogramDetails>().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<SubprogramDetails>()};
auto &newDetails{newSymbol.get<SubprogramDetails>()};
+ 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 000000000000000..5b7e2523a228667
--- /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
More information about the flang-commits
mailing list