[flang] Map symbols in expressions when copying interface symbols

[klausler]

Summary

Given a MODULE SUBROUTINE or MODULE FUNCTION interface followed
later by a corresponding separate module subprogram definition in a
MODULE PROCEDURE, the copies of the interface's dummy argument and
function result symbols that populate the initial scope of that
MODULE PROCEDURE need to have any symbol references in their types
or bounds adjusted to point to their new counterparts.

[vdonaldson]

Thanks for the fix!

flang/include/flang/Evaluate/call.h

struct ProcedureDesignator {
   EVALUATE_UNION_CLASS_BOILERPLATE(ProcedureDesignator)
   explicit ProcedureDesignator(SpecificIntrinsic &&i) : u{std::move(i)} {}
   explicit ProcedureDesignator(const Symbol &n) : u{n} {}
   explicit ProcedureDesignator(Component &&);
 
   // Exactly one of these will return a non-null pointer.
   const SpecificIntrinsic *GetSpecificIntrinsic() const;
   const Symbol *GetSymbol() const; // symbol or component symbol
+  const SymbolRef *UnwrapSymbolRef() const; // null if intrinsic or component
 
   // For references to NOPASS components and bindings only.
   // References to PASS components and bindings are represented
   // with the symbol below and the base object DataRef in the
   // passed-object ActualArgument.
   // Always null when the procedure is intrinsic.
   const Component *GetComponent() const;
 

flang/include/flang/Evaluate/traverse.h

 public:
   explicit Traverse(Visitor &v) : visitor_{v} {}
 
