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 @@ -1443,7 +1443,32 @@ } if (arg.passBy == PassBy::MutableBox) { - TODO(loc, "arg passby MutableBox"); + if (Fortran::evaluate::UnwrapExpr( + *expr)) { + // If expr is NULL(), the mutableBox created must be a deallocated + // pointer with the dummy argument characteristics (see table 16.5 + // in Fortran 2018 standard). + // No length parameters are set for the created box because any non + // deferred type parameters of the dummy will be evaluated on the + // callee side, and it is illegal to use NULL without a MOLD if any + // dummy length parameters are assumed. + mlir::Type boxTy = fir::dyn_cast_ptrEleTy(argTy); + assert(boxTy && boxTy.isa() && + "must be a fir.box type"); + mlir::Value boxStorage = builder.createTemporary(loc, boxTy); + mlir::Value nullBox = fir::factory::createUnallocatedBox( + builder, loc, boxTy, /*nonDeferredParams=*/{}); + builder.create(loc, nullBox, boxStorage); + caller.placeInput(arg, boxStorage); + continue; + } + fir::MutableBoxValue mutableBox = genMutableBoxValue(*expr); + mlir::Value irBox = + fir::factory::getMutableIRBox(builder, loc, mutableBox); + caller.placeInput(arg, irBox); + if (arg.mayBeModifiedByCall()) + mutableModifiedByCall.emplace_back(std::move(mutableBox)); + continue; } const bool actualArgIsVariable = Fortran::evaluate::IsVariable(*expr); if (arg.passBy == PassBy::BaseAddress || arg.passBy == PassBy::BoxChar) { diff --git a/flang/test/Lower/allocatable-caller.f90 b/flang/test/Lower/allocatable-caller.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/allocatable-caller.f90 @@ -0,0 +1,101 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! Test passing allocatables on caller side + +! CHECK-LABEL: func @_QPtest_scalar_call( +subroutine test_scalar_call() + interface + subroutine test_scalar(x) + real, allocatable :: x + end subroutine + end interface + real, allocatable :: x + ! CHECK: %[[box:.*]] = fir.alloca !fir.box> {{{.*}}uniq_name = "_QFtest_scalar_callEx"} + call test_scalar(x) + ! CHECK: fir.call @_QPtest_scalar(%[[box]]) : (!fir.ref>>) -> () +end subroutine + +! CHECK-LABEL: func @_QPtest_array_call( +subroutine test_array_call() + interface + subroutine test_array(x) + integer, allocatable :: x(:) + end subroutine + end interface + integer, allocatable :: x(:) + ! CHECK: %[[box:.*]] = fir.alloca !fir.box>> {{{.*}}uniq_name = "_QFtest_array_callEx"} + call test_array(x) + ! CHECK: fir.call @_QPtest_array(%[[box]]) : (!fir.ref>>>) -> () +end subroutine + +! CHECK-LABEL: func @_QPtest_char_scalar_deferred_call( +subroutine test_char_scalar_deferred_call() + interface + subroutine test_char_scalar_deferred(x) + character(:), allocatable :: x + end subroutine + end interface + character(:), allocatable :: x + character(10), allocatable :: x2 + ! CHECK-DAG: %[[box:.*]] = fir.alloca !fir.box>> {{{.*}}uniq_name = "_QFtest_char_scalar_deferred_callEx"} + ! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box>> {{{.*}}uniq_name = "_QFtest_char_scalar_deferred_callEx2"} + call test_char_scalar_deferred(x) + ! CHECK: fir.call @_QPtest_char_scalar_deferred(%[[box]]) : (!fir.ref>>>) -> () + call test_char_scalar_deferred(x2) + ! CHECK: %[[box2cast:.*]] = fir.convert %[[box2]] : (!fir.ref>>>) -> !fir.ref>>> + ! CHECK: fir.call @_QPtest_char_scalar_deferred(%[[box2cast]]) : (!fir.ref>>>) -> () +end subroutine + +! CHECK-LABEL: func @_QPtest_char_scalar_explicit_call( +subroutine test_char_scalar_explicit_call() + interface + subroutine test_char_scalar_explicit(x) + character(10), allocatable :: x + end subroutine + end interface + character(10), allocatable :: x + character(:), allocatable :: x2 + ! CHECK-DAG: %[[box:.*]] = fir.alloca !fir.box>> {{{.*}}uniq_name = "_QFtest_char_scalar_explicit_callEx"} + ! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box>> {{{.*}}uniq_name = "_QFtest_char_scalar_explicit_callEx2"} + call test_char_scalar_explicit(x) + ! CHECK: fir.call @_QPtest_char_scalar_explicit(%[[box]]) : (!fir.ref>>>) -> () + call test_char_scalar_explicit(x2) + ! CHECK: %[[box2cast:.*]] = fir.convert %[[box2]] : (!fir.ref>>>) -> !fir.ref>>> + ! CHECK: fir.call @_QPtest_char_scalar_explicit(%[[box2cast]]) : (!fir.ref>>>) -> () +end subroutine + +! CHECK-LABEL: func @_QPtest_char_array_deferred_call( +subroutine test_char_array_deferred_call() + interface + subroutine test_char_array_deferred(x) + character(:), allocatable :: x(:) + end subroutine + end interface + character(:), allocatable :: x(:) + character(10), allocatable :: x2(:) + ! CHECK-DAG: %[[box:.*]] = fir.alloca !fir.box>>> {{{.*}}uniq_name = "_QFtest_char_array_deferred_callEx"} + ! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box>>> {{{.*}}uniq_name = "_QFtest_char_array_deferred_callEx2"} + call test_char_array_deferred(x) + ! CHECK: fir.call @_QPtest_char_array_deferred(%[[box]]) : (!fir.ref>>>>) -> () + call test_char_array_deferred(x2) + ! CHECK: %[[box2cast:.*]] = fir.convert %[[box2]] : (!fir.ref>>>>) -> !fir.ref>>>> + ! CHECK: fir.call @_QPtest_char_array_deferred(%[[box2cast]]) : (!fir.ref>>>>) -> () +end subroutine + +! CHECK-LABEL: func @_QPtest_char_array_explicit_call( +subroutine test_char_array_explicit_call() + interface + subroutine test_char_array_explicit(x) + character(10), allocatable :: x(:) + end subroutine + end interface + character(10), allocatable :: x(:) + character(:), allocatable :: x2(:) + ! CHECK-DAG: %[[box:.*]] = fir.alloca !fir.box>>> {{{.*}}uniq_name = "_QFtest_char_array_explicit_callEx"} + ! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box>>> {{{.*}}uniq_name = "_QFtest_char_array_explicit_callEx2"} + call test_char_array_explicit(x) + ! CHECK: fir.call @_QPtest_char_array_explicit(%[[box]]) : (!fir.ref>>>>) -> () + call test_char_array_explicit(x2) + ! CHECK: %[[box2cast:.*]] = fir.convert %[[box2]] : (!fir.ref>>>>) -> !fir.ref>>>> + ! CHECK: fir.call @_QPtest_char_array_explicit(%[[box2cast]]) : (!fir.ref>>>>) -> () +end subroutine