[flang] Reset lbounds for allocatable function results.

[vzakhari]

Summary

With HLFIR the lbounds for the ALLOCATABLE result are taken
from the mutable box created for the result, so the non-default
lbounds might be propagated further causing incorrect result, e.g.:

program p
  real, allocatable :: p5(:)
  allocate(p5, source=real_init())
  print *, lbound(p5, 1) ! must print 1, but prints 7
contains
  function real_init()
    real, allocatable :: real_init(:)
    allocate(real_init(7:8))
  end function real_init
end program p

With FIR lowering the box passed for source has explicit lower
bound 1 at the call site, but the runtime box initialized by
real_init call still has lower bound 7. I am not sure if
the runtime box initialized b real_init will ever be accessed
in a debugger via Fortran variable names, but I think that
having the right runtime bounds that can be accessible via
examining registers/stack might be good in general. So I decided
to update the runtime bounds at the point of return.

This change "fixes" the test above for HLFIR, but we may still
have a problem at the call site. I am not sure, though, where
the right fix should be.

[vzakhari]

Hi @jeanPerier, can you please take a look when you have time? I am not sure whether this is the right solution.

[jeanPerier]

Your patch makes sense to me.

My initial plan was to do it on the caller side by "moving" the result into an hlfir.expr here (via hlfir.as_expr with the move flag set): https://github.com/llvm/llvm-project/blob/ab340f97f92a7f8ae5b0df02410552a86aebc295/flang/lib/Lower/ConvertCall.cpp#L1210
But this will create some hassle for the finalization of the allocatable, if any (currently inserted here) , because finalization can currently only be done with entities in memory (maybe hlfir.destroy could be given a flag to indicate that finalization is required).

Regarding your fixme, from it semantic point of view, rather than a late catch-up, it would be nice if expressions that are not variables are lowered into hlfir.expr / trivial scalars in HLFIR, but I would first check that this is good from an optimization point of view (i.e., that hlfir.expr manipulation does not increase the number of array copies).

So I think your patch is the best solution right now, and if we see benefits to promoting in-memory function results to hlfir.expr, then we should move the lower bound clean-up at that point on the caller side (IMHO, the fact that the descriptor passed "leaks" the result variable lower bound is not a big issue since it is not associated to a variable name on the caller side. Similarly, the incoming descriptor for an assumed shape lacks the local lower bounds on the callee side, we cannot guarantee that the lower bounds from the register in the call are meaningful at every point of the call).

[tblah]

LGTM too. Thanks!

flang/lib/Lower/Bridge.cpp