   // Packaging
   template <typename A, bool C>
   Result operator()(const common::Indirection<A, C> &x) const {
     return visitor_(x.value());
   }
-  template <typename A> Result operator()(const SymbolRef x) const {
+  template <typename _> Result operator()(const SymbolRef x) const {
     return visitor_(*x);
   }
   template <typename A> Result operator()(const std::unique_ptr<A> &x) const {
     return visitor_(x.get());
   }
   template <typename A> Result operator()(const std::shared_ptr<A> &x) const {
     return visitor_(x.get());
   }
public:
   Result operator()(const StaticDataObject &) const {
     return visitor_.Default();
   }
   Result operator()(const ImpliedDoIndex &) const { return visitor_.Default(); }
 
   // Variables
   Result operator()(const BaseObject &x) const { return visitor_(x.u); }
   Result operator()(const Component &x) const {
-    return Combine(x.base(), x.GetLastSymbol());
+    return Combine(x.base(), x.symbol());
   }
   Result operator()(const NamedEntity &x) const {
     if (const Component * component{x.UnwrapComponent()}) {
       return visitor_(*component);
     } else {
-      return visitor_(x.GetFirstSymbol());
+      return visitor_(DEREF(x.UnwrapSymbolRef()));
     }
   }
   Result operator()(const TypeParamInquiry &x) const {
     return visitor_(x.base());
   }
   Result operator()(const Triplet &x) const {
     return Combine(x.lower(), x.upper(), x.stride());
   }

flang/include/flang/Evaluate/variable.h

public:
   CLASS_BOILERPLATE(Component)
   Component(const DataRef &b, const Symbol &c) : base_{b}, symbol_{c} {}
   Component(DataRef &&b, const Symbol &c) : base_{std::move(b)}, symbol_{c} {}
   Component(common::CopyableIndirection<DataRef> &&b, const Symbol &c)
       : base_{std::move(b)}, symbol_{c} {}
 
   const DataRef &base() const { return base_.value(); }
   DataRef &base() { return base_.value(); }
+  const SymbolRef &symbol() const { return symbol_; }
+  SymbolRef &symbol() { return symbol_; }
+
   int Rank() const;
   const Symbol &GetFirstSymbol() const;
   const Symbol &GetLastSymbol() const { return symbol_; }
   std::optional<Expr<SubscriptInteger>> LEN() const;
   bool operator==(const Component &) const;
   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
 
 private:
public:
   explicit NamedEntity(const Symbol &symbol) : u_{symbol} {}
   explicit NamedEntity(Component &&c) : u_{std::move(c)} {}
 
   bool IsSymbol() const { return std::holds_alternative<SymbolRef>(u_); }
   const Symbol &GetFirstSymbol() const;
   const Symbol &GetLastSymbol() const;
   const Component &GetComponent() const { return std::get<Component>(u_); }
   Component &GetComponent() { return std::get<Component>(u_); }
-  const Component *UnwrapComponent() const; // null if just a Symbol
+  const SymbolRef *UnwrapSymbolRef() const; // null if a Component
+  SymbolRef *UnwrapSymbolRef();
+  const Component *UnwrapComponent() const; // null if not a Component
   Component *UnwrapComponent();
 
   int Rank() const;
   std::optional<Expr<SubscriptInteger>> LEN() const;
   bool operator==(const NamedEntity &) const;
   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
 
 private:

flang/include/flang/Semantics/symbol.h

public:
   const std::vector<Symbol *> &dummyArgs() const { return dummyArgs_; }
   void add_dummyArg(Symbol &symbol) { dummyArgs_.push_back(&symbol); }
   void add_alternateReturn() { dummyArgs_.push_back(nullptr); }
   const MaybeExpr &stmtFunction() const { return stmtFunction_; }
   void set_stmtFunction(SomeExpr &&expr) { stmtFunction_ = std::move(expr); }
   Symbol *moduleInterface() { return moduleInterface_; }
   const Symbol *moduleInterface() const { return moduleInterface_; }
   void set_moduleInterface(Symbol &);
+  void ReplaceResult(Symbol &result) {
+    CHECK(result_ != nullptr);
+    result_ = &result;
+  }
 
 private:
   bool isInterface_{false}; // true if this represents an interface-body
   bool isDummy_{false}; // true when interface of dummy procedure
   std::vector<Symbol *> dummyArgs_; // nullptr -> alternate return indicator
   Symbol *result_{nullptr};
   Scope *entryScope_{nullptr}; // if ENTRY, points to subprogram's scope
   MaybeExpr stmtFunction_;

flang/include/flang/Semantics/type.h

public:
   DerivedTypeSpec(const DerivedTypeSpec &);
   DerivedTypeSpec(DerivedTypeSpec &&);
 
   const SourceName &name() const { return name_; }
   const Symbol &typeSymbol() const { return typeSymbol_; }
   const Scope *scope() const { return scope_; }
   void set_scope(const Scope &);
   void ReplaceScope(const Scope &);
-  RawParameters &rawParameters() { return rawParameters_; }
+  const RawParameters &rawParameters() const { return rawParameters_; }
   const ParameterMapType &parameters() const { return parameters_; }
 
   bool MightBeParameterized() const;
   bool IsForwardReferenced() const;
   bool HasDefaultInitialization(bool ignoreAllocatable = false) const;
   bool HasDestruction() const;
 
   // The "raw" type parameter list is a simple transcription from the
   // parameter list in the parse tree, built by calling AddRawParamValue().
   // It can be used with forward-referenced derived types.
-  void AddRawParamValue(const std::optional<parser::Keyword> &, ParamValue &&);
+  void AddRawParamValue(const parser::Keyword *, ParamValue &&);
   // Checks the raw parameter list against the definition of a derived type.
   // Converts the raw parameter list to a map, naming each actual parameter.
   void CookParameters(evaluate::FoldingContext &);
   // Evaluates type parameter expressions.
   void EvaluateParameters(SemanticsContext &);
   void AddParamValue(SourceName, ParamValue &&);
   // Creates a Scope for the type and populates it with component
   // instantiations that have been specialized with actual type parameter

flang/lib/Evaluate/call.cpp

return common::visit(
           [](const common::CopyableIndirection<Component> &c) {
             return &c.value().GetLastSymbol();
           },
           [](const auto &) -> const Symbol * { return nullptr; },
       },
       u);
 }
 
+const SymbolRef *ProcedureDesignator::UnwrapSymbolRef() const {
+  return std::get_if<SymbolRef>(&u);
+}
+
 std::string ProcedureDesignator::GetName() const {
   return common::visit(
       common::visitors{
           [](const SpecificIntrinsic &i) { return i.name; },
           [](const Symbol &symbol) { return symbol.name().ToString(); },
           [](const common::CopyableIndirection<Component> &c) {
             return c.value().GetLastSymbol().name().ToString();
           },

flang/lib/Evaluate/variable.cpp

return common::visit(common::visitors{
                            [](SymbolRef s) -> const Symbol & { return s; },
                            [](const Component &c) -> const Symbol & {
                              return c.GetLastSymbol();
                            },
                        },
       u_);
 }
 
+const SymbolRef *NamedEntity::UnwrapSymbolRef() const {
+  return common::visit(
+      common::visitors{
+          [](const SymbolRef &s) { return &s; },
+          [](const Component &) -> const SymbolRef * { return nullptr; },
+      },
+      u_);
+}
+
+SymbolRef *NamedEntity::UnwrapSymbolRef() {
+  return common::visit(common::visitors{
+                           [](SymbolRef &s) { return &s; },
+                           [](Component &) -> SymbolRef * { return nullptr; },
+                       },
+      u_);
+}
+
 const Component *NamedEntity::UnwrapComponent() const {
   return common::visit(
       common::visitors{
           [](SymbolRef) -> const Component * { return nullptr; },
           [](const Component &c) { return &c; },
       },
       u_);
 }

flang/lib/Semantics/mod-file.cpp

void SubprogramSymbolCollector::DoParamValue(const ParamValue &paramValue) {
   }
 }
 
 // Do we need a IMPORT of this symbol into an interface block?
 bool SubprogramSymbolCollector::NeedImport(
     const SourceName &name, const Symbol &symbol) {
   if (!isInterface_) {
     return false;
+  } else if (IsSeparateModuleProcedureInterface(&symbol_)) {
+    return false; // IMPORT needed only for external and dummy procedure
+                  // interfaces
   } else if (&symbol == scope_.symbol()) {
     return false;
   } else if (symbol.owner().Contains(scope_)) {
     return true;
-  } else if (const Symbol * found{scope_.FindSymbol(name)}) {
+  } else if (const Symbol *found{scope_.FindSymbol(name)}) {
     // detect import from ancestor of use-associated symbol
     return found->has<UseDetails>() && found->owner() != scope_;
   } else {
     // "found" can be null in the case of a use-associated derived type's parent
     // type
     CHECK(symbol.has<DerivedTypeDetails>());
     return false;
   }
 }
 
 } // namespace Fortran::semantics

