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 @@ -71,11 +71,9 @@ /// Lower a type(C_PTR/C_FUNPTR) argument with VALUE attribute into a /// reference. A C pointer can correspond to a Fortran dummy argument of type /// C_PTR with the VALUE attribute. (see 18.3.6 note 3). -static mlir::Value -genRecordCPtrValueArg(Fortran::lower::AbstractConverter &converter, - mlir::Value rec, mlir::Type ty) { - fir::FirOpBuilder &builder = converter.getFirOpBuilder(); - mlir::Location loc = converter.getCurrentLocation(); +static mlir::Value genRecordCPtrValueArg(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Value rec, + mlir::Type ty) { mlir::Value cAddr = fir::factory::genCPtrOrCFunptrAddr(builder, loc, rec, ty); mlir::Value cVal = builder.create(loc, cAddr); return builder.createConvert(loc, cAddr.getType(), cVal); @@ -354,7 +352,7 @@ mlir::Type fromTy = fir::unwrapRefType(fst.getType()); if (fir::isa_builtin_cptr_type(fromTy) && Fortran::lower::isCPtrArgByValueType(snd)) { - cast = genRecordCPtrValueArg(converter, fst, fromTy); + cast = genRecordCPtrValueArg(builder, loc, fst, fromTy); } else if (fir::isa_derived(snd)) { // FIXME: This seems like a serious bug elsewhere in lowering. Paper // over the problem for now. @@ -1077,9 +1075,24 @@ // True pass-by-value semantics. assert(!preparedActual->handleDynamicOptional() && "cannot be optional"); hlfir::Entity actual = preparedActual->getActual(loc, builder); - auto value = hlfir::loadTrivialScalar(loc, builder, actual); - if (!value.isValue()) - TODO(loc, "Passing CPTR an CFUNCTPTR VALUE in HLFIR"); + hlfir::Entity value = hlfir::loadTrivialScalar(loc, builder, actual); + + mlir::Type eleTy = value.getFortranElementType(); + if (fir::isa_builtin_cptr_type(eleTy)) { + // Pass-by-value argument of type(C_PTR/C_FUNPTR). + // Load the __address component and pass it by value. + if (value.isValue()) { + auto associate = hlfir::genAssociateExpr(loc, builder, value, eleTy, + "adapt.cptrbyval"); + value = hlfir::Entity{genRecordCPtrValueArg( + builder, loc, associate.getFirBase(), eleTy)}; + builder.create(loc, associate); + } else { + value = + hlfir::Entity{genRecordCPtrValueArg(builder, loc, value, eleTy)}; + } + } + caller.placeInput(arg, builder.createConvert(loc, argTy, value)); } break; case PassBy::BaseAddressValueAttribute: diff --git a/flang/test/HLFIR/c_ptr_byvalue.f90 b/flang/test/HLFIR/c_ptr_byvalue.f90 new file mode 100644 --- /dev/null +++ b/flang/test/HLFIR/c_ptr_byvalue.f90 @@ -0,0 +1,41 @@ +! RUN: bbc -emit-fir -hlfir %s -o - | FileCheck %s + +! CHECK-LABEL: func.func @_QPtest1() { +! CHECK: %[[VAL_110:.*]]:3 = hlfir.associate %{{.*}} {uniq_name = "adapt.cptrbyval"} : (!hlfir.expr>) -> (!fir.ref>, !fir.ref>, i1) +! CHECK: %[[VAL_111:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_112:.*]] = fir.coordinate_of %[[VAL_110]]#1, %[[VAL_111]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_113:.*]] = fir.load %[[VAL_112]] : !fir.ref +! CHECK: %[[VAL_114:.*]] = fir.convert %[[VAL_113]] : (i64) -> !fir.ref +! CHECK: hlfir.end_associate %[[VAL_110]]#1, %[[VAL_110]]#2 : !fir.ref>, i1 +! CHECK: fir.call @get_expected_f(%[[VAL_114]]) fastmath : (!fir.ref) -> () +subroutine test1 + use iso_c_binding + interface + subroutine get_expected_f(src) bind(c) + use iso_c_binding + type(c_ptr), value :: src + end subroutine get_expected_f + end interface + real, target, dimension(1) :: r_src + call get_expected_f(c_loc(r_src)) +end + +! CHECK-LABEL: func.func @_QPtest2( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref> {fir.bindc_name = "cptr"}) { +! CHECK: %[[VAL_97:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest2Ecptr"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_98:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_99:.*]] = fir.coordinate_of %[[VAL_97]]#0, %[[VAL_98]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_100:.*]] = fir.load %[[VAL_99]] : !fir.ref +! CHECK: %[[VAL_101:.*]] = fir.convert %[[VAL_100]] : (i64) -> !fir.ref +! CHECK: fir.call @get_expected_f(%[[VAL_101]]) fastmath : (!fir.ref) -> () +subroutine test2(cptr) + use iso_c_binding + interface + subroutine get_expected_f(src) bind(c) + use iso_c_binding + type(c_ptr), value :: src + end subroutine get_expected_f + end interface + type(c_ptr) :: cptr + call get_expected_f(cptr) +end