Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[flang] Re-land #70461 (procedure pointer lowering) #73221

Closed
wants to merge 1 commit into from

Conversation

jeanPerier
Copy link
Contributor

#70461 was reverted by 49f55d1 because of
failing gfotran tests in the llvm-test-suite.

#70461 is correct, the issue is that no semantics errors are emitted for these "bad fortran" tests (used to be happy because they considered the lowering TODO as a semantic error).

I opened an issue against semantic #73215 and I am disabling the tests in the meantime: llvm/llvm-test-suite#55.

llvm#70461)

**Scope of the PR:**
1. Lowering global and local procedure pointer declaration statement
with explicit or implicit interface. The explicit interface can be from
an interface block, a module procedure or an internal procedure.
2. Lowering procedure pointer assignment, where the target procedure
could be external, module or internal procedures.
3. Lowering reference to procedure pointers so that it works end to end.

**PR notes:**
1. The first commit of the PR does not include testing. I would like to
collect some comments first, which may alter the output. Once I confirm
the implementation, I will add some testing as a follow up commit to
this PR.
2. No special handling of the host-associated entities when an internal
procedure is the target of a procedure pointer assignment in this PR.

**Implementation notes:**
1. The implementation is using the HLFIR path.
2. Flang currently uses `getUntypedBoxProcType` to get the
`fir::BoxProcType` for `ProcedureDesignator` when getting the address of
a procedure in order to pass it as an actual argument. This PR inherits
the same design decision for procedure pointer as the `fir::StoreOp`
requires the same memory type.
@llvmbot llvmbot added flang Flang issues not falling into any other category flang:fir-hlfir labels Nov 23, 2023
@llvmbot
Copy link
Collaborator

llvmbot commented Nov 23, 2023

@llvm/pr-subscribers-flang-fir-hlfir

Author: None (jeanPerier)

Changes

#70461 was reverted by 49f55d1 because of
failing gfotran tests in the llvm-test-suite.

#70461 is correct, the issue is that no semantics errors are emitted for these "bad fortran" tests (used to be happy because they considered the lowering TODO as a semantic error).

I opened an issue against semantic #73215 and I am disabling the tests in the meantime: llvm/llvm-test-suite#55.


Patch is 51.14 KiB, truncated to 20.00 KiB below, full version: https://github.com/llvm/llvm-project/pull/73221.diff

17 Files Affected:

  • (modified) flang/include/flang/Lower/BoxAnalyzer.h (+2)
  • (modified) flang/include/flang/Lower/CallInterface.h (+4-2)
  • (modified) flang/include/flang/Lower/ConvertProcedureDesignator.h (+10)
  • (modified) flang/include/flang/Optimizer/Builder/FIRBuilder.h (+4)
  • (modified) flang/include/flang/Optimizer/Builder/HLFIRTools.h (+3)
  • (modified) flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h (+6)
  • (modified) flang/lib/Lower/Bridge.cpp (+28-1)
  • (modified) flang/lib/Lower/CallInterface.cpp (+56-33)
  • (modified) flang/lib/Lower/ConvertCall.cpp (+45-4)
  • (modified) flang/lib/Lower/ConvertExpr.cpp (+3)
  • (modified) flang/lib/Lower/ConvertExprToHLFIR.cpp (+3-1)
  • (modified) flang/lib/Lower/ConvertProcedureDesignator.cpp (+23)
  • (modified) flang/lib/Lower/ConvertType.cpp (+7-2)
  • (modified) flang/lib/Lower/ConvertVariable.cpp (+70-8)
  • (modified) flang/lib/Optimizer/Builder/FIRBuilder.cpp (+11)
  • (modified) flang/lib/Optimizer/Builder/HLFIRTools.cpp (+2)
  • (added) flang/test/Lower/HLFIR/procedure-pointer.f90 (+285)
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/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/include/flang/Lower/ConvertProcedureDesignator.h b/flang/include/flang/Lower/ConvertProcedureDesignator.h
index 86a757a9aadf4f4..ae772c52e425bc1 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,10 @@ 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
+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/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/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/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 872bf6bc729ecd0..23c48cc7bd97874 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3095,6 +3095,17 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       const Fortran::lower::SomeExpr *expr =
           Fortran::semantics::GetExpr(pointerObject);
       assert(expr);
+      if (Fortran::evaluate::IsProcedurePointer(*expr)) {
+        Fortran::lower::StatementContext stmtCtx;
+        hlfir::Entity pptr = Fortran::lower::convertExprToHLFIR(
+            loc, *this, *expr, localSymbols, stmtCtx);
+        auto boxTy{
+            Fortran::lower::getUntypedBoxProcType(builder->getContext())};
+        hlfir::Entity nullBoxProc(
+            fir::factory::createNullBoxProc(*builder, loc, boxTy));
+        builder->createStoreWithConvert(loc, nullBoxProc, pptr);
+        return;
+      }
       fir::MutableBoxValue box = genExprMutableBox(loc, *expr);
       fir::factory::disassociateMutableBox(*builder, loc, box);
     }