flang/lib/Semantics/resolve-names-utils.h

private:
   EquivalenceSet currSet_; // equivalence set currently being constructed
   struct {
     Symbol *symbol{nullptr};
     std::vector<ConstantSubscript> subscripts;
     std::optional<ConstantSubscript> substringStart;
   } currObject_; // equivalence object currently being constructed
 };
 
+// Duplicates a subprogram's dummy arguments and result, if any, and
+// maps all of the symbols in their expressions.
+struct SymbolAndTypeMappings;
+void MapSubprogramToNewSymbols(const Symbol &oldSymbol, Symbol &newSymbol,
+    Scope &newScope, SymbolAndTypeMappings * = nullptr);
+
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_RESOLVE_NAMES_H_

flang/lib/Semantics/resolve-names-utils.cpp

 //===-- lib/Semantics/resolve-names-utils.cpp -----------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "resolve-names-utils.h"
 #include "flang/Common/Fortran-features.h"
 #include "flang/Common/Fortran.h"
 #include "flang/Common/idioms.h"
 #include "flang/Common/indirection.h"
 #include "flang/Evaluate/fold.h"
 #include "flang/Evaluate/tools.h"
+#include "flang/Evaluate/traverse.h"
 #include "flang/Evaluate/type.h"
 #include "flang/Parser/char-block.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Semantics/expression.h"
 #include "flang/Semantics/semantics.h"
 #include "flang/Semantics/tools.h"
 #include <initializer_list>
 #include <variant>
for (const auto &pair : *derived->typeSymbol().scope()) {
       }
     }
     return true;
   } else {
     return false;
   }
 }
 