void genReturnSymbol(const Fortran::semantics::Symbol &functionSymbol) {
     }
     mlir::Value resultVal = resultSymBox.match(
         [&](const fir::CharBoxValue &x) -> mlir::Value {
           if (Fortran::semantics::IsBindCProcedure(functionSymbol))
             return builder->create<fir::LoadOp>(loc, x.getBuffer());
           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<fir::LoadOp>(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<mlir::Value> lbounds{rank, one};
+            auto shiftTy = fir::ShiftType::get(builder->getContext(), rank);
+            mlir::Value shiftOp =
+                builder->create<fir::ShiftOp>(loc, shiftTy, lbounds);
+            load = builder->create<fir::ReboxOp>(
+                loc, load.getType(), load, shiftOp, /*slice=*/mlir::Value{});
+          }
+          return load;
+        },
         [&](const auto &) -> mlir::Value {
           mlir::Value resultRef = resultSymBox.getAddr();
           mlir::Type resultType = genType(resultSym);
           mlir::Type resultRefType = builder->getRefType(resultType);
           // A function with multiple entry points returning different types
           // tags all result variables with one of the largest types to allow
           // them to share the same storage. Convert this to the actual type.
           if (resultRef.getType() != resultRefType)

flang/test/Lower/HLFIR/allocatable-return.f90

+! 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<!fir.heap<f32>> {
+! CHECK:           %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<f32>> {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<allocatable>, uniq_name = "_QFtest_alloc_return_scalarEtest_alloc_return_scalar"} : (!fir.ref<!fir.box<!fir.heap<f32>>>) -> (!fir.ref<!fir.box<!fir.heap<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>)
+! CHECK:           %[[VAL_6:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.heap<f32>>>
+! CHECK:           return %[[VAL_6]] : !fir.box<!fir.heap<f32>>
+! 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<!fir.heap<!fir.array<?xf32>>> {
+! CHECK:           %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>> {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<allocatable>, uniq_name = "_QFtest_alloc_return_arrayEtest_alloc_return_array"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>)
+! CHECK:           %[[VAL_19:.*]] = fir.load %[[VAL_5]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+! 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.heap<!fir.array<?xf32>>>, !fir.shift<1>) -> !fir.box<!fir.heap<!fir.array<?xf32>>>
+! CHECK:           return %[[VAL_22]] : !fir.box<!fir.heap<!fir.array<?xf32>>>
+! 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<!fir.heap<!fir.char<1,3>>> {
+! CHECK:           %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,3>>> {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<allocatable>, uniq_name = "_QFtest_alloc_return_char_scalarEtest_alloc_return_char_scalar"} : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,3>>>>, index) -> (!fir.ref<!fir.box<!fir.heap<!fir.char<1,3>>>>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,3>>>>)
+! CHECK:           %[[VAL_7:.*]] = fir.load %[[VAL_4]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,3>>>>
+! CHECK:           return %[[VAL_7]] : !fir.box<!fir.heap<!fir.char<1,3>>>
+! 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<!fir.heap<!fir.array<?x!fir.char<1,3>>>> {
+! CHECK:           %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>> {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<allocatable>, uniq_name = "_QFtest_alloc_return_char_arrayEtest_alloc_return_char_array"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>>>, index) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>>>)
+! CHECK:           %[[VAL_20:.*]] = fir.load %[[VAL_6]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>>>
+! 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.heap<!fir.array<?x!fir.char<1,3>>>>, !fir.shift<1>) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>>
+! CHECK:           return %[[VAL_23]] : !fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>>
+! 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<!fir.heap<none>> {
+! CHECK:           %[[VAL_0:.*]] = fir.alloca !fir.class<!fir.heap<none>> {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<allocatable>, uniq_name = "_QFtest_alloc_return_poly_scalarEtest_alloc_return_poly_scalar"} : (!fir.ref<!fir.class<!fir.heap<none>>>) -> (!fir.ref<!fir.class<!fir.heap<none>>>, !fir.ref<!fir.class<!fir.heap<none>>>)
+! CHECK:           %[[VAL_17:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.class<!fir.heap<none>>>
+! CHECK:           return %[[VAL_17]] : !fir.class<!fir.heap<none>>
+! 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<!fir.heap<!fir.array<?xnone>>> {
+! CHECK:           %[[VAL_0:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?xnone>>> {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<allocatable>, uniq_name = "_QFtest_alloc_return_poly_arrayEtest_alloc_return_poly_array"} : (!fir.ref<!fir.class<!fir.heap<!fir.array<?xnone>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.array<?xnone>>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?xnone>>>>)
+! CHECK:           %[[VAL_26:.*]] = fir.load %[[VAL_5]]#1 : !fir.ref<!fir.class<!fir.heap<!fir.array<?xnone>>>>
+! 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.heap<!fir.array<?xnone>>>, !fir.shift<1>) -> !fir.class<!fir.heap<!fir.array<?xnone>>>
+! CHECK:           return %[[VAL_29]] : !fir.class<!fir.heap<!fir.array<?xnone>>>
+! CHECK:         }

flang/test/Lower/allocatable-return.f90

+! 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<!fir.heap<f32>> {
+! CHECK:           %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<f32>> {bindc_name = "test_alloc_return_scalar", uniq_name = "_QFtest_alloc_return_scalarEtest_alloc_return_scalar"}
+! CHECK:           %[[VAL_5:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+! CHECK:           return %[[VAL_5]] : !fir.box<!fir.heap<f32>>
+! 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<!fir.heap<!fir.array<?xf32>>> {
+! CHECK:           %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>> {bindc_name = "test_alloc_return_array", uniq_name = "_QFtest_alloc_return_arrayEtest_alloc_return_array"}
+! CHECK:           %[[VAL_18:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+! 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.heap<!fir.array<?xf32>>>, !fir.shift<1>) -> !fir.box<!fir.heap<!fir.array<?xf32>>>
+! CHECK:           return %[[VAL_21]] : !fir.box<!fir.heap<!fir.array<?xf32>>>
+! 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<!fir.heap<!fir.char<1,3>>> {
+! CHECK:           %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,3>>> {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<!fir.box<!fir.heap<!fir.char<1,3>>>>
+! CHECK:           return %[[VAL_5]] : !fir.box<!fir.heap<!fir.char<1,3>>>
+! 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<!fir.heap<!fir.array<?x!fir.char<1,3>>>> {
+! CHECK:           %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>> {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<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>>>
+! 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.heap<!fir.array<?x!fir.char<1,3>>>>, !fir.shift<1>) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>>
+! CHECK:           return %[[VAL_21]] : !fir.box<!fir.heap<!fir.array<?x!fir.char<1,3>>>>
+! 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<!fir.heap<none>> {
+! CHECK:           %[[VAL_0:.*]] = fir.alloca !fir.class<!fir.heap<none>> {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<!fir.class<!fir.heap<none>>>
+! CHECK:           return %[[VAL_16]] : !fir.class<!fir.heap<none>>
+! 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<!fir.heap<!fir.array<?xnone>>> {
+! CHECK:           %[[VAL_0:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?xnone>>> {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<!fir.class<!fir.heap<!fir.array<?xnone>>>>
+! 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.heap<!fir.array<?xnone>>>, !fir.shift<1>) -> !fir.class<!fir.heap<!fir.array<?xnone>>>
+! CHECK:           return %[[VAL_28]] : !fir.class<!fir.heap<!fir.array<?xnone>>>
+! CHECK:         }