Index: flang/lib/Lower/Bridge.cpp =================================================================== --- flang/lib/Lower/Bridge.cpp +++ flang/lib/Lower/Bridge.cpp @@ -1293,6 +1293,30 @@ return fir::factory::CharacterExprHelper{*builder, loc} .createEmboxChar(x.getBuffer(), x.getLen()); }, + [&](const fir::MutableBoxValue &x) -> mlir::Value { + mlir::Value resultRef = resultSymBox.getAddr(); + mlir::Value load = builder->create(loc, resultRef); + unsigned rank = x.rank(); + if (x.isAllocatable() && rank > 0) { + // ALLOCATABLE array result must have default lower bounds. + // At the call site the result box of a function reference + // might be considered having default lower bounds, but + // the runtime box should probably comply with this assumption + // as well. If the result box has proper lbounds in runtime, + // this may improve the debugging experience of Fortran apps. + // We may consider removing this, if the overhead of setting + // default lower bounds is too big. + mlir::Value one = + builder->createIntegerConstant(loc, builder->getIndexType(), 1); + llvm::SmallVector lbounds{rank, one}; + auto shiftTy = fir::ShiftType::get(builder->getContext(), rank); + mlir::Value shiftOp = + builder->create(loc, shiftTy, lbounds); + load = builder->create( + loc, load.getType(), load, shiftOp, /*slice=*/mlir::Value{}); + } + return load; + }, [&](const auto &) -> mlir::Value { mlir::Value resultRef = resultSymBox.getAddr(); mlir::Type resultType = genType(resultSym); Index: flang/lib/Lower/ConvertExprToHLFIR.cpp =================================================================== --- flang/lib/Lower/ConvertExprToHLFIR.cpp +++ flang/lib/Lower/ConvertExprToHLFIR.cpp @@ -1884,6 +1884,8 @@ Fortran::lower::StatementContext &stmtCtx) { hlfir::EntityWithAttributes loweredExpr = HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr); + // FIXME? If expr is not a variable, should we reset lower bounds + // for ranked boxes here? return convertToBox(loc, converter, loweredExpr, stmtCtx, converter.genType(expr)); } Index: flang/test/Lower/HLFIR/allocatable-return.f90 =================================================================== --- /dev/null +++ flang/test/Lower/HLFIR/allocatable-return.f90 @@ -0,0 +1,85 @@ +! RUN: bbc -emit-hlfir --polymorphic-type -I nowhere %s -o - | FileCheck %s + +! Test allocatable return. +! Allocatable arrays must have default runtime lbounds after the return. + +function test_alloc_return_scalar + real, allocatable :: test_alloc_return_scalar + allocate(test_alloc_return_scalar) +end function test_alloc_return_scalar +! CHECK-LABEL: func.func @_QPtest_alloc_return_scalar() -> !fir.box> { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box> {bindc_name = "test_alloc_return_scalar", uniq_name = "_QFtest_alloc_return_scalarEtest_alloc_return_scalar"} +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_alloc_return_scalarEtest_alloc_return_scalar"} : (!fir.ref>>) -> (!fir.ref>>, !fir.ref>>) +! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref>> +! CHECK: return %[[VAL_6]] : !fir.box> +! CHECK: } + +function test_alloc_return_array + real, allocatable :: test_alloc_return_array(:) + allocate(test_alloc_return_array(7:8)) +end function test_alloc_return_array +! CHECK-LABEL: func.func @_QPtest_alloc_return_array() -> !fir.box>> { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box>> {bindc_name = "test_alloc_return_array", uniq_name = "_QFtest_alloc_return_arrayEtest_alloc_return_array"} +! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_alloc_return_arrayEtest_alloc_return_array"} : (!fir.ref>>>) -> (!fir.ref>>>, !fir.ref>>>) +! CHECK: %[[VAL_19:.*]] = fir.load %[[VAL_5]]#1 : !fir.ref>>> +! CHECK: %[[VAL_20:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_21:.*]] = fir.shift %[[VAL_20]] : (index) -> !fir.shift<1> +! CHECK: %[[VAL_22:.*]] = fir.rebox %[[VAL_19]](%[[VAL_21]]) : (!fir.box>>, !fir.shift<1>) -> !fir.box>> +! CHECK: return %[[VAL_22]] : !fir.box>> +! CHECK: } + +function test_alloc_return_char_scalar + character(3), allocatable :: test_alloc_return_char_scalar + allocate(test_alloc_return_char_scalar) +end function test_alloc_return_char_scalar +! CHECK-LABEL: func.func @_QPtest_alloc_return_char_scalar() -> !fir.box>> { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box>> {bindc_name = "test_alloc_return_char_scalar", uniq_name = "_QFtest_alloc_return_char_scalarEtest_alloc_return_char_scalar"} +! CHECK: %[[VAL_1:.*]] = arith.constant 3 : index +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %[[VAL_1]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_alloc_return_char_scalarEtest_alloc_return_char_scalar"} : (!fir.ref>>>, index) -> (!fir.ref>>>, !fir.ref>>>) +! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_4]]#1 : !fir.ref>>> +! CHECK: return %[[VAL_7]] : !fir.box>> +! CHECK: } + +function test_alloc_return_char_array + character(3), allocatable :: test_alloc_return_char_array(:) + allocate(test_alloc_return_char_array(7:8)) +end function test_alloc_return_char_array +! CHECK-LABEL: func.func @_QPtest_alloc_return_char_array() -> !fir.box>>> { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box>>> {bindc_name = "test_alloc_return_char_array", uniq_name = "_QFtest_alloc_return_char_arrayEtest_alloc_return_char_array"} +! CHECK: %[[VAL_1:.*]] = arith.constant 3 : index +! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %[[VAL_1]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_alloc_return_char_arrayEtest_alloc_return_char_array"} : (!fir.ref>>>>, index) -> (!fir.ref>>>>, !fir.ref>>>>) +! CHECK: %[[VAL_20:.*]] = fir.load %[[VAL_6]]#1 : !fir.ref>>>> +! CHECK: %[[VAL_21:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_22:.*]] = fir.shift %[[VAL_21]] : (index) -> !fir.shift<1> +! CHECK: %[[VAL_23:.*]] = fir.rebox %[[VAL_20]](%[[VAL_22]]) : (!fir.box>>>, !fir.shift<1>) -> !fir.box>>> +! CHECK: return %[[VAL_23]] : !fir.box>>> +! CHECK: } + +function test_alloc_return_poly_scalar + type t + end type t + class(*), allocatable :: test_alloc_return_poly_scalar + allocate(t :: test_alloc_return_poly_scalar) +end function test_alloc_return_poly_scalar +! CHECK-LABEL: func.func @_QPtest_alloc_return_poly_scalar() -> !fir.class> { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.class> {bindc_name = "test_alloc_return_poly_scalar", uniq_name = "_QFtest_alloc_return_poly_scalarEtest_alloc_return_poly_scalar"} +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_alloc_return_poly_scalarEtest_alloc_return_poly_scalar"} : (!fir.ref>>) -> (!fir.ref>>, !fir.ref>>) +! CHECK: %[[VAL_17:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref>> +! CHECK: return %[[VAL_17]] : !fir.class> +! CHECK: } + +function test_alloc_return_poly_array + type t + end type t + class(*), allocatable :: test_alloc_return_poly_array(:) + allocate(t :: test_alloc_return_poly_array(7:8)) +end function test_alloc_return_poly_array +! CHECK-LABEL: func.func @_QPtest_alloc_return_poly_array() -> !fir.class>> { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.class>> {bindc_name = "test_alloc_return_poly_array", uniq_name = "_QFtest_alloc_return_poly_arrayEtest_alloc_return_poly_array"} +! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_alloc_return_poly_arrayEtest_alloc_return_poly_array"} : (!fir.ref>>>) -> (!fir.ref>>>, !fir.ref>>>) +! CHECK: %[[VAL_26:.*]] = fir.load %[[VAL_5]]#1 : !fir.ref>>> +! CHECK: %[[VAL_27:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_28:.*]] = fir.shift %[[VAL_27]] : (index) -> !fir.shift<1> +! CHECK: %[[VAL_29:.*]] = fir.rebox %[[VAL_26]](%[[VAL_28]]) : (!fir.class>>, !fir.shift<1>) -> !fir.class>> +! CHECK: return %[[VAL_29]] : !fir.class>> +! CHECK: } Index: flang/test/Lower/allocatable-return.f90 =================================================================== --- /dev/null +++ flang/test/Lower/allocatable-return.f90 @@ -0,0 +1,77 @@ +! RUN: bbc -emit-fir --polymorphic-type -I nowhere %s -o - | FileCheck %s + +! Test allocatable return. +! Allocatable arrays must have default runtime lbounds after the return. + +function test_alloc_return_scalar + real, allocatable :: test_alloc_return_scalar + allocate(test_alloc_return_scalar) +end function test_alloc_return_scalar +! CHECK-LABEL: func.func @_QPtest_alloc_return_scalar() -> !fir.box> { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box> {bindc_name = "test_alloc_return_scalar", uniq_name = "_QFtest_alloc_return_scalarEtest_alloc_return_scalar"} +! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_0]] : !fir.ref>> +! CHECK: return %[[VAL_5]] : !fir.box> +! CHECK: } + +function test_alloc_return_array + real, allocatable :: test_alloc_return_array(:) + allocate(test_alloc_return_array(7:8)) +end function test_alloc_return_array +! CHECK-LABEL: func.func @_QPtest_alloc_return_array() -> !fir.box>> { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box>> {bindc_name = "test_alloc_return_array", uniq_name = "_QFtest_alloc_return_arrayEtest_alloc_return_array"} +! CHECK: %[[VAL_18:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> +! CHECK: %[[VAL_19:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_20:.*]] = fir.shift %[[VAL_19]] : (index) -> !fir.shift<1> +! CHECK: %[[VAL_21:.*]] = fir.rebox %[[VAL_18]](%[[VAL_20]]) : (!fir.box>>, !fir.shift<1>) -> !fir.box>> +! CHECK: return %[[VAL_21]] : !fir.box>> +! CHECK: } + +function test_alloc_return_char_scalar + character(3), allocatable :: test_alloc_return_char_scalar + allocate(test_alloc_return_char_scalar) +end function test_alloc_return_char_scalar +! CHECK-LABEL: func.func @_QPtest_alloc_return_char_scalar() -> !fir.box>> { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box>> {bindc_name = "test_alloc_return_char_scalar", uniq_name = "_QFtest_alloc_return_char_scalarEtest_alloc_return_char_scalar"} +! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> +! CHECK: return %[[VAL_5]] : !fir.box>> +! CHECK: } + +function test_alloc_return_char_array + character(3), allocatable :: test_alloc_return_char_array(:) + allocate(test_alloc_return_char_array(7:8)) +end function test_alloc_return_char_array +! CHECK-LABEL: func.func @_QPtest_alloc_return_char_array() -> !fir.box>>> { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box>>> {bindc_name = "test_alloc_return_char_array", uniq_name = "_QFtest_alloc_return_char_arrayEtest_alloc_return_char_array"} +! CHECK: %[[VAL_18:.*]] = fir.load %[[VAL_0]] : !fir.ref>>>> +! CHECK: %[[VAL_19:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_20:.*]] = fir.shift %[[VAL_19]] : (index) -> !fir.shift<1> +! CHECK: %[[VAL_21:.*]] = fir.rebox %[[VAL_18]](%[[VAL_20]]) : (!fir.box>>>, !fir.shift<1>) -> !fir.box>>> +! CHECK: return %[[VAL_21]] : !fir.box>>> +! CHECK: } + +function test_alloc_return_poly_scalar + type t + end type t + class(*), allocatable :: test_alloc_return_poly_scalar + allocate(t :: test_alloc_return_poly_scalar) +end function test_alloc_return_poly_scalar +! CHECK-LABEL: func.func @_QPtest_alloc_return_poly_scalar() -> !fir.class> { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.class> {bindc_name = "test_alloc_return_poly_scalar", uniq_name = "_QFtest_alloc_return_poly_scalarEtest_alloc_return_poly_scalar"} +! CHECK: %[[VAL_16:.*]] = fir.load %[[VAL_0]] : !fir.ref>> +! CHECK: return %[[VAL_16]] : !fir.class> +! CHECK: } + +function test_alloc_return_poly_array + type t + end type t + class(*), allocatable :: test_alloc_return_poly_array(:) + allocate(t :: test_alloc_return_poly_array(7:8)) +end function test_alloc_return_poly_array +! CHECK-LABEL: func.func @_QPtest_alloc_return_poly_array() -> !fir.class>> { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.class>> {bindc_name = "test_alloc_return_poly_array", uniq_name = "_QFtest_alloc_return_poly_arrayEtest_alloc_return_poly_array"} +! CHECK: %[[VAL_25:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> +! CHECK: %[[VAL_26:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_27:.*]] = fir.shift %[[VAL_26]] : (index) -> !fir.shift<1> +! CHECK: %[[VAL_28:.*]] = fir.rebox %[[VAL_25]](%[[VAL_27]]) : (!fir.class>>, !fir.shift<1>) -> !fir.class>> +! CHECK: return %[[VAL_28]] : !fir.class>> +! CHECK: }