+// MapSubprogramToNewSymbols() relies on the following recursive symbol/scope
+// copying infrastructure to duplicate an interface's symbols and map all
+// of the symbol references in their contained expressions and interfaces
+// to the new symbols.
+
+struct SymbolAndTypeMappings {
+  std::map<const Symbol *, const Symbol *> symbolMap;
+  std::map<const DeclTypeSpec *, const DeclTypeSpec *> typeMap;
+};
+
+class SymbolMapper : public evaluate::AnyTraverse<SymbolMapper, bool> {
+public:
+  using Base = evaluate::AnyTraverse<SymbolMapper, bool>;
+  SymbolMapper(Scope &scope, SymbolAndTypeMappings &map)
+      : Base{*this}, scope_{scope}, map_{map} {}
+  using Base::operator();
+  bool operator()(const SymbolRef &ref) const {
+    if (const Symbol *mapped{MapSymbol(*ref)}) {
+      const_cast<SymbolRef &>(ref) = *mapped;
+    }
+    return false;
+  }
+  bool operator()(const Symbol &x) const {
+    if (MapSymbol(x)) {
+      DIE("SymbolMapper hit symbol outside SymbolRef");
+    }
+    return false;
+  }
+  void MapSymbolExprs(Symbol &);
+
+private:
+  void MapParamValue(ParamValue &param) const { (*this)(param.GetExplicit()); }
+  void MapBound(Bound &bound) const { (*this)(bound.GetExplicit()); }
+  void MapShapeSpec(ShapeSpec &spec) const {
+    MapBound(spec.lbound());
+    MapBound(spec.ubound());
+  }
+  const Symbol *MapSymbol(const Symbol &) const;
+  const Symbol *MapSymbol(const Symbol *) const;
+  const DeclTypeSpec *MapType(const DeclTypeSpec &);
+  const DeclTypeSpec *MapType(const DeclTypeSpec *);
+  const Symbol *MapInterface(const Symbol *);
+
+  Scope &scope_;
+  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);
+      }
+    }
+  }
+  common::visit(common::visitors{[&](ObjectEntityDetails &object) {
+                                   for (ShapeSpec &spec : object.shape()) {
+                                     MapShapeSpec(spec);
+                                   }
+                                   for (ShapeSpec &spec : object.coshape()) {
+                                     MapShapeSpec(spec);
+                                   }
+                                 },
+                    [&](ProcEntityDetails &proc) {
+                      if (const Symbol *mappedSymbol{
+                              MapInterface(proc.interface().symbol())}) {
+                        proc.interface().set_symbol(*mappedSymbol);
+                      } else if (const DeclTypeSpec *mappedType{
+                                     MapType(proc.interface().type())}) {
+                        proc.interface().set_type(*mappedType);
+                      }
+                      if (proc.init()) {
+                        if (const Symbol *mapped{MapSymbol(*proc.init())}) {
+                          proc.set_init(*mapped);
+                        }
+                      }
+                    },
+                    [&](const HostAssocDetails &hostAssoc) {
+                      if (const Symbol *mapped{MapSymbol(hostAssoc.symbol())}) {
+                        symbol.set_details(HostAssocDetails{*mapped});
+                      }
+                    },
+                    [](const auto &) {}},
+      symbol.details());
+}
+
+const Symbol *SymbolMapper::MapSymbol(const Symbol &symbol) const {
+  if (auto iter{map_.symbolMap.find(&symbol)}; iter != map_.symbolMap.end()) {
+    return iter->second;
+  }
+  return nullptr;
+}
+
+const Symbol *SymbolMapper::MapSymbol(const Symbol *symbol) const {
+  return symbol ? MapSymbol(*symbol) : nullptr;
+}
+
+const DeclTypeSpec *SymbolMapper::MapType(const DeclTypeSpec &type) {
+  if (auto iter{map_.typeMap.find(&type)}; iter != map_.typeMap.end()) {
+    return iter->second;
+  }
+  const DeclTypeSpec *newType{nullptr};
+  if (type.category() == DeclTypeSpec::Category::Character) {
+    const CharacterTypeSpec &charType{type.characterTypeSpec()};
+    if (charType.length().GetExplicit()) {
+      ParamValue newLen{charType.length()};
+      (*this)(newLen.GetExplicit());
+      newType = &scope_.MakeCharacterType(
+          std::move(newLen), KindExpr{charType.kind()});
+    }
+  } else if (const DerivedTypeSpec *derived{type.AsDerived()}) {
+    if (!derived->parameters().empty()) {
+      DerivedTypeSpec newDerived{derived->name(), derived->typeSymbol()};
+      newDerived.CookParameters(scope_.context().foldingContext());
+      for (const auto &[paramName, paramValue] : derived->parameters()) {
+        ParamValue newParamValue{paramValue};
+        MapParamValue(newParamValue);
+        newDerived.AddParamValue(paramName, std::move(newParamValue));
+      }
+      // Scope::InstantiateDerivedTypes() instantiates it later.
+      newType = &scope_.MakeDerivedType(type.category(), std::move(newDerived));
+    }
+  }
+  if (newType) {
+    map_.typeMap[&type] = newType;
+  }
+  return newType;
+}
+
+const DeclTypeSpec *SymbolMapper::MapType(const DeclTypeSpec *type) {
+  return type ? MapType(*type) : nullptr;
+}
+
+const Symbol *SymbolMapper::MapInterface(const Symbol *interface) {
+  if (const Symbol *mapped{MapSymbol(interface)}) {
+    return mapped;
+  }
+  if (interface) {
+    if (&interface->owner() != &scope_) {
+      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 nullptr;
+}
+
+void MapSubprogramToNewSymbols(const Symbol &oldSymbol, Symbol &newSymbol,
+    Scope &newScope, SymbolAndTypeMappings *mappings) {
+  SymbolAndTypeMappings newMappings;
+  if (!mappings) {
+    mappings = &newMappings;
+  }
+  mappings->symbolMap[&oldSymbol] = &newSymbol;
+  const auto &oldDetails{oldSymbol.get<SubprogramDetails>()};
+  auto &newDetails{newSymbol.get<SubprogramDetails>()};
+  for (const Symbol *dummyArg : oldDetails.dummyArgs()) {
+    if (!dummyArg) {
+      newDetails.add_alternateReturn();
+    } else if (Symbol *copy{newScope.CopySymbol(*dummyArg)}) {
+      newDetails.add_dummyArg(*copy);
+      mappings->symbolMap[dummyArg] = copy;
+    }
+  }
+  if (oldDetails.isFunction()) {
+    newScope.erase(newSymbol.name());
+    if (Symbol *copy{newScope.CopySymbol(oldDetails.result())}) {
+      newDetails.set_result(*copy);
+      mappings->symbolMap[&oldDetails.result()] = copy;
+    }
+  }
+  SymbolMapper mapper{newScope, *mappings};
+  for (auto &[_, ref] : newScope) {
+    mapper.MapSymbolExprs(*ref);
+  }
+  newScope.InstantiateDerivedTypes();
+}
+
 } // namespace Fortran::semantics

flang/lib/Semantics/resolve-names.cpp

bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
   }
   if (symbol->owner() == currScope() && symbol->scope()) {
     // This is a MODULE PROCEDURE whose interface appears in its host.
     // Convert the module procedure's interface into a subprogram.
     SetScope(DEREF(symbol->scope()));
     symbol->get<SubprogramDetails>().set_isInterface(false);
   } else {
     // Copy the interface into a new subprogram scope.
+    EraseSymbol(name);
     Symbol &newSymbol{MakeSymbol(name, SubprogramDetails{})};
     PushScope(Scope::Kind::Subprogram, &newSymbol);
-    const auto &details{symbol->get<SubprogramDetails>()};
-    auto &newDetails{newSymbol.get<SubprogramDetails>()};
-    newDetails.set_moduleInterface(*symbol);
-    for (const Symbol *dummyArg : details.dummyArgs()) {
-      if (!dummyArg) {
-        newDetails.add_alternateReturn();
-      } else if (Symbol * copy{currScope().CopySymbol(*dummyArg)}) {
-        newDetails.add_dummyArg(*copy);
-      }
-    }
-    if (details.isFunction()) {
-      currScope().erase(symbol->name());
-      newDetails.set_result(*currScope().CopySymbol(details.result()));
-    }
+    newSymbol.get<SubprogramDetails>().set_moduleInterface(*symbol);
     newSymbol.attrs() |= symbol->attrs();
+    newSymbol.set(symbol->test(Symbol::Flag::Subroutine)
+            ? Symbol::Flag::Subroutine
+            : Symbol::Flag::Function);
+    MapSubprogramToNewSymbols(*symbol, newSymbol, currScope());
   }
   return true;
 }
 
 // A subprogram or interface declared with SUBROUTINE or FUNCTION
 bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
     Symbol::Flag subpFlag, bool hasModulePrefix,
     const parser::LanguageBindingSpec *bindingSpec,
