[flang] Fix lowering of optional char proc args

[luporl]

Summary

Optional character function arguments were not being lowered
properly. As they are passed as a tuple, containing the (boxed)
function address and the character length, it is not possible for
fir.absent to handle it directly. Instead, a tuple needs to be
created and filled with an absent function address and a dummy
character length.

Fixes #60225

[jeanPerier]

Thanks a lot for the fix!

flang/lib/Lower/ConvertExpr.cpp

2474–2485

Can I ask you to move this code into a new FirOpBuilder helper builder.genAbsentOp(loc, argTy) that would detect that the argTy is a tuple via fir::isCharacterProcedureTuple(argTy), and use fir::factory::createCharacterProcedureTuple instead of createBoxProcCharTuple to create the tuple?

That way, it can be reused in other places that also suffer from this bug, like the equivalent HLFIR code pieces here:

• https://github.com/llvm/llvm-project/blob/91cbc3f2d83dfcf064238e807b47c58279509ff7/flang/lib/Lower/ConvertCall.cpp#L1047
• https://github.com/llvm/llvm-project/blob/91cbc3f2d83dfcf064238e807b47c58279509ff7/flang/lib/Lower/ConvertCall.cpp#L764

2481

I would use fir.undefined or zero rather than 1 for the length of an absent character procedure.

[luporl]

Thanks for the review!

flang/lib/Lower/ConvertExpr.cpp

2474–2485

Right, I'll make this change and fix these HLFIR code pieces.

[luporl]

• Use fir.undefined as character length
• Move lowering fix to builder.genAbsentOp
• Fix HLFIR and test it

[jeanPerier]

Thanks a lot, I think the IR can be slightly further simplify by merging the fir.absent and fir.emboxproc into a single fir.absent. Looks great otherwise.

flang/lib/Optimizer/Builder/FIRBuilder.cpp

619 ↗

