[flang] Fix passing NULL to OPTIONAL procedure pointers

[jeanPerier]

Procedure pointer lowering used prepareUserCallActualArgument because it was convenient, but this helper was not meant for POINTERs when originally written and it did not handled passing NULL to an OPTIONAL procedure pointer correctly.

The resulting argument should be a disassociated pointer, not an absent pointer (Fortran 15.5.2.12 point 1.).

Move the logic for procedure pointer argument "cooking" in its own helper to avoid triggering the logic that created an absent argument in this case.

[llvmbot]

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

Author: None (jeanPerier)

Changes

Procedure pointer lowering used prepareUserCallActualArgument because it was convenient, but this helper was not meant for POINTERs when originally written and it did not handled passing NULL to an OPTIONAL procedure pointer correctly.

The resulting argument should be a disassociated pointer, not an absent pointer (Fortran 15.5.2.12 point 1.).

Move the logic for procedure pointer argument "cooking" in its own helper to avoid triggering the logic that created an absent argument in this case.

---

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

2 Files Affected:

• (modified) flang/lib/Lower/ConvertCall.cpp (+41-27)
• (modified) flang/test/Lower/HLFIR/procedure-pointer.f90 (+20)

diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 1d5ebeb1b3620..bb8fd2e945f43 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -912,37 +912,16 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   // element if this is an array in an elemental call.
   hlfir::Entity actual = preparedActual.getActual(loc, builder);
 
-  // Handle the procedure pointer actual arguments.
-  if (actual.isProcedurePointer()) {
-    // Procedure pointer actual to procedure pointer dummy.
-    if (fir::isBoxProcAddressType(dummyType))
-      return PreparedDummyArgument{actual, /*cleanups=*/{}};
+  // Handle procedure arguments (procedure pointers should go through
+  // prepareProcedurePointerActualArgument).
+  if (hlfir::isFortranProcedureValue(dummyType)) {
     // Procedure pointer actual to procedure dummy.
-    if (hlfir::isFortranProcedureValue(dummyType)) {
+    if (actual.isProcedurePointer()) {
       actual = hlfir::derefPointersAndAllocatables(loc, builder, actual);
       return PreparedDummyArgument{actual, /*cleanups=*/{}};
     }
-  }
-
-  // NULL() actual to procedure pointer dummy
-  if (Fortran::evaluate::IsNullProcedurePointer(expr) &&
-      fir::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 (fir::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.
+    assert(actual.isProcedure());
     // 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)
@@ -1219,6 +1198,34 @@ static PreparedDummyArgument prepareUserCallActualArgument(
   return result;
 }
 
+/// Prepare actual argument for a procedure pointer dummy.
+static PreparedDummyArgument prepareProcedurePointerActualArgument(
+    mlir::Location loc, fir::FirOpBuilder &builder,
+    const Fortran::lower::PreparedActualArgument &preparedActual,
+    mlir::Type dummyType,
+    const Fortran::lower::CallerInterface::PassedEntity &arg,
+    const Fortran::lower::SomeExpr &expr, CallContext &callContext) {
+
+  // NULL() actual to procedure pointer dummy
+  if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr) &&
+      fir::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=*/{}};
+  }
+  hlfir::Entity actual = preparedActual.getActual(loc, builder);
+  if (actual.isProcedurePointer())
+    return PreparedDummyArgument{actual, /*cleanups=*/{}};
+  assert(actual.isProcedure());
+  // Procedure actual to procedure pointer dummy.
+  auto tempBoxProc{builder.createTemporary(loc, actual.getType())};
+  builder.create<fir::StoreOp>(loc, actual, tempBoxProc);
+  return PreparedDummyArgument{tempBoxProc, /*cleanups=*/{}};
+}
+
 /// Lower calls to user procedures with actual arguments that have been
 /// pre-lowered but not yet prepared according to the interface.
 /// This can be called for elemental procedures, but only with scalar
@@ -1284,7 +1291,6 @@ 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, arg, *expr, callContext);
@@ -1292,6 +1298,14 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
                           preparedDummy.cleanups.rend());
       caller.placeInput(arg, preparedDummy.dummy);
     } break;
+    case PassBy::BoxProcRef: {
+      PreparedDummyArgument preparedDummy =
+          prepareProcedurePointerActualArgument(loc, builder, *preparedActual,
+                                                argTy, arg, *expr, callContext);
+      callCleanUps.append(preparedDummy.cleanups.rbegin(),
+                          preparedDummy.cleanups.rend());
+      caller.placeInput(arg, preparedDummy.dummy);
+    } break;
     case PassBy::AddressAndLength:
       // PassBy::AddressAndLength is only used for character results. Results
       // are not handled here.
diff --git a/flang/test/Lower/HLFIR/procedure-pointer.f90 b/flang/test/Lower/HLFIR/procedure-pointer.f90
index ba423db150841..28965b22de971 100644
--- a/flang/test/Lower/HLFIR/procedure-pointer.f90
+++ b/flang/test/Lower/HLFIR/procedure-pointer.f90
@@ -340,6 +340,26 @@ subroutine sub12()
 ! CHECK: fir.call @_QPfoo2(%[[VAL_17]]) fastmath<contract> : (!fir.ref<!fir.boxproc<() -> ()>>) -> ()
 end 
 
+subroutine test_opt_pointer()
+  interface
+    subroutine takes_opt_proc_ptr(p)
+      procedure(), pointer, optional :: p
+    end subroutine
+  end interface
+  call takes_opt_proc_ptr(NULL())
+  call takes_opt_proc_ptr()
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_opt_pointer() {
+! CHECK:    %[[VAL_0:.*]] = fir.alloca !fir.boxproc<() -> ()>
+! CHECK:    %[[VAL_1:.*]] = fir.zero_bits () -> ()
+! CHECK:    %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : (() -> ()) -> !fir.boxproc<() -> ()>
+! CHECK:    fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref<!fir.boxproc<() -> ()>>
+! CHECK:    fir.call @_QPtakes_opt_proc_ptr(%[[VAL_0]]) fastmath<contract> : (!fir.ref<!fir.boxproc<() -> ()>>) -> ()
+! CHECK:    %[[VAL_3:.*]] = fir.absent !fir.ref<!fir.boxproc<() -> ()>>
+! CHECK:    fir.call @_QPtakes_opt_proc_ptr(%[[VAL_3]]) fastmath<contract> : (!fir.ref<!fir.boxproc<() -> ()>>) -> ()
+
+
+
 ! CHECK-LABEL: fir.global internal @_QFsub1Ep2 : !fir.boxproc<(!fir.ref<f32>) -> f32> {
 ! CHECK: %[[VAL_0:.*]] = fir.zero_bits (!fir.ref<f32>) -> f32
 ! CHECK: %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<(!fir.ref<f32>) -> f32>

[DanielCChen]

Good catch! The fix LGTM. Thanks!