diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 04dcc9250be61..095f6295d6ad7 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -494,10 +494,19 @@ Fortran::lower::genCallOpAndResult( // arguments of any type and vice versa. mlir::Value cast; auto *context = builder.getContext(); - if (mlir::isa(snd) && - mlir::isa(fst.getType())) { - auto funcTy = mlir::FunctionType::get(context, {}, {}); - auto boxProcTy = builder.getBoxProcType(funcTy); + + // Special handling for %VAL arguments: internal procedures expect + // reference parameters. When %VAL is used, the argument should be + // passed by value. Pass the originally loaded value. + if (fir::isa_ref_type(snd) && !fir::isa_ref_type(fst.getType()) && + fir::dyn_cast_ptrEleTy(snd) == fst.getType()) { + auto loadOp = mlir::cast(fst.getDefiningOp()); + mlir::Value originalStorage = loadOp.getMemref(); + cast = originalStorage; + } else if (mlir::isa(snd) && + mlir::isa(fst.getType())) { + mlir::FunctionType funcTy = mlir::FunctionType::get(context, {}, {}); + fir::BoxProcType boxProcTy = builder.getBoxProcType(funcTy); if (mlir::Value host = argumentHostAssocs(converter, fst)) { cast = fir::EmboxProcOp::create(builder, loc, boxProcTy, llvm::ArrayRef{fst, host}); @@ -1637,7 +1646,19 @@ void prepareUserCallArguments( (*cleanup)(); break; } - caller.placeInput(arg, builder.createConvert(loc, argTy, value)); + // For %VAL arguments, we should pass the value directly without + // conversion to reference types. If argTy is different from value type, + // it might be due to signature mismatch with internal procedures. + if (argTy == value.getType()) + caller.placeInput(arg, value); + else if (fir::isa_ref_type(argTy) && + fir::dyn_cast_ptrEleTy(argTy) == value.getType()) { + auto loadOp = mlir::cast(value.getDefiningOp()); + mlir::Value originalStorage = loadOp.getMemref(); + caller.placeInput(arg, originalStorage); + } else + caller.placeInput(arg, builder.createConvert(loc, argTy, value)); + } break; case PassBy::BaseAddressValueAttribute: case PassBy::CharBoxValueAttribute: diff --git a/flang/test/Lower/percent-val-actual-argument.f90 b/flang/test/Lower/percent-val-actual-argument.f90 new file mode 100644 index 0000000000000..890b1972e80bb --- /dev/null +++ b/flang/test/Lower/percent-val-actual-argument.f90 @@ -0,0 +1,16 @@ +! RUN: flang -fc1 -emit-hlfir %s -o - | FileCheck %s + +program main + logical::a1 + data a1/.true./ + call sa(%val(a1)) +! CHECK: %[[A1_ADDR:.*]] = fir.address_of(@_QFEa1) : !fir.ref> +! CHECK: %[[A1_DECL:.*]]:2 = hlfir.declare %[[A1_ADDR]] {uniq_name = "_QFEa1"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) +! CHECK: fir.call @_QPsa(%[[A1_DECL]]#0) fastmath : (!fir.ref>) -> () +! CHECK: func.func @_QPsa(%[[SA_ARG:.*]]: !fir.ref> {fir.bindc_name = "x1"}) { + write(6,*) "a1 = ", a1 +end program main + +subroutine sa(x1) + logical::x1 +end subroutine sa diff --git a/flang/test/Lower/percent-val-value-argument.f90 b/flang/test/Lower/percent-val-value-argument.f90 new file mode 100644 index 0000000000000..e7d5c5485c6c7 --- /dev/null +++ b/flang/test/Lower/percent-val-value-argument.f90 @@ -0,0 +1,17 @@ +! RUN: flang -fc1 -emit-hlfir %s -o - | FileCheck %s + +program main + logical::a1 + data a1/.true./ + call sb(%val(a1)) +! CHECK: %[[A1_ADDR:.*]] = fir.address_of(@_QFEa1) : !fir.ref> +! CHECK: %[[A1_DECL:.*]]:2 = hlfir.declare %[[A1_ADDR]] {uniq_name = "_QFEa1"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[A1_LOADED:.*]] = fir.load %[[A1_DECL]]#0 : !fir.ref> +! CHECK: fir.call @_QFPsb(%[[A1_LOADED]]) fastmath : (!fir.logical<4>) -> () +! CHECK: func.func private @_QFPsb(%[[SB_ARG:.*]]: !fir.logical<4> {fir.bindc_name = "x1"}) + write(6,*) "a1 = ", a1 +contains + subroutine sb(x1) + logical, value :: x1 + end subroutine sb +end program main