diff --git a/flang/include/flang/Optimizer/Builder/FIRBuilder.h b/flang/include/flang/Optimizer/Builder/FIRBuilder.h --- a/flang/include/flang/Optimizer/Builder/FIRBuilder.h +++ b/flang/include/flang/Optimizer/Builder/FIRBuilder.h @@ -426,6 +426,10 @@ mlir::Value ub, mlir::Value step, mlir::Type type); + /// Create an AbsentOp of \p argTy type and handle special cases, such as + /// Character Procedure Tuple arguments. + mlir::Value genAbsentOp(mlir::Location loc, mlir::Type argTy); + /// Set default FastMathFlags value for all operations /// supporting mlir::arith::FastMathAttr that will be created /// by this builder. diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -764,7 +764,7 @@ if (type == i1Type) elseResultValues.push_back(builder.createBool(loc, false)); else - elseResultValues.push_back(builder.create(loc, type)); + elseResultValues.push_back(builder.genAbsentOp(loc, type)); } builder.create(loc, elseResultValues); } @@ -1047,7 +1047,7 @@ mlir::Type argTy = callSiteType.getInput(arg.firArgument); if (!preparedActual) { // Optional dummy argument for which there is no actual argument. - caller.placeInput(arg, builder.create(loc, argTy)); + caller.placeInput(arg, builder.genAbsentOp(loc, argTy)); continue; } const auto *expr = arg.entity->UnwrapExpr(); diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -2455,7 +2455,7 @@ mlir::Type argTy = callSiteType.getInput(arg.firArgument); if (!actual) { // Optional dummy argument for which there is no actual argument. - caller.placeInput(arg, builder.create(loc, argTy)); + caller.placeInput(arg, builder.genAbsentOp(loc, argTy)); continue; } const auto *expr = actual->UnwrapExpr(); diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp --- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp +++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp @@ -614,6 +614,18 @@ return create(loc, cmp, div, zero); } +mlir::Value fir::FirOpBuilder::genAbsentOp(mlir::Location loc, + mlir::Type argTy) { + if (!fir::isCharacterProcedureTuple(argTy)) + return create(loc, argTy); + + auto boxProc = + create(loc, argTy.cast().getType(0)); + mlir::Value charLen = create(loc, getCharacterLengthType()); + return fir::factory::createCharacterProcedureTuple(*this, loc, argTy, boxProc, + charLen); +} + void fir::FirOpBuilder::setCommonAttributes(mlir::Operation *op) const { auto fmi = mlir::dyn_cast(*op); if (!fmi) diff --git a/flang/test/Lower/HLFIR/dummy-argument-optional.f90 b/flang/test/Lower/HLFIR/dummy-argument-optional.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/HLFIR/dummy-argument-optional.f90 @@ -0,0 +1,60 @@ +! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s + +! Test OPTIONAL lowering on caller/callee +module opt + implicit none +contains + +! Test optional character function +! CHECK-LABEL: func @_QMoptPchar_proc( +! CHECK-SAME: %[[arg0:.*]]: !fir.ref>, +character(len=3) function char_proc(i) + integer :: i + char_proc = "XYZ" +end function +! CHECK-LABEL: func @_QMoptPuse_char_proc( +! CHECK-SAME: %[[arg0:.*]]: tuple ()>, 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 ()>, i64>) -> !fir.boxproc<() -> ()> +! CHECK: %[[boxAddr:.*]] = fir.box_addr %[[boxProc]] : (!fir.boxproc<() -> ()>) -> (() -> ()) +! CHECK: %[[boxProc2:.*]] = fir.emboxproc %[[boxAddr]] : (() -> ()) -> !fir.boxproc<() -> ()> +! CHECK: %[[tuple:.*]] = fir.undefined tuple ()>, i64> +! CHECK: %[[tuple2:.*]] = fir.insert_value %[[tuple]], %[[boxProc2]], [0 : index] : (tuple ()>, i64>, !fir.boxproc<() -> ()>) -> tuple ()>, i64> +! CHECK: %[[tuple3:.*]] = fir.insert_value %[[tuple2]], %{{.*}}, [1 : index] : (tuple ()>, i64>, i64) -> tuple ()>, i64> +! CHECK: %[[boxProc3:.*]] = fir.extract_value %[[tuple3]], [0 : index] : (tuple ()>, i64>) -> !fir.boxproc<() -> ()> +! CHECK: %{{.*}} = fir.is_present %[[boxProc3]] : (!fir.boxproc<() -> ()>) -> 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: %[[boxProc:.*]] = fir.absent !fir.boxproc<() -> ()> +! CHECK: %[[undef:.*]] = fir.undefined index +! CHECK: %[[charLen:.*]] = fir.convert %[[undef]] : (index) -> i64 +! CHECK: %[[tuple:.*]] = fir.undefined tuple ()>, i64> +! CHECK: %[[tuple2:.*]] = fir.insert_value %[[tuple]], %[[boxProc]], [0 : index] : (tuple ()>, i64>, !fir.boxproc<() -> ()>) -> tuple ()>, i64> +! CHECK: %[[tuple3:.*]] = fir.insert_value %[[tuple2]], %[[charLen]], [1 : index] : (tuple ()>, i64>, i64) -> tuple ()>, i64> +! CHECK: fir.call @_QMoptPuse_char_proc(%[[tuple3]], %{{.*}}){{.*}} : (tuple ()>, i64>, !fir.boxchar<1>) -> () + call use_char_proc(c=c) +! CHECK: %[[funcAddr:.*]] = fir.address_of(@_QMoptPchar_proc) : (!fir.ref>, index, {{.*}}) -> !fir.boxchar<1> +! CHECK: %[[c3:.*]] = arith.constant 3 : i64 +! CHECK: %[[boxProc2:.*]] = fir.emboxproc %[[funcAddr]] : ((!fir.ref>, index, {{.*}}) -> !fir.boxchar<1>) -> !fir.boxproc<() -> ()> +! CHECK: %[[tuple4:.*]] = fir.undefined tuple ()>, i64> +! CHECK: %[[tuple5:.*]] = fir.insert_value %[[tuple4]], %[[boxProc2]], [0 : index] : (tuple ()>, i64>, !fir.boxproc<() -> ()>) -> tuple ()>, i64> +! CHECK: %[[tuple6:.*]] = fir.insert_value %[[tuple5]], %[[c3]], [1 : index] : (tuple ()>, i64>, i64) -> tuple ()>, i64> +! CHECK: fir.call @_QMoptPuse_char_proc(%[[tuple6]], {{.*}}){{.*}} : (tuple ()>, i64>, !fir.boxchar<1>) -> () + call use_char_proc(char_proc, c) +end subroutine + +end module diff --git a/flang/test/Lower/dummy-argument-optional.f90 b/flang/test/Lower/dummy-argument-optional.f90 --- a/flang/test/Lower/dummy-argument-optional.f90 +++ b/flang/test/Lower/dummy-argument-optional.f90 @@ -1,4 +1,5 @@ ! 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 @@ -68,6 +69,53 @@ call character_scalar() end subroutine +! Test optional character function +! CHECK-LABEL: func @_QMoptPchar_proc( +! CHECK-SAME: %[[arg0:.*]]: !fir.ref>, +character(len=3) function char_proc(i) + integer :: i + char_proc = "XYZ" +end function +! CHECK-LABEL: func @_QMoptPuse_char_proc( +! CHECK-SAME: %[[arg0:.*]]: tuple ()>, 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 ()>, 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: %[[boxProc:.*]] = fir.absent !fir.boxproc<() -> ()> +! CHECK: %[[undef:.*]] = fir.undefined index +! CHECK: %[[charLen:.*]] = fir.convert %[[undef]] : (index) -> i64 +! CHECK: %[[tuple:.*]] = fir.undefined tuple ()>, i64> +! CHECK: %[[tuple2:.*]] = fir.insert_value %[[tuple]], %[[boxProc]], [0 : index] : (tuple ()>, i64>, !fir.boxproc<() -> ()>) -> tuple ()>, i64> +! CHECK: %[[tuple3:.*]] = fir.insert_value %[[tuple2]], %[[charLen]], [1 : index] : (tuple ()>, i64>, i64) -> tuple ()>, i64> +! CHECK: fir.call @_QMoptPuse_char_proc(%[[tuple3]], %{{.*}}){{.*}} : (tuple ()>, i64>, !fir.boxchar<1>) -> () + call use_char_proc(c=c) +! CHECK: %[[funcAddr:.*]] = fir.address_of(@_QMoptPchar_proc) : (!fir.ref>, index, {{.*}}) -> !fir.boxchar<1> +! CHECK: %[[c3:.*]] = arith.constant 3 : i64 +! CHECK: %[[boxProc2:.*]] = fir.emboxproc %[[funcAddr]] : ((!fir.ref>, index, {{.*}}) -> !fir.boxchar<1>) -> !fir.boxproc<() -> ()> +! CHECK: %[[tuple4:.*]] = fir.undefined tuple ()>, i64> +! CHECK: %[[tuple5:.*]] = fir.insert_value %[[tuple4]], %[[boxProc2]], [0 : index] : (tuple ()>, i64>, !fir.boxproc<() -> ()>) -> tuple ()>, i64> +! CHECK: %[[tuple6:.*]] = fir.insert_value %[[tuple5]], %[[c3]], [1 : index] : (tuple ()>, i64>, i64) -> tuple ()>, i64> +! CHECK: fir.call @_QMoptPuse_char_proc(%[[tuple6]], {{.*}}){{.*}} : (tuple ()>, 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.bindc_name = "x", fir.optional}) {