for (const auto &typeParamSpec :
     }
     const auto &value{std::get<parser::TypeParamValue>(typeParamSpec.t)};
     // The expressions in a derived type specifier whose values define
     // non-defaulted type parameters are evaluated (folded) in the enclosing
     // scope.  The KIND/LEN distinction is resolved later in
     // DerivedTypeSpec::CookParameters().
     ParamValue param{GetParamValue(value, common::TypeParamAttr::Kind)};
     if (!param.isExplicit() || param.GetExplicit()) {
-      spec->AddRawParamValue(optKeyword, std::move(param));
+      spec->AddRawParamValue(
+          common::GetPtrFromOptional(optKeyword), std::move(param));
     }
   }
   // The DerivedTypeSpec *spec is used initially as a search key.
   // If it turns out to have the same name and actual parameter
   // value expressions as another DerivedTypeSpec in the current
   // scope does, then we'll use that extant spec; otherwise, when this
   // spec is distinct from all derived types previously instantiated
   // in the current scope, this spec will be moved into that collection.

flang/lib/Semantics/runtime-type-info.cpp

if (!derivedTypeSpec && !dtScope.IsDerivedTypeWithKindParameter() &&
     DerivedTypeSpec derived{dtScope.symbol()->name(), *dtScope.symbol()};
     if (const SymbolVector *
         lenParameters{GetTypeParameters(*dtScope.symbol())}) {
       // Create dummy deferred values for the length parameters so that the
       // DerivedTypeSpec is complete and can be used in helpers.
       for (SymbolRef lenParam : *lenParameters) {
         (void)lenParam;
         derived.AddRawParamValue(
-            std::nullopt, ParamValue::Deferred(common::TypeParamAttr::Len));
+            nullptr, ParamValue::Deferred(common::TypeParamAttr::Len));
       }
       derived.CookParameters(context_.foldingContext());
     }
     DeclTypeSpec &decl{
         dtScope.MakeDerivedType(DeclTypeSpec::TypeDerived, std::move(derived))};
     derivedTypeSpec = &decl.derivedTypeSpec();
   }
   const Symbol *dtSymbol{

flang/lib/Semantics/symbol.cpp

return common::visit(
             [&](const DerivedTypeDetails &) {
               const auto *derived{this->detailsIf<DerivedTypeDetails>()};
               return derived && derived->isForwardReferenced();
             },
             [&](const UseDetails &x) {
               const auto *use{this->detailsIf<UseDetails>()};
               return use && use->symbol() == x.symbol();
             },
+            [&](const HostAssocDetails &) {
+              return this->has<HostAssocDetails>();
+            },
             [](const auto &) { return false; },
         },
         details);
   }
 }
 
 // Usually a symbol's name is the first occurrence in the source, but sometimes
 // we want to replace it with one at a different location (but same characters).

