[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.
This commit is contained in:
Peter Klausler
2023-10-16 17:08:28 -07:00
committed by GitHub
parent 28a686a704
commit 11d07d9ef6
2 changed files with 80 additions and 16 deletions

View File

@@ -779,6 +779,7 @@ public:
return false;
}
void MapSymbolExprs(Symbol &);
Symbol *CopySymbol(const Symbol *);
private:
void MapParamValue(ParamValue &param) const { (*this)(param.GetExplicit()); }
@@ -797,16 +798,44 @@ private:
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 &copy{*pair.first->second};
map_.symbolMap[symbol] = &copy;
copy.set(symbol->test(Symbol::Flag::Subroutine)
? Symbol::Flag::Subroutine
: Symbol::Flag::Function);
Scope &newScope{scope_.MakeScope(Scope::Kind::Subprogram, &copy)};
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 &copy;
}
}
} 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);
}

View File

@@ -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