[flang-commits] [flang] [Flang] Add partial support for lowering procedure pointer assignment. (PR #70461)

Daniel Chen via flang-commits flang-commits at lists.llvm.org
Thu Nov 16 07:50:53 PST 2023


https://github.com/DanielCChen updated https://github.com/llvm/llvm-project/pull/70461

>From 9ce3d2eab35553ab50bffb66e6e1fa05d93079e8 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Tue, 31 Oct 2023 13:35:38 -0400
Subject: [PATCH 01/15] [Flang] Add partial support for procedure pointer.

---
 flang/lib/Lower/Bridge.cpp                    |  9 ++-
 flang/lib/Lower/ConvertCall.cpp               | 16 +++--
 .../lib/Lower/ConvertProcedureDesignator.cpp  |  4 ++
 flang/lib/Lower/ConvertType.cpp               |  8 ++-
 flang/lib/Lower/ConvertVariable.cpp           | 58 +++++++++++++++++--
 5 files changed, 81 insertions(+), 14 deletions(-)

diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 872bf6bc729ecd0..a3914c76cb5317d 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3241,8 +3241,13 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       mlir::Location loc, const Fortran::evaluate::Assignment &assign,
       const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
     Fortran::lower::StatementContext stmtCtx;
-    if (Fortran::evaluate::IsProcedure(assign.rhs))
-      TODO(loc, "procedure pointer assignment");
+
+    if (Fortran::evaluate::IsProcedure(assign.rhs)) {
+      auto lhs{fir::getBase(genExprAddr(assign.lhs, stmtCtx, &loc))};
+      auto rhs{fir::getBase(genExprAddr(assign.rhs, stmtCtx, &loc))};
+      builder->create<fir::StoreOp>(loc, rhs, lhs);
+      return;
+    }
 
     std::optional<Fortran::evaluate::DynamicType> lhsType =
         assign.lhs.GetType();
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 82e1ece4efeafe7..a8bbab55d762c3f 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -165,8 +165,10 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
   // will be used only if there is no explicit length in the local interface).
   mlir::Value funcPointer;
   mlir::Value charFuncPointerLength;
+  bool isProcPtr = false;
   if (const Fortran::semantics::Symbol *sym =
           caller.getIfIndirectCallSymbol()) {
+    isProcPtr = Fortran::semantics::IsProcedurePointer(sym);
     funcPointer = fir::getBase(converter.getSymbolExtendedValue(*sym, &symMap));
     if (!funcPointer)
       fir::emitFatalError(loc, "failed to find indirect call symbol address");
@@ -325,10 +327,16 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
   // compatible interface in Fortran, but that have different signatures in
   // FIR.
   if (funcPointer) {
-    operands.push_back(
-        funcPointer.getType().isa<fir::BoxProcType>()
-            ? builder.create<fir::BoxAddrOp>(loc, funcType, funcPointer)
-            : builder.createConvert(loc, funcType, funcPointer));
+    if (isProcPtr) {
+      funcPointer = builder.create<fir::LoadOp>(loc, funcPointer);
+      auto boxProcTy{fir::BoxProcType::get(builder.getContext(), funcType)};
+      auto func{builder.createConvert(loc, boxProcTy, funcPointer)};
+      operands.push_back(builder.create<fir::BoxAddrOp>(loc, funcType, func));
+    } else
+      operands.push_back(
+          funcPointer.getType().isa<fir::BoxProcType>()
+              ? builder.create<fir::BoxAddrOp>(loc, funcType, funcPointer)
+              : builder.createConvert(loc, funcType, funcPointer));
   }
 
   // Deal with potential mismatches in arguments types. Passing an array to a
diff --git a/flang/lib/Lower/ConvertProcedureDesignator.cpp b/flang/lib/Lower/ConvertProcedureDesignator.cpp
index 20ade1a04049fc4..b02fb3eb38141c8 100644
--- a/flang/lib/Lower/ConvertProcedureDesignator.cpp
+++ b/flang/lib/Lower/ConvertProcedureDesignator.cpp
@@ -98,6 +98,10 @@ hlfir::EntityWithAttributes Fortran::lower::convertProcedureDesignatorToHLFIR(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const Fortran::evaluate::ProcedureDesignator &proc,
     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
+  if (std::optional<fir::FortranVariableOpInterface> varDef =
+          symMap.lookupVariableDefinition(*proc.GetSymbol()))
+    return *varDef;
+
   fir::ExtendedValue procExv =
       convertProcedureDesignator(loc, converter, proc, symMap, stmtCtx);
   // Directly package the procedure address as a fir.boxproc or
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 1ed3b602621b449..dbcaaced169ce3c 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -248,8 +248,12 @@ struct TypeBuilderImpl {
     // links, the fir type is built based on the ultimate symbol. This relies
     // on the fact volatile and asynchronous are not reflected in fir types.
     const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate();
-    if (Fortran::semantics::IsProcedurePointer(ultimate))
-      TODO(loc, "procedure pointers");
+
+    if (Fortran::semantics::IsProcedurePointer(ultimate)) {
+      Fortran::evaluate::ProcedureDesignator proc(ultimate);
+      return Fortran::lower::translateSignature(proc, converter);
+    }
+
     if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
       if (const Fortran::semantics::IntrinsicTypeSpec *tySpec =
               type->AsIntrinsic()) {
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index e8137886d2cf54b..e54406f031fb963 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -479,8 +479,20 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
   if (global && globalIsInitialized(global))
     return global;
 
-  if (Fortran::semantics::IsProcedurePointer(sym))
-    TODO(loc, "procedure pointer globals");
+  if (Fortran::semantics::IsProcedurePointer(sym)) {
+    auto boxProcTy{Fortran::lower::getUntypedBoxProcType(builder.getContext())};
+    global = builder.createGlobal(loc, boxProcTy, globalName, linkage,
+                                  mlir::Attribute{}, isConst, var.isTarget());
+    Fortran::lower::createGlobalInitialization(
+        builder, global, [&](fir::FirOpBuilder &builder) {
+          mlir::Value initVal{builder.create<fir::ZeroOp>(loc, symTy)};
+          auto emBoxVal{
+              builder.create<fir::EmboxProcOp>(loc, boxProcTy, initVal)};
+          builder.create<fir::HasValueOp>(loc, emBoxVal);
+        });
+    global.setVisibility(mlir::SymbolTable::Visibility::Public);
+    return global;
+  }
 
   // If this is an array, check to see if we can use a dense attribute
   // with a tensor mlir type. This optimization currently only supports
@@ -645,8 +657,19 @@ static mlir::Value createNewLocal(Fortran::lower::AbstractConverter &converter,
       var.getSymbol().GetUltimate();
   llvm::StringRef symNm = toStringRef(ultimateSymbol.name());
   bool isTarg = var.isTarget();
+
   // Let the builder do all the heavy lifting.
-  return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg);
+  if (!Fortran::semantics::IsProcedurePointer(ultimateSymbol))
+    return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg);
+
+  // Local procedure pointer.
+  auto boxProcTy{Fortran::lower::getUntypedBoxProcType(builder.getContext())};
+  auto res{builder.allocateLocal(loc, boxProcTy, nm, symNm, shape, lenParams,
+                                 isTarg)};
+  mlir::Value initVal{builder.create<fir::ZeroOp>(loc, ty)};
+  auto emBoxVal{builder.create<fir::EmboxProcOp>(loc, boxProcTy, initVal)};
+  builder.create<fir::StoreOp>(loc, emBoxVal, res);
+  return res;
 }
 
 /// Must \p var be default initialized at runtime when entering its scope.
@@ -1542,7 +1565,8 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
   // is useful to maintain the address of the commonblock in an MLIR value and
   // query it. hlfir.declare need not be created for these.
   if (converter.getLoweringOptions().getLowerToHighLevelFIR() &&
-      !Fortran::semantics::IsProcedure(sym) &&
+      (!Fortran::semantics::IsProcedure(sym) ||
+       Fortran::semantics::IsPointer(sym)) &&
       !sym.detailsIf<Fortran::semantics::CommonBlockDetails>()) {
     bool isCrayPointee =
         sym.test(Fortran::semantics::Symbol::Flag::CrayPointee);
@@ -1687,6 +1711,16 @@ genAllocatableOrPointerDeclare(Fortran::lower::AbstractConverter &converter,
                    /*lbounds=*/std::nullopt, force);
 }
 
+/// Map a procedure pointer
+static void genProcPointer(Fortran::lower::AbstractConverter &converter,
+                           Fortran::lower::SymMap &symMap,
+                           const Fortran::semantics::Symbol &sym,
+                           mlir::Value addr, bool force = false) {
+  genDeclareSymbol(converter, symMap, sym, addr, mlir::Value{},
+                   /*shape=*/std::nullopt,
+                   /*lbounds=*/std::nullopt, force);
+}
+
 /// Map a symbol represented with a runtime descriptor to its FIR fir.box and
 /// evaluated specification expressions. Will optionally create fir.declare.
 static void genBoxDeclare(Fortran::lower::AbstractConverter &converter,
@@ -1738,8 +1772,20 @@ void Fortran::lower::mapSymbolAttributes(
 
       Fortran::lower::genDeclareSymbol(converter, symMap, sym, undefOp);
     }
-    if (Fortran::semantics::IsPointer(sym))
-      TODO(loc, "procedure pointers");
+
+    // Procedure pointer.
+    if (Fortran::semantics::IsPointer(sym)) {
+      // global
+      mlir::Value boxAlloc = preAlloc;
+      // dummy or passed result
+      if (!boxAlloc)
+        if (Fortran::lower::SymbolBox symbox = symMap.lookupSymbol(sym))
+          boxAlloc = symbox.getAddr();
+      // local
+      if (!boxAlloc)
+        boxAlloc = createNewLocal(converter, loc, var, preAlloc);
+      genProcPointer(converter, symMap, sym, boxAlloc, replace);
+    }
     return;
   }
 

>From e1c72e3907ed8ff71f2f465cded278627255d07e Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Sun, 5 Nov 2023 20:38:46 -0500
Subject: [PATCH 02/15] [Flang] Lowering procedure pointer actual/dummy
 argument.

---
 .../flang/Optimizer/HLFIR/HLFIRDialect.h      |  6 +++
 flang/lib/Lower/CallInterface.cpp             | 42 ++++++++++---------
 flang/lib/Lower/ConvertCall.cpp               | 16 +++++++
 3 files changed, 44 insertions(+), 20 deletions(-)

diff --git a/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h b/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h
index aa68d0811c4868a..e8f28485298277d 100644
--- a/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h
+++ b/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h
@@ -67,6 +67,12 @@ inline bool isBoxAddressType(mlir::Type type) {
   return type && type.isa<fir::BaseBoxType>();
 }
 
+/// Is this a fir.boxproc address type?
+inline bool isBoxProcAddressType(mlir::Type type) {
+  type = fir::dyn_cast_ptrEleTy(type);
+  return type && type.isa<fir::BoxProcType>();
+}
+
 /// Is this a fir.box or fir.class address or value type?
 inline bool isBoxAddressOrValueType(mlir::Type type) {
   return fir::unwrapRefType(type).isa<fir::BaseBoxType>();
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 51b0579fac36c0f..d78a612808cfaf7 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -1055,30 +1055,32 @@ class Fortran::lower::CallInterfaceImpl {
       const DummyCharacteristics *characteristics,
       const Fortran::evaluate::characteristics::DummyProcedure &proc,
       const FortranEntity &entity) {
-    if (proc.attrs.test(
-            Fortran::evaluate::characteristics::DummyProcedure::Attr::Pointer))
-      TODO(interface.converter.getCurrentLocation(),
-           "procedure pointer arguments");
-    // Otherwise, it is a dummy procedure.
     const Fortran::evaluate::characteristics::Procedure &procedure =
         proc.procedure.value();
     mlir::Type funcType =
         getProcedureDesignatorType(&procedure, interface.converter);
-    std::optional<Fortran::evaluate::DynamicType> resultTy =
-        getResultDynamicType(procedure);
-    if (resultTy && mustPassLengthWithDummyProcedure(procedure)) {
-      // The result length of dummy procedures that are character functions must
-      // be passed so that the dummy procedure can be called if it has assumed
-      // length on the callee side.
-      mlir::Type tupleType =
-          fir::factory::getCharacterProcedureTupleType(funcType);
-      llvm::StringRef charProcAttr = fir::getCharacterProcedureDummyAttrName();
-      addFirOperand(tupleType, nextPassedArgPosition(), Property::CharProcTuple,
-                    {mlir::NamedAttribute{
-                        mlir::StringAttr::get(&mlirContext, charProcAttr),
-                        mlir::UnitAttr::get(&mlirContext)}});
-      addPassedArg(PassEntityBy::CharProcTuple, entity, characteristics);
-      return;
+    if (proc.attrs.test(Fortran::evaluate::characteristics::DummyProcedure::
+                            Attr::Pointer)) {
+      funcType = fir::ReferenceType::get(funcType);
+    } else { // Otherwise, it is a dummy procedure.
+      std::optional<Fortran::evaluate::DynamicType> resultTy =
+          getResultDynamicType(procedure);
+      if (resultTy && mustPassLengthWithDummyProcedure(procedure)) {
+        // The result length of dummy procedures that are character functions
+        // must be passed so that the dummy procedure can be called if it has
+        // assumed length on the callee side.
+        mlir::Type tupleType =
+            fir::factory::getCharacterProcedureTupleType(funcType);
+        llvm::StringRef charProcAttr =
+            fir::getCharacterProcedureDummyAttrName();
+        addFirOperand(tupleType, nextPassedArgPosition(),
+                      Property::CharProcTuple,
+                      {mlir::NamedAttribute{
+                          mlir::StringAttr::get(&mlirContext, charProcAttr),
+                          mlir::UnitAttr::get(&mlirContext)}});
+        addPassedArg(PassEntityBy::CharProcTuple, entity, characteristics);
+        return;
+      }
     }
     addFirOperand(funcType, nextPassedArgPosition(), Property::BaseAddress);
     addPassedArg(PassEntityBy::BaseAddress, entity, characteristics);
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index a8bbab55d762c3f..1a21751561ad67f 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -878,6 +878,22 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   // element if this is an array in an elemental call.
   hlfir::Entity actual = preparedActual.getActual(loc, builder);
 
+  // Handles the procedure pointer actual/dummy arguments.
+  // It could have a combination of
+  //     acutal             dummy
+  // 2.  procedure pointer  procedure pointer
+  // 3.  procedure pointer  procedure
+  // 4.  procedure          procedure pointer
+  if (hlfir::isBoxProcAddressType(actual.getType()) ||
+      hlfir::isBoxProcAddressType(dummyType)) {
+    if (actual.getType() != dummyType &&
+        hlfir::isBoxProcAddressType(actual.getType())) {
+      auto baseAddr{actual.getFirBase()};
+      actual = hlfir::Entity{builder.create<fir::LoadOp>(loc, baseAddr)};
+    }
+    return PreparedDummyArgument{actual, /*cleanups=*/{}};
+  }
+
   // Do nothing if this is a procedure argument. It is already a
   // fir.boxproc/fir.tuple<fir.boxproc, len> as it should.
   if (actual.isProcedure()) {

>From 0b19d7019ca38845ff2f8761fd214a8ec9c0cda4 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Fri, 10 Nov 2023 14:07:32 -0500
Subject: [PATCH 03/15] [Flang] Addressing multiple review comments. The
 details is in the PR.

---
 flang/include/flang/Lower/BoxAnalyzer.h       |  2 +
 .../flang/Lower/ConvertProcedureDesignator.h  | 11 +++
 .../flang/Optimizer/Builder/FIRBuilder.h      |  4 +
 .../flang/Optimizer/Builder/HLFIRTools.h      |  3 +
 flang/lib/Lower/Bridge.cpp                    | 18 +++-
 flang/lib/Lower/CallInterface.cpp             | 82 +++++++++++--------
 flang/lib/Lower/ConvertCall.cpp               | 33 ++------
 flang/lib/Lower/ConvertExprToHLFIR.cpp        |  4 +-
 .../lib/Lower/ConvertProcedureDesignator.cpp  | 13 +++
 flang/lib/Lower/ConvertType.cpp               |  3 +-
 flang/lib/Lower/ConvertVariable.cpp           | 73 +++++++++++------
 flang/lib/Optimizer/Builder/FIRBuilder.cpp    | 11 +++
 flang/lib/Optimizer/Builder/HLFIRTools.cpp    |  2 +
 13 files changed, 168 insertions(+), 91 deletions(-)

diff --git a/flang/include/flang/Lower/BoxAnalyzer.h b/flang/include/flang/Lower/BoxAnalyzer.h
index 52cded8b219d835..3b8e2455ff273be 100644
--- a/flang/include/flang/Lower/BoxAnalyzer.h
+++ b/flang/include/flang/Lower/BoxAnalyzer.h
@@ -382,6 +382,8 @@ class BoxAnalyzer : public fir::details::matcher<BoxAnalyzer> {
 
   /// Run the analysis on `sym`.
   void analyze(const Fortran::semantics::Symbol &sym) {
+    if (Fortran::semantics::IsProcedurePointer(sym))
+      return;
     if (symIsArray(sym)) {
       bool isConstant = !isAssumedSize(sym);
       llvm::SmallVector<int64_t> lbounds;
diff --git a/flang/include/flang/Lower/ConvertProcedureDesignator.h b/flang/include/flang/Lower/ConvertProcedureDesignator.h
index 86a757a9aadf4f4..b0d422b8c3ff88d 100644
--- a/flang/include/flang/Lower/ConvertProcedureDesignator.h
+++ b/flang/include/flang/Lower/ConvertProcedureDesignator.h
@@ -19,6 +19,8 @@
 
 namespace mlir {
 class Location;
+class Value;
+class Type;
 }
 namespace fir {
 class ExtendedValue;
@@ -29,6 +31,9 @@ class EntityWithAttributes;
 namespace Fortran::evaluate {
 struct ProcedureDesignator;
 }
+namespace Fortran::semantics {
+class Symbol;
+}
 
 namespace Fortran::lower {
 class AbstractConverter;
@@ -50,5 +55,11 @@ hlfir::EntityWithAttributes convertProcedureDesignatorToHLFIR(
     const Fortran::evaluate::ProcedureDesignator &proc,
     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx);
 
+/// Generate initialization for procedure pointer to procedure target.
+mlir::Value
+convertProcedureDesignatorToAddress(Fortran::lower::AbstractConverter &,
+                                    mlir::Location, mlir::Type boxType,
+                                    Fortran::lower::StatementContext &stmtCtx,
+                                    const Fortran::semantics::Symbol *sym);
 } // namespace Fortran::lower
 #endif // FORTRAN_LOWER_CONVERT_PROCEDURE_DESIGNATOR_H
diff --git a/flang/include/flang/Optimizer/Builder/FIRBuilder.h b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
index 0b36186d68a4614..b5b2c99810b15bb 100644
--- a/flang/include/flang/Optimizer/Builder/FIRBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
@@ -677,6 +677,10 @@ mlir::Value genCPtrOrCFunptrValue(fir::FirOpBuilder &builder,
 /// to keep all the lower bound and explicit parameter information.
 fir::BoxValue createBoxValue(fir::FirOpBuilder &builder, mlir::Location loc,
                              const fir::ExtendedValue &exv);
+
+/// Generate Null BoxProc for procedure pointer null initialization.
+mlir::Value createNullBoxProc(fir::FirOpBuilder &builder, mlir::Location loc,
+                              mlir::Type boxType);
 } // namespace fir::factory
 
 #endif // FORTRAN_OPTIMIZER_BUILDER_FIRBUILDER_H
diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
index 07bb380320bf712..999ac9c7a42fad2 100644
--- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h
+++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
@@ -58,6 +58,9 @@ class Entity : public mlir::Value {
   bool isValue() const { return isFortranValue(*this); }
   bool isVariable() const { return !isValue(); }
   bool isMutableBox() const { return hlfir::isBoxAddressType(getType()); }
+  bool isProcedurePointer() const {
+    return hlfir::isBoxProcAddressType(getType());
+  }
   bool isBoxAddressOrValue() const {
     return hlfir::isBoxAddressOrValueType(getType());
   }
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index a3914c76cb5317d..a10701e0fa68b5d 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3242,10 +3242,20 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
     Fortran::lower::StatementContext stmtCtx;
 
-    if (Fortran::evaluate::IsProcedure(assign.rhs)) {
-      auto lhs{fir::getBase(genExprAddr(assign.lhs, stmtCtx, &loc))};
-      auto rhs{fir::getBase(genExprAddr(assign.rhs, stmtCtx, &loc))};
-      builder->create<fir::StoreOp>(loc, rhs, lhs);
+    if (Fortran::evaluate::IsProcedurePointerTarget(assign.rhs)) {
+      hlfir::Entity lhs = Fortran::lower::convertExprToHLFIR(
+          loc, *this, assign.lhs, localSymbols, stmtCtx);
+      if (Fortran::evaluate::IsNullProcedurePointer(assign.rhs)) {
+        auto boxTy{Fortran::lower::getUntypedBoxProcType(&getMLIRContext())};
+        hlfir::Entity rhs(
+            fir::factory::createNullBoxProc(*builder, loc, boxTy));
+        builder->createStoreWithConvert(loc, rhs, lhs);
+        return;
+      }
+      hlfir::Entity rhs(getBase(Fortran::lower::convertExprToAddress(
+          loc, *this, assign.rhs, localSymbols, stmtCtx)));
+      rhs = hlfir::derefPointersAndAllocatables(loc, *builder, rhs);
+      builder->createStoreWithConvert(loc, rhs, lhs);
       return;
     }
 
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index d78a612808cfaf7..4b38ec488a439f0 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -23,6 +23,10 @@
 #include "flang/Semantics/tools.h"
 #include <optional>
 
+static mlir::FunctionType
+getProcedureType(const Fortran::evaluate::characteristics::Procedure &proc,
+                 Fortran::lower::AbstractConverter &converter);
+
 mlir::Type Fortran::lower::getUntypedBoxProcType(mlir::MLIRContext *context) {
   llvm::SmallVector<mlir::Type> resultTys;
   llvm::SmallVector<mlir::Type> inputTys;
@@ -1059,10 +1063,10 @@ class Fortran::lower::CallInterfaceImpl {
         proc.procedure.value();
     mlir::Type funcType =
         getProcedureDesignatorType(&procedure, interface.converter);
-    if (proc.attrs.test(Fortran::evaluate::characteristics::DummyProcedure::
-                            Attr::Pointer)) {
+    if (proc.attrs.test(
+            Fortran::evaluate::characteristics::DummyProcedure::Attr::Pointer))
       funcType = fir::ReferenceType::get(funcType);
-    } else { // Otherwise, it is a dummy procedure.
+    else { // Otherwise, it is a dummy procedure.
       std::optional<Fortran::evaluate::DynamicType> resultTy =
           getResultDynamicType(procedure);
       if (resultTy && mustPassLengthWithDummyProcedure(procedure)) {
@@ -1089,37 +1093,40 @@ class Fortran::lower::CallInterfaceImpl {
   void handleExplicitResult(
       const Fortran::evaluate::characteristics::FunctionResult &result) {
     using Attr = Fortran::evaluate::characteristics::FunctionResult::Attr;
-
-    if (result.IsProcedurePointer())
-      TODO(interface.converter.getCurrentLocation(),
-           "procedure pointer results");
-    const Fortran::evaluate::characteristics::TypeAndShape *typeAndShape =
-        result.GetTypeAndShape();
-    assert(typeAndShape && "expect type for non proc pointer result");
-    mlir::Type mlirType = translateDynamicType(typeAndShape->type());
-    fir::SequenceType::Shape bounds = getBounds(typeAndShape->shape());
-    const auto *resTypeAndShape{result.GetTypeAndShape()};
-    bool resIsPolymorphic =
-        resTypeAndShape && resTypeAndShape->type().IsPolymorphic();
-    bool resIsAssumedType =
-        resTypeAndShape && resTypeAndShape->type().IsAssumedType();
-    if (!bounds.empty())
-      mlirType = fir::SequenceType::get(bounds, mlirType);
-    if (result.attrs.test(Attr::Allocatable))
-      mlirType = fir::wrapInClassOrBoxType(fir::HeapType::get(mlirType),
-                                           resIsPolymorphic, resIsAssumedType);
-    if (result.attrs.test(Attr::Pointer))
-      mlirType = fir::wrapInClassOrBoxType(fir::PointerType::get(mlirType),
-                                           resIsPolymorphic, resIsAssumedType);
-
-    if (fir::isa_char(mlirType)) {
-      // Character scalar results must be passed as arguments in lowering so
-      // that an assumed length character function callee can access the result
-      // length. A function with a result requiring an explicit interface does
-      // not have to be compatible with assumed length function, but most
-      // compilers supports it.
-      handleImplicitCharacterResult(typeAndShape->type());
-      return;
+    mlir::Type mlirType;
+    if (auto proc{result.IsProcedurePointer()})
+      mlirType = fir::BoxProcType::get(
+          &mlirContext, getProcedureType(*proc, interface.converter));
+    else {
+      const Fortran::evaluate::characteristics::TypeAndShape *typeAndShape =
+          result.GetTypeAndShape();
+      assert(typeAndShape && "expect type for non proc pointer result");
+      mlirType = translateDynamicType(typeAndShape->type());
+      fir::SequenceType::Shape bounds = getBounds(typeAndShape->shape());
+      const auto *resTypeAndShape{result.GetTypeAndShape()};
+      bool resIsPolymorphic =
+          resTypeAndShape && resTypeAndShape->type().IsPolymorphic();
+      bool resIsAssumedType =
+          resTypeAndShape && resTypeAndShape->type().IsAssumedType();
+      if (!bounds.empty())
+        mlirType = fir::SequenceType::get(bounds, mlirType);
+      if (result.attrs.test(Attr::Allocatable))
+        mlirType = fir::wrapInClassOrBoxType(
+            fir::HeapType::get(mlirType), resIsPolymorphic, resIsAssumedType);
+      if (result.attrs.test(Attr::Pointer))
+        mlirType =
+            fir::wrapInClassOrBoxType(fir::PointerType::get(mlirType),
+                                      resIsPolymorphic, resIsAssumedType);
+
+      if (fir::isa_char(mlirType)) {
+        // Character scalar results must be passed as arguments in lowering so
+        // that an assumed length character function callee can access the
+        // result length. A function with a result requiring an explicit
+        // interface does not have to be compatible with assumed length
+        // function, but most compilers supports it.
+        handleImplicitCharacterResult(typeAndShape->type());
+        return;
+      }
     }
 
     addFirResult(mlirType, FirPlaceHolder::resultEntityPosition,
@@ -1536,3 +1543,10 @@ bool Fortran::lower::isCPtrArgByValueType(mlir::Type ty) {
   return ty.isa<fir::ReferenceType>() &&
          fir::isa_integer(fir::unwrapRefType(ty));
 }
+
+// Return the mlir::FunctionType of a procedure
+static mlir::FunctionType
+getProcedureType(const Fortran::evaluate::characteristics::Procedure &proc,
+                 Fortran::lower::AbstractConverter &converter) {
+  return SignatureBuilder{proc, converter, false}.genFunctionType();
+}
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 1a21751561ad67f..af07990c0c3c4bb 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -165,10 +165,8 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
   // will be used only if there is no explicit length in the local interface).
   mlir::Value funcPointer;
   mlir::Value charFuncPointerLength;
-  bool isProcPtr = false;
   if (const Fortran::semantics::Symbol *sym =
           caller.getIfIndirectCallSymbol()) {
-    isProcPtr = Fortran::semantics::IsProcedurePointer(sym);
     funcPointer = fir::getBase(converter.getSymbolExtendedValue(*sym, &symMap));
     if (!funcPointer)
       fir::emitFatalError(loc, "failed to find indirect call symbol address");
@@ -177,6 +175,9 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
       std::tie(funcPointer, charFuncPointerLength) =
           fir::factory::extractCharacterProcedureTuple(builder, loc,
                                                        funcPointer);
+    // RHS is a procedure pointer. Load its value.
+    if (Fortran::semantics::IsProcedurePointer(sym))
+      funcPointer = builder.create<fir::LoadOp>(loc, funcPointer);
   }
 
   mlir::IndexType idxTy = builder.getIndexType();
@@ -327,16 +328,10 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
   // compatible interface in Fortran, but that have different signatures in
   // FIR.
   if (funcPointer) {
-    if (isProcPtr) {
-      funcPointer = builder.create<fir::LoadOp>(loc, funcPointer);
-      auto boxProcTy{fir::BoxProcType::get(builder.getContext(), funcType)};
-      auto func{builder.createConvert(loc, boxProcTy, funcPointer)};
-      operands.push_back(builder.create<fir::BoxAddrOp>(loc, funcType, func));
-    } else
-      operands.push_back(
-          funcPointer.getType().isa<fir::BoxProcType>()
-              ? builder.create<fir::BoxAddrOp>(loc, funcType, funcPointer)
-              : builder.createConvert(loc, funcType, funcPointer));
+    operands.push_back(
+        funcPointer.getType().isa<fir::BoxProcType>()
+            ? builder.create<fir::BoxAddrOp>(loc, funcType, funcPointer)
+            : builder.createConvert(loc, funcType, funcPointer));
   }
 
   // Deal with potential mismatches in arguments types. Passing an array to a
@@ -879,19 +874,9 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   hlfir::Entity actual = preparedActual.getActual(loc, builder);
 
   // Handles the procedure pointer actual/dummy arguments.
-  // It could have a combination of
-  //     acutal             dummy
-  // 2.  procedure pointer  procedure pointer
-  // 3.  procedure pointer  procedure
-  // 4.  procedure          procedure pointer
-  if (hlfir::isBoxProcAddressType(actual.getType()) ||
-      hlfir::isBoxProcAddressType(dummyType)) {
-    if (actual.getType() != dummyType &&
-        hlfir::isBoxProcAddressType(actual.getType())) {
-      auto baseAddr{actual.getFirBase()};
-      actual = hlfir::Entity{builder.create<fir::LoadOp>(loc, baseAddr)};
-    }
+  if (actual.isProcedurePointer() || hlfir::isBoxProcAddressType(dummyType)) {
     return PreparedDummyArgument{actual, /*cleanups=*/{}};
+    // TODO {loc, "procedure to procedure pointer argument passing");
   }
 
   // Do nothing if this is a procedure argument. It is already a
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index 5a51493c9aaa5d4..b114fbe1a13a26b 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -1425,7 +1425,9 @@ class HlfirBuilder {
   }
 
   hlfir::EntityWithAttributes gen(const Fortran::evaluate::ProcedureRef &expr) {
-    TODO(getLoc(), "lowering ProcRef to HLFIR");
+    TODO(
+        getLoc(),
+        "lowering function references that return procedure pointers to HLFIR");
   }
 
   template <typename T>
diff --git a/flang/lib/Lower/ConvertProcedureDesignator.cpp b/flang/lib/Lower/ConvertProcedureDesignator.cpp
index b02fb3eb38141c8..240645023e27ffc 100644
--- a/flang/lib/Lower/ConvertProcedureDesignator.cpp
+++ b/flang/lib/Lower/ConvertProcedureDesignator.cpp
@@ -11,6 +11,7 @@
 #include "flang/Lower/AbstractConverter.h"
 #include "flang/Lower/CallInterface.h"
 #include "flang/Lower/ConvertCall.h"
+#include "flang/Lower/ConvertExprToHLFIR.h"
 #include "flang/Lower/ConvertVariable.h"
 #include "flang/Lower/Support/Utils.h"
 #include "flang/Lower/SymbolMap.h"
@@ -129,3 +130,15 @@ hlfir::EntityWithAttributes Fortran::lower::convertProcedureDesignatorToHLFIR(
       [funcAddr](const auto &) { return funcAddr; });
   return hlfir::EntityWithAttributes{res};
 }
+
+mlir::Value Fortran::lower::convertProcedureDesignatorToAddress(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    mlir::Type boxType, Fortran::lower::StatementContext &stmtCtx,
+    const Fortran::semantics::Symbol *sym) {
+  Fortran::lower::SymMap globalOpSymMap;
+  Fortran::evaluate::ProcedureDesignator proc(*sym);
+  auto procVal{Fortran::lower::convertProcedureDesignatorToHLFIR(
+      loc, converter, proc, globalOpSymMap, stmtCtx)};
+  return fir::getBase(Fortran::lower::convertToAddress(
+      loc, converter, procVal, stmtCtx, procVal.getType()));
+}
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index dbcaaced169ce3c..72f1ee7a2cb2baa 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -251,7 +251,8 @@ struct TypeBuilderImpl {
 
     if (Fortran::semantics::IsProcedurePointer(ultimate)) {
       Fortran::evaluate::ProcedureDesignator proc(ultimate);
-      return Fortran::lower::translateSignature(proc, converter);
+      auto procTy{Fortran::lower::translateSignature(proc, converter)};
+      return fir::BoxProcType::get(context, procTy);
     }
 
     if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index e54406f031fb963..c2107534278c057 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -18,6 +18,7 @@
 #include "flang/Lower/ConvertConstant.h"
 #include "flang/Lower/ConvertExpr.h"
 #include "flang/Lower/ConvertExprToHLFIR.h"
+#include "flang/Lower/ConvertProcedureDesignator.h"
 #include "flang/Lower/Mangler.h"
 #include "flang/Lower/PFTBuilder.h"
 #include "flang/Lower/StatementContext.h"
@@ -479,21 +480,6 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
   if (global && globalIsInitialized(global))
     return global;
 
-  if (Fortran::semantics::IsProcedurePointer(sym)) {
-    auto boxProcTy{Fortran::lower::getUntypedBoxProcType(builder.getContext())};
-    global = builder.createGlobal(loc, boxProcTy, globalName, linkage,
-                                  mlir::Attribute{}, isConst, var.isTarget());
-    Fortran::lower::createGlobalInitialization(
-        builder, global, [&](fir::FirOpBuilder &builder) {
-          mlir::Value initVal{builder.create<fir::ZeroOp>(loc, symTy)};
-          auto emBoxVal{
-              builder.create<fir::EmboxProcOp>(loc, boxProcTy, initVal)};
-          builder.create<fir::HasValueOp>(loc, emBoxVal);
-        });
-    global.setVisibility(mlir::SymbolTable::Visibility::Public);
-    return global;
-  }
-
   // If this is an array, check to see if we can use a dense attribute
   // with a tensor mlir type. This optimization currently only supports
   // Fortran arrays of integer, real, complex, or logical. The tensor
@@ -516,10 +502,19 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
       }
     }
   }
-  if (!global)
-    global = builder.createGlobal(loc, symTy, globalName, linkage,
-                                  mlir::Attribute{}, isConst, var.isTarget());
-  if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
+  if (!global) {
+    if (Fortran::semantics::IsProcedurePointer(sym)) {
+      auto nullBoxProcTy{
+          Fortran::lower::getUntypedBoxProcType(builder.getContext())};
+      global = builder.createGlobal(loc, nullBoxProcTy, globalName, linkage,
+                                    mlir::Attribute{}, isConst, var.isTarget());
+    } else {
+      global = builder.createGlobal(loc, symTy, globalName, linkage,
+                                    mlir::Attribute{}, isConst, var.isTarget());
+    }
+  }
+  if (Fortran::semantics::IsAllocatableOrPointer(sym) &&
+      !Fortran::semantics::IsProcedure(sym)) {
     const auto *details =
         sym.detailsIf<Fortran::semantics::ObjectEntityDetails>();
     if (details && details->init()) {
@@ -539,7 +534,6 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
             b.create<fir::HasValueOp>(loc, box);
           });
     }
-
   } else if (const auto *details =
                  sym.detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
     if (details->init()) {
@@ -564,10 +558,38 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
             builder.create<fir::HasValueOp>(loc, castTo);
           });
     }
+  } else if (Fortran::semantics::IsProcedurePointer(sym)) {
+    const auto *details{sym.detailsIf<Fortran::semantics::ProcEntityDetails>()};
+    if (details && details->init()) {
+      auto sym{*details->init()};
+      if (sym) // Has a procedure target.
+        Fortran::lower::createGlobalInitialization(
+            builder, global, [&](fir::FirOpBuilder &b) {
+              Fortran::lower::StatementContext stmtCtx(
+                  /*cleanupProhibited=*/true);
+              auto box{Fortran::lower::convertProcedureDesignatorToAddress(
+                  converter, loc, symTy, stmtCtx, sym)};
+              b.create<fir::HasValueOp>(loc, box);
+            });
+      else { // Has NULL() target.
+        Fortran::lower::createGlobalInitialization(
+            builder, global, [&](fir::FirOpBuilder &b) {
+              auto box{fir::factory::createNullBoxProc(b, loc, symTy)};
+              b.create<fir::HasValueOp>(loc, box);
+            });
+      }
+    } else {
+      // No initialization.
+      Fortran::lower::createGlobalInitialization(
+          builder, global, [&](fir::FirOpBuilder &b) {
+            auto box{fir::factory::createNullBoxProc(b, loc, symTy)};
+            b.create<fir::HasValueOp>(loc, box);
+          });
+    }
   } else if (sym.has<Fortran::semantics::CommonBlockDetails>()) {
     mlir::emitError(loc, "COMMON symbol processed elsewhere");
   } else {
-    TODO(loc, "global"); // Procedure pointer or something else
+    TODO(loc, "global"); // Something else
   }
   // Creates zero initializer for globals without initializers, this is a common
   // and expected behavior (although not required by the standard)
@@ -663,12 +685,9 @@ static mlir::Value createNewLocal(Fortran::lower::AbstractConverter &converter,
     return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg);
 
   // Local procedure pointer.
-  auto boxProcTy{Fortran::lower::getUntypedBoxProcType(builder.getContext())};
-  auto res{builder.allocateLocal(loc, boxProcTy, nm, symNm, shape, lenParams,
-                                 isTarg)};
-  mlir::Value initVal{builder.create<fir::ZeroOp>(loc, ty)};
-  auto emBoxVal{builder.create<fir::EmboxProcOp>(loc, boxProcTy, initVal)};
-  builder.create<fir::StoreOp>(loc, emBoxVal, res);
+  auto res{builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg)};
+  auto box{fir::factory::createNullBoxProc(builder, loc, ty)};
+  builder.create<fir::StoreOp>(loc, box, res);
   return res;
 }
 
diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
index c6d632036c82e96..df42dc8a3d0c8ba 100644
--- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp
+++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
@@ -1516,3 +1516,14 @@ mlir::Value fir::factory::genCPtrOrCFunptrValue(fir::FirOpBuilder &builder,
       fir::factory::genCPtrOrCFunptrAddr(builder, loc, cPtr, cPtrTy);
   return builder.create<fir::LoadOp>(loc, cPtrAddr);
 }
+
+mlir::Value fir::factory::createNullBoxProc(fir::FirOpBuilder &builder,
+                                            mlir::Location loc,
+                                            mlir::Type boxType) {
+  auto boxTy{boxType.dyn_cast<fir::BoxProcType>()};
+  if (!boxTy)
+    fir::emitFatalError(loc, "Procedure pointer must be of BoxProcType");
+  auto boxEleTy{fir::unwrapRefType(boxTy.getEleTy())};
+  mlir::Value initVal{builder.create<fir::ZeroOp>(loc, boxEleTy)};
+  return builder.create<fir::EmboxProcOp>(loc, boxTy, initVal);
+}
diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
index 3d0a59b468ba791..88d3f15deb9b3b8 100644
--- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp
+++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
@@ -696,6 +696,8 @@ hlfir::Entity hlfir::derefPointersAndAllocatables(mlir::Location loc,
     // or fir.class to hold bounds, dynamic type or length parameter
     // information. Keep them boxed.
     return boxLoad;
+  } else if (entity.isProcedurePointer()) {
+    return hlfir::Entity{builder.create<fir::LoadOp>(loc, entity)};
   }
   return entity;
 }

>From ac2abc009941a946dcd9e67c33e9f90c9b8a7934 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Sat, 11 Nov 2023 00:13:41 -0500
Subject: [PATCH 04/15] [Flang] Handle procedure pointer actual to procedure
 dummy argument passing.

---
 flang/lib/Lower/ConvertCall.cpp | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index af07990c0c3c4bb..14c9ee85bd612fb 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -873,15 +873,23 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   // element if this is an array in an elemental call.
   hlfir::Entity actual = preparedActual.getActual(loc, builder);
 
-  // Handles the procedure pointer actual/dummy arguments.
-  if (actual.isProcedurePointer() || hlfir::isBoxProcAddressType(dummyType)) {
-    return PreparedDummyArgument{actual, /*cleanups=*/{}};
-    // TODO {loc, "procedure to procedure pointer argument passing");
+  // Handles the procedure pointer actual arguments.
+  if (actual.isProcedurePointer()) {
+    if (hlfir::isBoxProcAddressType(dummyType))
+      // Procedure pointer actual to procedure pointer dummy.
+      return PreparedDummyArgument{actual, /*cleanups=*/{}};
+    if (hlfir::isFortranProcedureValue(dummyType)) {
+      // Procedure pointer actual to procedure dummy.
+      actual = hlfir::derefPointersAndAllocatables(loc, builder, actual);
+      return PreparedDummyArgument{actual, /*cleanups=*/{}};
+    }
   }
 
   // Do nothing if this is a procedure argument. It is already a
   // fir.boxproc/fir.tuple<fir.boxproc, len> as it should.
   if (actual.isProcedure()) {
+    if (hlfir::isBoxProcAddressType(dummyType))
+      TODO(loc, "procedure to procedure pointer argument passing");
     if (actual.getType() != dummyType)
       actual = fixProcedureDummyMismatch(loc, builder, actual, dummyType);
     return PreparedDummyArgument{actual, /*cleanups=*/{}};
@@ -1183,6 +1191,8 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
       break;
     case PassBy::CharProcTuple: {
       hlfir::Entity actual = preparedActual->getActual(loc, builder);
+      if (actual.isProcedurePointer())
+        actual = hlfir::derefPointersAndAllocatables(loc, builder, actual);
       if (!fir::isCharacterProcedureTuple(actual.getType()))
         actual = fixProcedureDummyMismatch(loc, builder, actual, argTy);
       caller.placeInput(arg, actual);

>From af38724955fee96dc3e7e7e2c3e20afa254bfb49 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Sat, 11 Nov 2023 11:00:49 -0500
Subject: [PATCH 05/15] [Flang] Remove some leftover code from the 3rd commit.

---
 flang/lib/Lower/ConvertVariable.cpp | 11 ++---------
 1 file changed, 2 insertions(+), 9 deletions(-)

diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index c2107534278c057..88a7fb7154e5621 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -503,15 +503,8 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
     }
   }
   if (!global) {
-    if (Fortran::semantics::IsProcedurePointer(sym)) {
-      auto nullBoxProcTy{
-          Fortran::lower::getUntypedBoxProcType(builder.getContext())};
-      global = builder.createGlobal(loc, nullBoxProcTy, globalName, linkage,
-                                    mlir::Attribute{}, isConst, var.isTarget());
-    } else {
-      global = builder.createGlobal(loc, symTy, globalName, linkage,
-                                    mlir::Attribute{}, isConst, var.isTarget());
-    }
+    global = builder.createGlobal(loc, symTy, globalName, linkage,
+                                  mlir::Attribute{}, isConst, var.isTarget());
   }
   if (Fortran::semantics::IsAllocatableOrPointer(sym) &&
       !Fortran::semantics::IsProcedure(sym)) {

>From 4fec0ade18f8ced3afb6270df18164fe6dc1cbd4 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Sat, 11 Nov 2023 11:02:21 -0500
Subject: [PATCH 06/15] [Flang] minor clean up.

---
 flang/lib/Lower/ConvertVariable.cpp | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 88a7fb7154e5621..679b80dd4c2a5f8 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -502,10 +502,9 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
       }
     }
   }
-  if (!global) {
+  if (!global)
     global = builder.createGlobal(loc, symTy, globalName, linkage,
                                   mlir::Attribute{}, isConst, var.isTarget());
-  }
   if (Fortran::semantics::IsAllocatableOrPointer(sym) &&
       !Fortran::semantics::IsProcedure(sym)) {
     const auto *details =

>From 43d8f2ad373797419ee9c3faa57bd5c3e83d0d28 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Sat, 11 Nov 2023 23:27:48 -0500
Subject: [PATCH 07/15] [Flang] Handle procedure actual to procedure pointer
 dummy.

---
 flang/lib/Lower/ConvertCall.cpp | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 14c9ee85bd612fb..058def204af0ac4 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -32,7 +32,9 @@
 #include "mlir/IR/IRMapping.h"
 #include "llvm/Support/CommandLine.h"
 #include "llvm/Support/Debug.h"
+#include <iostream>
 #include <optional>
+using namespace std;
 
 #define DEBUG_TYPE "flang-lower-expr"
 
@@ -888,8 +890,13 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   // Do nothing if this is a procedure argument. It is already a
   // fir.boxproc/fir.tuple<fir.boxproc, len> as it should.
   if (actual.isProcedure()) {
-    if (hlfir::isBoxProcAddressType(dummyType))
-      TODO(loc, "procedure to procedure pointer argument passing");
+    if (hlfir::isBoxProcAddressType(dummyType)) {
+      // Procedure actual to procedure pointer dummy.
+      auto proc{fir::getBase(actual)};
+      auto tempBoxProc{builder.createTemporary(loc, proc.getType())};
+      builder.create<fir::StoreOp>(loc, actual, tempBoxProc);
+      return PreparedDummyArgument{tempBoxProc, /*cleanups=*/{}};
+    }
     if (actual.getType() != dummyType)
       actual = fixProcedureDummyMismatch(loc, builder, actual, dummyType);
     return PreparedDummyArgument{actual, /*cleanups=*/{}};

>From 670e527a64b3267225c8c5d8f367d47a838ea719 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Sat, 11 Nov 2023 23:39:14 -0500
Subject: [PATCH 08/15] [Flang] Minor clean up and revise the comments a bit.

---
 flang/lib/Lower/ConvertCall.cpp | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 058def204af0ac4..55337665fb135a5 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -32,9 +32,7 @@
 #include "mlir/IR/IRMapping.h"
 #include "llvm/Support/CommandLine.h"
 #include "llvm/Support/Debug.h"
-#include <iostream>
 #include <optional>
-using namespace std;
 
 #define DEBUG_TYPE "flang-lower-expr"
 
@@ -177,7 +175,8 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
       std::tie(funcPointer, charFuncPointerLength) =
           fir::factory::extractCharacterProcedureTuple(builder, loc,
                                                        funcPointer);
-    // RHS is a procedure pointer. Load its value.
+    // Reference to a procedure pointer. Load its value, the address of the
+    // procedure it poiints to.
     if (Fortran::semantics::IsProcedurePointer(sym))
       funcPointer = builder.create<fir::LoadOp>(loc, funcPointer);
   }

>From 32cb9b43d495ae71fe77985587c1cba48048933f Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Sun, 12 Nov 2023 11:18:10 -0500
Subject: [PATCH 09/15] [Flang] Use PassEntityBy::BoxProcRef for procedure
 pointer.

---
 flang/include/flang/Lower/CallInterface.h |  6 ++--
 flang/lib/Lower/CallInterface.cpp         | 44 ++++++++++++-----------
 flang/lib/Lower/ConvertCall.cpp           |  1 +
 flang/lib/Lower/ConvertExpr.cpp           |  3 ++
 4 files changed, 31 insertions(+), 23 deletions(-)

diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h
index 579bdcfd8988792..c7dca4f8f1348e0 100644
--- a/flang/include/flang/Lower/CallInterface.h
+++ b/flang/include/flang/Lower/CallInterface.h
@@ -111,7 +111,8 @@ class CallInterface {
     CharBoxValueAttribute, // BoxChar with VALUE
     // Passing a character procedure as a <procedure address, result length>
     // tuple.
-    CharProcTuple
+    CharProcTuple,
+    BoxProcRef
   };
   /// Different properties of an entity that can be passed/returned.
   /// One-to-One mapping with PassEntityBy but for
@@ -124,7 +125,8 @@ class CallInterface {
     CharProcTuple,
     Box,
     MutableBox,
-    Value
+    Value,
+    BoxProcRef
   };
 
   using FortranEntity = typename PassedEntityTypes<T>::FortranEntity;
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 4b38ec488a439f0..0dd9289acee55d6 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -1063,28 +1063,30 @@ class Fortran::lower::CallInterfaceImpl {
         proc.procedure.value();
     mlir::Type funcType =
         getProcedureDesignatorType(&procedure, interface.converter);
-    if (proc.attrs.test(
-            Fortran::evaluate::characteristics::DummyProcedure::Attr::Pointer))
+    if (proc.attrs.test(Fortran::evaluate::characteristics::DummyProcedure::
+                            Attr::Pointer)) {
+      // Prodecure pointer dummy argument.
       funcType = fir::ReferenceType::get(funcType);
-    else { // Otherwise, it is a dummy procedure.
-      std::optional<Fortran::evaluate::DynamicType> resultTy =
-          getResultDynamicType(procedure);
-      if (resultTy && mustPassLengthWithDummyProcedure(procedure)) {
-        // The result length of dummy procedures that are character functions
-        // must be passed so that the dummy procedure can be called if it has
-        // assumed length on the callee side.
-        mlir::Type tupleType =
-            fir::factory::getCharacterProcedureTupleType(funcType);
-        llvm::StringRef charProcAttr =
-            fir::getCharacterProcedureDummyAttrName();
-        addFirOperand(tupleType, nextPassedArgPosition(),
-                      Property::CharProcTuple,
-                      {mlir::NamedAttribute{
-                          mlir::StringAttr::get(&mlirContext, charProcAttr),
-                          mlir::UnitAttr::get(&mlirContext)}});
-        addPassedArg(PassEntityBy::CharProcTuple, entity, characteristics);
-        return;
-      }
+      addFirOperand(funcType, nextPassedArgPosition(), Property::BoxProcRef);
+      addPassedArg(PassEntityBy::BoxProcRef, entity, characteristics);
+      return;
+    }
+    // Otherwise, it is a dummy procedure.
+    std::optional<Fortran::evaluate::DynamicType> resultTy =
+        getResultDynamicType(procedure);
+    if (resultTy && mustPassLengthWithDummyProcedure(procedure)) {
+      // The result length of dummy procedures that are character functions
+      // must be passed so that the dummy procedure can be called if it has
+      // assumed length on the callee side.
+      mlir::Type tupleType =
+          fir::factory::getCharacterProcedureTupleType(funcType);
+      llvm::StringRef charProcAttr = fir::getCharacterProcedureDummyAttrName();
+      addFirOperand(tupleType, nextPassedArgPosition(), Property::CharProcTuple,
+                    {mlir::NamedAttribute{
+                        mlir::StringAttr::get(&mlirContext, charProcAttr),
+                        mlir::UnitAttr::get(&mlirContext)}});
+      addPassedArg(PassEntityBy::CharProcTuple, entity, characteristics);
+      return;
     }
     addFirOperand(funcType, nextPassedArgPosition(), Property::BaseAddress);
     addPassedArg(PassEntityBy::BaseAddress, entity, characteristics);
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 55337665fb135a5..0d3b6b17c922531 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1181,6 +1181,7 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
     case PassBy::CharBoxValueAttribute:
     case PassBy::Box:
     case PassBy::BaseAddress:
+    case PassBy::BoxProcRef:
     case PassBy::BoxChar: {
       PreparedDummyArgument preparedDummy =
           prepareUserCallActualArgument(loc, builder, *preparedActual, argTy,
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 8c2318632f725b1..da2b32ac8226855 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -4845,6 +4845,9 @@ class ArrayExprLowering {
         }
         // See C15100 and C15101
         fir::emitFatalError(loc, "cannot be POINTER, ALLOCATABLE");
+      case PassBy::BoxProcRef:
+        // Procedure pointer: no action here.
+        break;
       }
     }
 

>From 4cec00806dc5e2e965e9b103b286d5e318077eb9 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Sun, 12 Nov 2023 22:47:39 -0500
Subject: [PATCH 10/15] [Flang] Fix an oversight error that cuased LIT test
 failures.

---
 flang/lib/Lower/Bridge.cpp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index a10701e0fa68b5d..a25f829413917fa 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3242,7 +3242,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
     Fortran::lower::StatementContext stmtCtx;
 
-    if (Fortran::evaluate::IsProcedurePointerTarget(assign.rhs)) {
+    if (Fortran::evaluate::IsProcedurePointer(assign.lhs)) {
       hlfir::Entity lhs = Fortran::lower::convertExprToHLFIR(
           loc, *this, assign.lhs, localSymbols, stmtCtx);
       if (Fortran::evaluate::IsNullProcedurePointer(assign.rhs)) {

>From 3eb8d079314d6c75c5868e8c8089f2f28da37609 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Mon, 13 Nov 2023 13:37:53 -0500
Subject: [PATCH 11/15] [Flang] To address review comments.

---
 .../flang/Lower/ConvertProcedureDesignator.h     |  7 +++----
 flang/lib/Lower/Bridge.cpp                       |  3 ++-
 flang/lib/Lower/CallInterface.cpp                | 11 ++++++++---
 flang/lib/Lower/ConvertCall.cpp                  | 16 +++++++++++-----
 flang/lib/Lower/ConvertProcedureDesignator.cpp   |  8 ++++----
 flang/lib/Lower/ConvertVariable.cpp              |  8 ++++++--
 6 files changed, 34 insertions(+), 19 deletions(-)

diff --git a/flang/include/flang/Lower/ConvertProcedureDesignator.h b/flang/include/flang/Lower/ConvertProcedureDesignator.h
index b0d422b8c3ff88d..ae772c52e425bc1 100644
--- a/flang/include/flang/Lower/ConvertProcedureDesignator.h
+++ b/flang/include/flang/Lower/ConvertProcedureDesignator.h
@@ -57,9 +57,8 @@ hlfir::EntityWithAttributes convertProcedureDesignatorToHLFIR(
 
 /// Generate initialization for procedure pointer to procedure target.
 mlir::Value
-convertProcedureDesignatorToAddress(Fortran::lower::AbstractConverter &,
-                                    mlir::Location, mlir::Type boxType,
-                                    Fortran::lower::StatementContext &stmtCtx,
-                                    const Fortran::semantics::Symbol *sym);
+convertProcedureDesignatorInitialTarget(Fortran::lower::AbstractConverter &,
+                                        mlir::Location,
+                                        const Fortran::semantics::Symbol &sym);
 } // namespace Fortran::lower
 #endif // FORTRAN_LOWER_CONVERT_PROCEDURE_DESIGNATOR_H
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index a25f829413917fa..e23e16b9a401251 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3242,6 +3242,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
     Fortran::lower::StatementContext stmtCtx;
 
+    if (!lowerToHighLevelFIR() && Fortran::evaluate::IsProcedure(assign.rhs))
+      TODO(loc, "procedure pointer assignment");
     if (Fortran::evaluate::IsProcedurePointer(assign.lhs)) {
       hlfir::Entity lhs = Fortran::lower::convertExprToHLFIR(
           loc, *this, assign.lhs, localSymbols, stmtCtx);
@@ -3254,7 +3256,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       }
       hlfir::Entity rhs(getBase(Fortran::lower::convertExprToAddress(
           loc, *this, assign.rhs, localSymbols, stmtCtx)));
-      rhs = hlfir::derefPointersAndAllocatables(loc, *builder, rhs);
       builder->createStoreWithConvert(loc, rhs, lhs);
       return;
     }
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 0dd9289acee55d6..b1420dcb25a1145 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -1059,6 +1059,11 @@ class Fortran::lower::CallInterfaceImpl {
       const DummyCharacteristics *characteristics,
       const Fortran::evaluate::characteristics::DummyProcedure &proc,
       const FortranEntity &entity) {
+    if (!interface.converter.getLoweringOptions().getLowerToHighLevelFIR() &&
+        proc.attrs.test(
+            Fortran::evaluate::characteristics::DummyProcedure::Attr::Pointer))
+      TODO(interface.converter.getCurrentLocation(),
+           "procedure pointer arguments");
     const Fortran::evaluate::characteristics::Procedure &procedure =
         proc.procedure.value();
     mlir::Type funcType =
@@ -1075,9 +1080,9 @@ class Fortran::lower::CallInterfaceImpl {
     std::optional<Fortran::evaluate::DynamicType> resultTy =
         getResultDynamicType(procedure);
     if (resultTy && mustPassLengthWithDummyProcedure(procedure)) {
-      // The result length of dummy procedures that are character functions
-      // must be passed so that the dummy procedure can be called if it has
-      // assumed length on the callee side.
+      // The result length of dummy procedures that are character functions must
+      // be passed so that the dummy procedure can be called if it has assumed
+      // length on the callee side.
       mlir::Type tupleType =
           fir::factory::getCharacterProcedureTupleType(funcType);
       llvm::StringRef charProcAttr = fir::getCharacterProcedureDummyAttrName();
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 0d3b6b17c922531..8eac78b63f7caaf 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -32,7 +32,9 @@
 #include "mlir/IR/IRMapping.h"
 #include "llvm/Support/CommandLine.h"
 #include "llvm/Support/Debug.h"
+#include <iostream>
 #include <optional>
+using namespace std;
 
 #define DEBUG_TYPE "flang-lower-expr"
 
@@ -176,7 +178,7 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
           fir::factory::extractCharacterProcedureTuple(builder, loc,
                                                        funcPointer);
     // Reference to a procedure pointer. Load its value, the address of the
-    // procedure it poiints to.
+    // procedure it points to.
     if (Fortran::semantics::IsProcedurePointer(sym))
       funcPointer = builder.create<fir::LoadOp>(loc, funcPointer);
   }
@@ -890,9 +892,11 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   // fir.boxproc/fir.tuple<fir.boxproc, len> as it should.
   if (actual.isProcedure()) {
     if (hlfir::isBoxProcAddressType(dummyType)) {
+      if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr)) {
+        cout << " AAA" << endl;
+      }
       // Procedure actual to procedure pointer dummy.
-      auto proc{fir::getBase(actual)};
-      auto tempBoxProc{builder.createTemporary(loc, proc.getType())};
+      auto tempBoxProc{builder.createTemporary(loc, actual.getType())};
       builder.create<fir::StoreOp>(loc, actual, tempBoxProc);
       return PreparedDummyArgument{tempBoxProc, /*cleanups=*/{}};
     }
@@ -2175,8 +2179,10 @@ genProcedureRef(CallContext &callContext) {
         TODO(loc, "assumed type actual argument");
       if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
               *expr)) {
-        if (arg.passBy !=
-            Fortran::lower::CallerInterface::PassEntityBy::MutableBox) {
+        if ((arg.passBy !=
+             Fortran::lower::CallerInterface::PassEntityBy::MutableBox) &&
+            (arg.passBy !=
+             Fortran::lower::CallerInterface::PassEntityBy::BoxProcRef)) {
           assert(
               arg.isOptional() &&
               "NULL must be passed only to pointer, allocatable, or OPTIONAL");
diff --git a/flang/lib/Lower/ConvertProcedureDesignator.cpp b/flang/lib/Lower/ConvertProcedureDesignator.cpp
index 240645023e27ffc..390e3d37bdc99b4 100644
--- a/flang/lib/Lower/ConvertProcedureDesignator.cpp
+++ b/flang/lib/Lower/ConvertProcedureDesignator.cpp
@@ -131,12 +131,12 @@ hlfir::EntityWithAttributes Fortran::lower::convertProcedureDesignatorToHLFIR(
   return hlfir::EntityWithAttributes{res};
 }
 
-mlir::Value Fortran::lower::convertProcedureDesignatorToAddress(
+mlir::Value Fortran::lower::convertProcedureDesignatorInitialTarget(
     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
-    mlir::Type boxType, Fortran::lower::StatementContext &stmtCtx,
-    const Fortran::semantics::Symbol *sym) {
+    const Fortran::semantics::Symbol &sym) {
   Fortran::lower::SymMap globalOpSymMap;
-  Fortran::evaluate::ProcedureDesignator proc(*sym);
+  Fortran::lower::StatementContext stmtCtx;
+  Fortran::evaluate::ProcedureDesignator proc(sym);
   auto procVal{Fortran::lower::convertProcedureDesignatorToHLFIR(
       loc, converter, proc, globalOpSymMap, stmtCtx)};
   return fir::getBase(Fortran::lower::convertToAddress(
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 679b80dd4c2a5f8..676b01dda4c847e 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -480,6 +480,10 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
   if (global && globalIsInitialized(global))
     return global;
 
+  if (!converter.getLoweringOptions().getLowerToHighLevelFIR() &&
+      Fortran::semantics::IsProcedurePointer(sym))
+    TODO(loc, "procedure pointer globals");
+
   // If this is an array, check to see if we can use a dense attribute
   // with a tensor mlir type. This optimization currently only supports
   // Fortran arrays of integer, real, complex, or logical. The tensor
@@ -559,8 +563,8 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
             builder, global, [&](fir::FirOpBuilder &b) {
               Fortran::lower::StatementContext stmtCtx(
                   /*cleanupProhibited=*/true);
-              auto box{Fortran::lower::convertProcedureDesignatorToAddress(
-                  converter, loc, symTy, stmtCtx, sym)};
+              auto box{Fortran::lower::convertProcedureDesignatorInitialTarget(
+                  converter, loc, *sym)};
               b.create<fir::HasValueOp>(loc, box);
             });
       else { // Has NULL() target.

>From aaa7e0f31a44cb118ea5fc73274cb704ccd412a9 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Mon, 13 Nov 2023 15:02:16 -0500
Subject: [PATCH 12/15] [Flang] Fix some unintended debug code.

---
 flang/lib/Lower/ConvertCall.cpp | 5 -----
 1 file changed, 5 deletions(-)

diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 8eac78b63f7caaf..0843cd4a60c61da 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -32,9 +32,7 @@
 #include "mlir/IR/IRMapping.h"
 #include "llvm/Support/CommandLine.h"
 #include "llvm/Support/Debug.h"
-#include <iostream>
 #include <optional>
-using namespace std;
 
 #define DEBUG_TYPE "flang-lower-expr"
 
@@ -892,9 +890,6 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   // fir.boxproc/fir.tuple<fir.boxproc, len> as it should.
   if (actual.isProcedure()) {
     if (hlfir::isBoxProcAddressType(dummyType)) {
-      if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr)) {
-        cout << " AAA" << endl;
-      }
       // Procedure actual to procedure pointer dummy.
       auto tempBoxProc{builder.createTemporary(loc, actual.getType())};
       builder.create<fir::StoreOp>(loc, actual, tempBoxProc);

>From 1e1b13990bbea2310f3a4107736b55f143c6b628 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Mon, 13 Nov 2023 22:24:38 -0500
Subject: [PATCH 13/15] [Flang] Handle reference to null() as actual argument
 to procedure pointer dummy.

---
 flang/lib/Lower/ConvertCall.cpp | 24 ++++++++++++++++++------
 1 file changed, 18 insertions(+), 6 deletions(-)

diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 0843cd4a60c61da..75947c335c23208 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -874,27 +874,39 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   // element if this is an array in an elemental call.
   hlfir::Entity actual = preparedActual.getActual(loc, builder);
 
-  // Handles the procedure pointer actual arguments.
+  // Handle the procedure pointer actual arguments.
   if (actual.isProcedurePointer()) {
+    // Procedure pointer actual to procedure pointer dummy.
     if (hlfir::isBoxProcAddressType(dummyType))
-      // Procedure pointer actual to procedure pointer dummy.
       return PreparedDummyArgument{actual, /*cleanups=*/{}};
+    // Procedure pointer actual to procedure dummy.
     if (hlfir::isFortranProcedureValue(dummyType)) {
-      // Procedure pointer actual to procedure dummy.
       actual = hlfir::derefPointersAndAllocatables(loc, builder, actual);
       return PreparedDummyArgument{actual, /*cleanups=*/{}};
     }
   }
 
-  // Do nothing if this is a procedure argument. It is already a
-  // fir.boxproc/fir.tuple<fir.boxproc, len> as it should.
+  // NULL() actual to procedure pointer dummy
+  if (Fortran::evaluate::IsNullProcedurePointer(expr) &&
+      hlfir::isBoxProcAddressType(dummyType)) {
+    auto boxTy{Fortran::lower::getUntypedBoxProcType(builder.getContext())};
+    auto tempBoxProc{builder.createTemporary(loc, boxTy)};
+    hlfir::Entity nullBoxProc(
+        fir::factory::createNullBoxProc(builder, loc, boxTy));
+    builder.create<fir::StoreOp>(loc, nullBoxProc, tempBoxProc);
+    return PreparedDummyArgument{tempBoxProc, /*cleanups=*/{}};
+  }
+
   if (actual.isProcedure()) {
+    // Procedure actual to procedure pointer dummy.
     if (hlfir::isBoxProcAddressType(dummyType)) {
-      // Procedure actual to procedure pointer dummy.
       auto tempBoxProc{builder.createTemporary(loc, actual.getType())};
       builder.create<fir::StoreOp>(loc, actual, tempBoxProc);
       return PreparedDummyArgument{tempBoxProc, /*cleanups=*/{}};
     }
+    // Procedure actual to procedure dummy.
+    // Do nothing if this is a procedure argument. It is already a
+    // fir.boxproc/fir.tuple<fir.boxproc, len> as it should.
     if (actual.getType() != dummyType)
       actual = fixProcedureDummyMismatch(loc, builder, actual, dummyType);
     return PreparedDummyArgument{actual, /*cleanups=*/{}};

>From 5718608b366f834fdbcd1974087fa8c2544f12cc Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Tue, 14 Nov 2023 12:40:04 -0500
Subject: [PATCH 14/15] [Flang] Address the review comment.

---
 flang/lib/Lower/ConvertProcedureDesignator.cpp | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/flang/lib/Lower/ConvertProcedureDesignator.cpp b/flang/lib/Lower/ConvertProcedureDesignator.cpp
index 390e3d37bdc99b4..c36e61987f505bb 100644
--- a/flang/lib/Lower/ConvertProcedureDesignator.cpp
+++ b/flang/lib/Lower/ConvertProcedureDesignator.cpp
@@ -99,9 +99,11 @@ hlfir::EntityWithAttributes Fortran::lower::convertProcedureDesignatorToHLFIR(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const Fortran::evaluate::ProcedureDesignator &proc,
     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
-  if (std::optional<fir::FortranVariableOpInterface> varDef =
-          symMap.lookupVariableDefinition(*proc.GetSymbol()))
-    return *varDef;
+  const auto *sym = proc.GetSymbol();
+  if (sym)
+    if (std::optional<fir::FortranVariableOpInterface> varDef =
+            symMap.lookupVariableDefinition(*sym))
+      return *varDef;
 
   fir::ExtendedValue procExv =
       convertProcedureDesignator(loc, converter, proc, symMap, stmtCtx);

>From 76db05373865b62f1a3311d2ee612aed1fdf88fc Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Tue, 14 Nov 2023 13:26:17 -0500
Subject: [PATCH 15/15] [Flang] Cast the init target to the decl type of
 procedure pointer.

---
 flang/lib/Lower/ConvertVariable.cpp | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 676b01dda4c847e..d4f738e5dae116f 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -565,7 +565,8 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
                   /*cleanupProhibited=*/true);
               auto box{Fortran::lower::convertProcedureDesignatorInitialTarget(
                   converter, loc, *sym)};
-              b.create<fir::HasValueOp>(loc, box);
+              auto castTo{builder.createConvert(loc, symTy, box)};
+              b.create<fir::HasValueOp>(loc, castTo);
             });
       else { // Has NULL() target.
         Fortran::lower::createGlobalInitialization(



More information about the flang-commits mailing list