@@ -3241,8 +3252,24 @@ 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))
+
+    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);
+      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)));
+      builder->createStoreWithConvert(loc, rhs, lhs);
+      return;
+    }
 
     std::optional<Fortran::evaluate::DynamicType> lhsType =
         assign.lhs.GetType();
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 51b0579fac36c0f..b1420dcb25a1145 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;
@@ -1055,15 +1059,24 @@ class Fortran::lower::CallInterfaceImpl {
       const DummyCharacteristics *characteristics,
       const Fortran::evaluate::characteristics::DummyProcedure &proc,
       const FortranEntity &entity) {
-    if (proc.attrs.test(
+    if (!interface.converter.getLoweringOptions().getLowerToHighLevelFIR() &&
+        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);
+    if (proc.attrs.test(Fortran::evaluate::characteristics::DummyProcedure::
+                            Attr::Pointer)) {
+      // Prodecure pointer dummy argument.
+      funcType = fir::ReferenceType::get(funcType);
+      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)) {
@@ -1087,37 +1100,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,
@@ -1534,3 +1550,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 82e1ece4efeafe7..395a98b43d53793 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -175,6 +175,10 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
       std::tie(funcPointer, charFuncPointerLength) =
           fir::factory::extractCharacterProcedureTuple(builder, loc,
                                                        funcPointer);
+    // Reference to a procedure pointer. Load its value, the address of the
+    // procedure it points to.
+    if (Fortran::semantics::IsProcedurePointer(sym))
+      funcPointer = builder.create<fir::LoadOp>(loc, funcPointer);
   }
 
   mlir::IndexType idxTy = builder.getIndexType();
@@ -870,9 +874,39 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   // element if this is an array in an elemental call.
   hlfir::Entity actual = preparedActual.getActual(loc, builder);
 
-  // Do nothing if this is a procedure argument. It is already a
-  // fir.boxproc/fir.tuple<fir.boxproc, len> as it should.
+  // Handle the procedure pointer actual arguments.
+  if (actual.isProcedurePointer()) {
+    // Procedure pointer actual to procedure pointer dummy.
+    if (hlfir::isBoxProcAddressType(dummyType))
+      return PreparedDummyArgument{actual, /*cleanups=*/{}};
+    // Procedure pointer actual to procedure dummy.
+    if (hlfir::isFortranProcedureValue(dummyType)) {
+      actual = hlfir::derefPointersAndAllocatables(loc, builder, actual);
+      return PreparedDummyArgument{actual, /*cleanups=*/{}};
+    }
+  }
+
+  // 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)) {
+      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=*/{}};
@@ -1158,6 +1192,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,
@@ -1174,6 +1209,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);
@@ -1495,6 +1532,8 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals,
     }
 
     hlfir::Entity actual = arg.value()->getActual(loc, builder);
+    if (actual.isProcedurePointer())
+      TODO(loc, "Procedure pointer as actual argument to intrinsics.");
     switch (argRules.lowerAs) {
     case fir::LowerIntrinsicArgAs::Value:
       operands.emplace_back(
@@ -2149,8 +2188,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/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;
       }
     }
 
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 20ade1a04049fc4..84e04b0a65f447e 100644
--- a/flang/lib/Lower/ConvertProcedureDesignator.cpp
+++ b/flang/lib/Lower/ConvertProcedureDesignator.cpp
@@ -11,11 +11,13 @@
 #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"
 #include "flang/Optimizer/Builder/Character.h"
 #include "flang/Optimizer/Builder/IntrinsicCall.h"
+#include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/Dialect/FIROps.h"
 
 static bool areAllSymbolsInExprMapped(const Fortran::evaluate::ExtentExpr &expr,
@@ -98,6 +100,15 @@ 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) {
+  ...
[truncated]

Copy link
Contributor

@kiranchandramohan kiranchandramohan left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

LGTM.

Copy link
Contributor

@tblah tblah left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

LGTM

jeanPerier pushed a commit that referenced this pull request Nov 23, 2023
#70461)

**Scope of the PR:**
1. Lowering global and local procedure pointer declaration statement
with explicit or implicit interface. The explicit interface can be from
an interface block, a module procedure or an internal procedure.
2. Lowering procedure pointer assignment, where the target procedure
could be external, module or internal procedures.
3. Lowering reference to procedure pointers so that it works end to end.

**PR notes:**
1. The first commit of the PR does not include testing. I would like to
collect some comments first, which may alter the output. Once I confirm
the implementation, I will add some testing as a follow up commit to
this PR.
2. No special handling of the host-associated entities when an internal
procedure is the target of a procedure pointer assignment in this PR.

**Implementation notes:**
1. The implementation is using the HLFIR path.
2. Flang currently uses `getUntypedBoxProcType` to get the
`fir::BoxProcType` for `ProcedureDesignator` when getting the address of
a procedure in order to pass it as an actual argument. This PR inherits
the same design decision for procedure pointer as the `fir::StoreOp`
requires the same memory type.

Note: this commit is actually resubmitting the original commit from
PR #70461 that was reverted. See PR #73221.
@jeanPerier
Copy link
Contributor Author

Thanks for the approval, I merged manually in af09219 to preserve @DanielCChen commit's authorship.

@jeanPerier jeanPerier closed this Nov 23, 2023
@jeanPerier jeanPerier deleted the jpr-reland-proc-pointers branch November 23, 2023 12:45
@DanielCChen
Copy link
Contributor

Thanks @jeanPerier for re-landing #70461 !

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
flang:fir-hlfir flang Flang issues not falling into any other category
Projects
None yet
Development

Successfully merging this pull request may close these issues.

None yet

5 participants