flang/lib/Semantics/type.cpp

void DerivedTypeSpec::set_scope(const Scope &scope) {
   ReplaceScope(scope);
 }
 void DerivedTypeSpec::ReplaceScope(const Scope &scope) {
   CHECK(scope.IsDerivedType());
   scope_ = &scope;
 }
 
 void DerivedTypeSpec::AddRawParamValue(
-    const std::optional<parser::Keyword> &keyword, ParamValue &&value) {
+    const parser::Keyword *keyword, ParamValue &&value) {
   CHECK(parameters_.empty());
-  rawParameters_.emplace_back(keyword ? &*keyword : nullptr, std::move(value));
+  rawParameters_.emplace_back(keyword, std::move(value));
 }
 
 void DerivedTypeSpec::CookParameters(evaluate::FoldingContext &foldingContext) {
   if (cooked_) {
     return;
   }
   cooked_ = true;
   auto &messages{foldingContext.messages()};

flang/test/Semantics/modproc01.f90

+!RUN: %flang_fc1 -fdebug-dump-symbols %s | FileCheck %s
+module m
+  type pdt1(k1,l1)
+    integer, kind :: k1
+    integer, len :: l1
+    type(pdt2(k1,l1)), allocatable :: a1
+  end type pdt1
+  type pdt2(k2,l2)
+    integer, kind :: k2
+    integer, len :: l2
+    integer(k2) :: j2
+    type(pdt1(k2,l2)) :: a2(k2)
+  end type pdt2
+  interface
+    module function mf(n,str,x1) result(res)
+      integer, intent(in) :: n
+      character(n), intent(in) :: str
+      type(pdt1(1,n)), intent(in) :: x1
+      type(pdt2(2,n)) :: res
+    end function
+    module subroutine ms(f)
+      procedure(mf) :: f
+    end subroutine
+  end interface
+end module
+!CHECK:    mf, MODULE, PUBLIC (Function): Subprogram isInterface result:TYPE(pdt2(k2=2_4,l2=n)) res (INTEGER(4) n,CHARACTER(n,1) str,TYPE(pdt1(k1=1_4,l1=n)) x1)
+!CHECK:    pdt1, PUBLIC: DerivedType components: a1
+!CHECK:    pdt2, PUBLIC: DerivedType components: j2,a2
+!CHECK:    sm: Module (m)
+!CHECK:    DerivedType scope: pdt1
+!CHECK:      a1, ALLOCATABLE: ObjectEntity type: TYPE(pdt2(int(k1,kind=4),int(l1,kind=4)))
+!CHECK:      k1: TypeParam type:INTEGER(4) Kind
+!CHECK:      l1: TypeParam type:INTEGER(4) Len
+!CHECK:    DerivedType scope: pdt2
+!CHECK:      a2: ObjectEntity type: TYPE(pdt1(k1=int(k2,kind=4),l1=int(l2,kind=4))) shape: 1_8:k2
+!CHECK:      j2: ObjectEntity type: INTEGER(int(int(k2,kind=4),kind=8))
+!CHECK:      k2: TypeParam type:INTEGER(4) Kind
+!CHECK:      l2: TypeParam type:INTEGER(4) Len
+!CHECK:    Subprogram scope: mf size=112 alignment=8
+!CHECK:      mf (Function): HostAssoc
+!CHECK:      n, INTENT(IN) size=4 offset=0: ObjectEntity dummy type: INTEGER(4)
+!CHECK:      res size=40 offset=72: ObjectEntity funcResult type: TYPE(pdt2(k2=2_4,l2=n))
+!CHECK:      str, INTENT(IN) size=24 offset=8: ObjectEntity dummy type: CHARACTER(n,1)
+!CHECK:      x1, INTENT(IN) size=40 offset=32: ObjectEntity dummy type: TYPE(pdt1(k1=1_4,l1=n))
+!CHECK:      DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=1_4,l1=n)
+!CHECK:        a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=1_4,l2=int(l1,kind=4)))
+!CHECK:        k1: TypeParam type:INTEGER(4) Kind init:1_4
+!CHECK:        l1: TypeParam type:INTEGER(4) Len init:n
+!CHECK:        DerivedType scope: size=72 alignment=8 instantiation of pdt2(k2=1_4,l2=int(l1,kind=4))
+!CHECK:          a2 size=64 offset=8: ObjectEntity type: TYPE(pdt1(k1=1_4,l1=int(l2,kind=4))) shape: 1_8:1_8
+!CHECK:          j2 size=1 offset=0: ObjectEntity type: INTEGER(1)
+!CHECK:          k2: TypeParam type:INTEGER(4) Kind init:1_4
+!CHECK:          l2: TypeParam type:INTEGER(4) Len init:int(l1,kind=4)
+!CHECK:          DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=1_4,l1=int(l2,kind=4))
+!CHECK:            a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=1_4,l2=int(l1,kind=4)))
+!CHECK:            k1: TypeParam type:INTEGER(4) Kind init:1_4
+!CHECK:            l1: TypeParam type:INTEGER(4) Len init:int(l2,kind=4)
+!CHECK:      DerivedType scope: size=72 alignment=8 instantiation of pdt2(k2=2_4,l2=n)
+!CHECK:        a2 size=64 offset=8: ObjectEntity type: TYPE(pdt1(k1=2_4,l1=int(l2,kind=4))) shape: 1_8:2_8
+!CHECK:        j2 size=2 offset=0: ObjectEntity type: INTEGER(2)
+!CHECK:        k2: TypeParam type:INTEGER(4) Kind init:2_4
+!CHECK:        l2: TypeParam type:INTEGER(4) Len init:n
+!CHECK:        DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=2_4,l1=int(l2,kind=4))
+!CHECK:          a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=2_4,l2=int(l1,kind=4)))
+!CHECK:          k1: TypeParam type:INTEGER(4) Kind init:2_4
+!CHECK:          l1: TypeParam type:INTEGER(4) Len init:int(l2,kind=4)
+!CHECK:          DerivedType scope: size=72 alignment=8 instantiation of pdt2(k2=2_4,l2=int(l1,kind=4))
+!CHECK:            a2 size=64 offset=8: ObjectEntity type: TYPE(pdt1(k1=2_4,l1=int(l2,kind=4))) shape: 1_8:2_8
+!CHECK:            j2 size=2 offset=0: ObjectEntity type: INTEGER(2)
+!CHECK:            k2: TypeParam type:INTEGER(4) Kind init:2_4
+!CHECK:            l2: TypeParam type:INTEGER(4) Len init:int(l1,kind=4)
+
+submodule(m) sm
+ contains
+  module procedure mf
+    print *, len(str), x1%k1, x1%l1, res%k2, res%l2
+    allocate(res%a2(1)%a1)
+    res%a2(1)%a1%j2 = 2
+  end procedure
+  module procedure ms
+!    type(pdt2(2.3)) x
+!    x = f(3, "abc", pdt1(1,3)())
+  end procedure
+end submodule
+!CHECK:    Module scope: sm size=0 alignment=1
+!CHECK:      mf, MODULE, PUBLIC (Function): Subprogram result:TYPE(pdt2(k2=2_4,l2=n)) res (INTEGER(4) n,CHARACTER(n,1) str,TYPE(pdt1(k1=1_4,l1=n)) x1) moduleInterface: mf, MODULE, PUBLIC (Function): Subprogram isInterface result:TYPE(pdt2(k2=2_4,l2=n)) res (INTEGER(4) n,CHARACTER(n,1) str,TYPE(pdt1(k1=1_4,l1=n)) x1)
+!CHECK:      Subprogram scope: mf size=112 alignment=8
+!CHECK:        len, INTRINSIC, PURE (Function): ProcEntity
+!CHECK:        n, INTENT(IN) size=4 offset=0: ObjectEntity dummy type: INTEGER(4)
+!CHECK:        res size=40 offset=72: ObjectEntity funcResult type: TYPE(pdt2(k2=2_4,l2=n))
+!CHECK:        str, INTENT(IN) size=24 offset=8: ObjectEntity dummy type: CHARACTER(n,1)
+!CHECK:        x1, INTENT(IN) size=40 offset=32: ObjectEntity dummy type: TYPE(pdt1(k1=1_4,l1=n))
+!CHECK:        DerivedType scope: size=72 alignment=8 instantiation of pdt2(k2=2_4,l2=n)
+!CHECK:          a2 size=64 offset=8: ObjectEntity type: TYPE(pdt1(k1=2_4,l1=int(l2,kind=4))) shape: 1_8:2_8
+!CHECK:          j2 size=2 offset=0: ObjectEntity type: INTEGER(2)
+!CHECK:          k2: TypeParam type:INTEGER(4) Kind init:2_4
+!CHECK:          l2: TypeParam type:INTEGER(4) Len init:n
+!CHECK:          DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=2_4,l1=int(l2,kind=4))
+!CHECK:            a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=2_4,l2=int(l1,kind=4)))
+!CHECK:            k1: TypeParam type:INTEGER(4) Kind init:2_4
+!CHECK:            l1: TypeParam type:INTEGER(4) Len init:int(l2,kind=4)
+!CHECK:            DerivedType scope: size=72 alignment=8 instantiation of pdt2(k2=2_4,l2=int(l1,kind=4))
+!CHECK:              a2 size=64 offset=8: ObjectEntity type: TYPE(pdt1(k1=2_4,l1=int(l2,kind=4))) shape: 1_8:2_8
+!CHECK:              j2 size=2 offset=0: ObjectEntity type: INTEGER(2)
+!CHECK:              k2: TypeParam type:INTEGER(4) Kind init:2_4
+!CHECK:              l2: TypeParam type:INTEGER(4) Len init:int(l1,kind=4)
+!CHECK:        DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=1_4,l1=n)
+!CHECK:          a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=1_4,l2=int(l1,kind=4)))
+!CHECK:          k1: TypeParam type:INTEGER(4) Kind init:1_4
+!CHECK:          l1: TypeParam type:INTEGER(4) Len init:n
+!CHECK:          DerivedType scope: size=72 alignment=8 instantiation of pdt2(k2=1_4,l2=int(l1,kind=4))
+!CHECK:            a2 size=64 offset=8: ObjectEntity type: TYPE(pdt1(k1=1_4,l1=int(l2,kind=4))) shape: 1_8:1_8
+!CHECK:            j2 size=1 offset=0: ObjectEntity type: INTEGER(1)
+!CHECK:            k2: TypeParam type:INTEGER(4) Kind init:1_4
+!CHECK:            l2: TypeParam type:INTEGER(4) Len init:int(l1,kind=4)
+!CHECK:            DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=1_4,l1=int(l2,kind=4))
+!CHECK:              a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=1_4,l2=int(l1,kind=4)))
+!CHECK:              k1: TypeParam type:INTEGER(4) Kind init:1_4
+!CHECK:              l1: TypeParam type:INTEGER(4) Len init:int(l2,kind=4)
+
+program test
+  use m
+  type(pdt2(2,3)) x
+  x = mf(3, "abc", pdt1(1,3)())
+!  call ms(mf)
+end program
+!CHECK:  MainProgram scope: test size=88 alignment=8
+!CHECK:    mf, MODULE (Function): Use from mf in m
+!CHECK:    pdt1: Use from pdt1 in m
+!CHECK:    pdt2: Use from pdt2 in m
+!CHECK:    x size=88 offset=0: ObjectEntity type: TYPE(pdt2(k2=2_4,l2=3_4))
+!CHECK:    DerivedType scope: size=88 alignment=8 instantiation of pdt2(k2=2_4,l2=3_4)
+!CHECK:      a2 size=80 offset=8: ObjectEntity type: TYPE(pdt1(k1=2_4,l1=3_4)) shape: 1_8:2_8
+!CHECK:      j2 size=2 offset=0: ObjectEntity type: INTEGER(2)
+!CHECK:      k2: TypeParam type:INTEGER(4) Kind init:2_4
+!CHECK:      l2: TypeParam type:INTEGER(4) Len init:3_4
+!CHECK:      DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=2_4,l1=3_4)
+!CHECK:        a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=2_4,l2=3_4))
+!CHECK:        k1: TypeParam type:INTEGER(4) Kind init:2_4
+!CHECK:        l1: TypeParam type:INTEGER(4) Len init:3_4
+!CHECK:    DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=1_4,l1=3_4)
+!CHECK:      a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=1_4,l2=3_4))
+!CHECK:      k1: TypeParam type:INTEGER(4) Kind init:1_4
+!CHECK:      l1: TypeParam type:INTEGER(4) Len init:3_4
+!CHECK:      DerivedType scope: size=1 alignment=1 instantiation of pdt2(k2=1_4,l2=3_4)
+!CHECK:        a2: ObjectEntity type: TYPE(pdt1(k1=1_4,l1=3_4)) shape: 1_8:1_8
+!CHECK:        j2 size=1 offset=0: ObjectEntity type: INTEGER(1)
+!CHECK:        k2: TypeParam type:INTEGER(4) Kind init:1_4
+!CHECK:        l2: TypeParam type:INTEGER(4) Len init:3_4