(On Diff #501184)

Nit: single line if/for... should not have braces in LLVM/MLIR coding style (it's a bit of brain gymnastic...)

https://llvm.org/docs/CodingStandards.html#don-t-use-braces-on-simple-single-statement-bodies-of-if-else-loop-statements

623–627 ↗

(On Diff #501184)

Thinking this through a bit more, doesn't auto boxProc = create<fir::AbsentOp>(loc, argTy.cast<mlir::TupleType>().getType(0)); works an save the EmboxProc at that level?
I think AbsentOp should work properly on BoxProcType (otherwise, there would also be a bug for optional non character dummy procedures).

It will probably also make the extension of this code to optional character pointer procedure easier when they arrive (nothing to do other than updating the isCharacterProcedureTuple to detect them).

[luporl]

flang/lib/Optimizer/Builder/FIRBuilder.cpp

623–627 ↗

(On Diff #501184)

I've tried this and it works (assembly seems correct and test program runs without errors).

I'm just a bit worried about the generated FIR, that has an unconditional fir.box_addr on the absent BoxProc, in the if (present(arg)) part. Is fir.box_addr guaranteed to work with fir.absent BoxProcs?

[jeanPerier]

flang/lib/Optimizer/Builder/FIRBuilder.cpp

623–627 ↗

(On Diff #501184)

Is fir.box_addr guaranteed to work with fir.absent BoxProcs?

Yes, it's fine. I agree it is not supper nice to do this box_addr + embox_proc. It is a bit useless an noisy, but is not related to your patch.

The box_addr is probably generated here: https://github.com/llvm/llvm-project/blob/cedfd2721e3492e5ab0ea86d24d8027846687c27/flang/lib/Lower/ConvertProcedureDesignator.cpp#L63, but it would need to be tested that the box_addr part can be skipped (that the code in lowering is OK with getting a fir.boxproc), so I would not try to change this in this patch.

[luporl]

flang/lib/Optimizer/Builder/FIRBuilder.cpp

623–627 ↗

(On Diff #501184)

Ok, thanks for the detailed explanation. Then I'll go ahead with this change.

[luporl]

• Simplify IR

[jeanPerier]

Thanks for having dealt with all the comments, LGTM

flang/lib/Lower/ConvertExpr.cpp

ExtValue genRawProcedureRef(const Fortran::evaluate::ProcedureRef &procRef,
     // arguments.
     for (const Fortran::lower::CallInterface<
              Fortran::lower::CallerInterface>::PassedEntity &arg :
          caller.getPassedArguments()) {
       const auto *actual = arg.entity;
       mlir::Type argTy = callSiteType.getInput(arg.firArgument);
       if (!actual) {
         // Optional dummy argument for which there is no actual argument.
+        if (arg.passBy != PassBy::CharProcTuple) {
           caller.placeInput(arg, builder.create<fir::AbsentOp>(loc, argTy));
           continue;
         }
+
+        mlir::Type funcTy = argTy.cast<mlir::TupleType>()
+                                .getType(0)
+                                .cast<fir::BoxProcType>()
+                                .getEleTy();
+        mlir::Value funcAddr = builder.create<fir::AbsentOp>(loc, funcTy);
+        mlir::Value charLen =
+            builder.createIntegerConstant(loc, builder.getCharacterLengthType(),
+                                          fir::CharacterType::singleton());
+        caller.placeInput(
+            arg, createBoxProcCharTuple(converter, argTy, funcAddr, charLen));
+        continue;
+      }
       const auto *expr = actual->UnwrapExpr();
       if (!expr)
         TODO(loc, "assumed type actual argument");
 
       if (arg.passBy == PassBy::Value) {
         ExtValue argVal = genval(*expr);
         if (!fir::isUnboxedValue(argVal))
           fir::emitFatalError(

flang/test/Lower/dummy-argument-optional.f90

 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
+! RUN: flang-new -fc1 -fdefault-integer-8 -emit-fir %s -o - | FileCheck %s
 
 ! Test OPTIONAL lowering on caller/callee and PRESENT intrinsic.
 module opt
   implicit none
   type t
     real, allocatable :: p(:)
   end type
 contains
subroutine call_character_scalar()
   ! CHECK: %[[x:.*]] = fir.emboxchar %[[addrCast]], {{.*}}
   ! CHECK: fir.call @_QMoptPcharacter_scalar(%[[x]]) {{.*}}: (!fir.boxchar<1>) -> ()
   call character_scalar(x)
   ! CHECK: %[[absent:.*]] = fir.absent !fir.boxchar<1>
   ! CHECK: fir.call @_QMoptPcharacter_scalar(%[[absent]]) {{.*}}: (!fir.boxchar<1>) -> ()
   call character_scalar()
 end subroutine
 
+! Test optional character function
+! CHECK-LABEL: func @_QMoptPchar_proc(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.char<1,3>>,
+character(len=3) function char_proc(i)
+  integer :: i
+  char_proc = "XYZ"
+end function
+! CHECK-LABEL: func @_QMoptPuse_char_proc(
+! CHECK-SAME: %[[arg0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc},
+subroutine use_char_proc(f, c)
+  optional :: f
+  interface
+    character(len=3) function f(i)
+      integer :: i
+    end function
+  end interface
+  character(len=3) :: c
+! CHECK: %[[boxProc:.*]] = fir.extract_value %[[arg0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
+! CHECK: %[[procAddr:.*]] = fir.box_addr %[[boxProc]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: %{{.*}} = fir.is_present %[[procAddr]] : (() -> ()) -> i1
+  if (present(f)) then
+    c = f(0)
+  else
+    c = "ABC"
+  end if
+end subroutine
+! CHECK-LABEL: func @_QMoptPcall_use_char_proc(
+subroutine call_use_char_proc()
+  character(len=3) :: c
+! CHECK: %[[absent:.*]] = fir.absent () -> ()
+! CHECK: %[[c1:.*]] = arith.constant 1 : index
+! CHECK: %[[boxProc:.*]] = fir.emboxproc %[[absent]] : (() -> ()) -> !fir.boxproc<() -> ()>
+! CHECK: %[[charLen:.*]] = fir.convert %[[c1]] : (index) -> i64
+! CHECK: %[[tuple:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: %[[tuple2:.*]] = fir.insert_value %[[tuple]], %[[boxProc]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: %[[tuple3:.*]] = fir.insert_value %[[tuple2]], %[[charLen]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: fir.call @_QMoptPuse_char_proc(%[[tuple3]], %{{.*}}){{.*}} : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxchar<1>) -> ()
+  call use_char_proc(c=c)
+! CHECK: %[[funcAddr:.*]] = fir.address_of(@_QMoptPchar_proc) : (!fir.ref<!fir.char<1,3>>, index, {{.*}}) -> !fir.boxchar<1>
+! CHECK: %[[c3:.*]] = arith.constant 3 : i64
+! CHECK: %[[boxProc2:.*]] = fir.emboxproc %[[funcAddr]] : ((!fir.ref<!fir.char<1,3>>, index, {{.*}}) -> !fir.boxchar<1>) -> !fir.boxproc<() -> ()>
+! CHECK: %[[tuple4:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: %[[tuple5:.*]] = fir.insert_value %[[tuple4]], %[[boxProc2]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: %[[tuple6:.*]] = fir.insert_value %[[tuple5]], %[[c3]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: fir.call @_QMoptPuse_char_proc(%[[tuple6]], {{.*}}){{.*}} : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxchar<1>) -> ()
+  call use_char_proc(char_proc, c)
+end subroutine
+
 ! Test optional assumed shape
 ! CHECK-LABEL: func @_QMoptPassumed_shape(
 ! CHECK-SAME: %[[arg0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
 subroutine assumed_shape(x)
   real, optional :: x(:)
   ! CHECK: fir.is_present %[[arg0]] : (!fir.box<!fir.array<?xf32>>) -> i1
   print *, present(x)
 end subroutine