[flang] Handle separate module procedures with INTERFACE dummy arguments

[klausler]

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 #66631.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Changes

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 #66631.

---

Full diff: https://github.com/llvm/llvm-project/pull/67608.diff

2 Files Affected:

• (modified) flang/lib/Semantics/resolve-names-utils.cpp (+40-16)
• (added) flang/test/Semantics/separate-mp05.f90 (+40)

diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 2f8e5777c529020..e90b098b0a669ff 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 &param) 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 &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);
   }
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

[jeanPerier]

LGTM

[jeanPerier]

The else case of this is a no-op, there is never a case where one would want a non interface SubprogramDetails to be copied into a new scope?

[klausler]

If a SubprogramDetails is not an interface, then it's not a dummy procedure and not a procedure pointer, and it doesn't need to be localized.