[flang] Add test for allocatable on the caller side

[clementval]

Summary

This patch adds test for allocatable on the caller side.
Lowering for missing features is added as well.

This patch is part of the upstreaming effort from fir-dev branch.

Depends on D120746

[PeteSteinfeld]

All builds, tests, and is formatted correctly.

[clementval]

Rebase

flang/lib/Lower/ConvertExpr.cpp

for (const Fortran::lower::CallInterface<
         if (!fir::isUnboxedValue(argVal))
           fir::emitFatalError(
               loc, "internal error: passing non trivial value by value");
         caller.placeInput(arg, fir::getBase(argVal));
         continue;
       }
 
       if (arg.passBy == PassBy::MutableBox) {
-        TODO(loc, "arg passby MutableBox");
+        if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
+                *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<fir::BoxType>() &&
+                 "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<fir::StoreOp>(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) {
         auto argAddr = [&]() -> ExtValue {
           ExtValue baseAddr;
           if (actualArgIsVariable && arg.isOptional()) {
             if (Fortran::evaluate::IsAllocatableOrPointerObject(
                     *expr, converter.getFoldingContext())) {

flang/test/Lower/allocatable-caller.f90

+! 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<!fir.heap<f32>> {{{.*}}uniq_name = "_QFtest_scalar_callEx"}
+  call test_scalar(x)
+  ! CHECK: fir.call @_QPtest_scalar(%[[box]]) : (!fir.ref<!fir.box<!fir.heap<f32>>>) -> ()
+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<!fir.heap<!fir.array<?xi32>>> {{{.*}}uniq_name = "_QFtest_array_callEx"}
+  call test_array(x)
+  ! CHECK: fir.call @_QPtest_array(%[[box]]) : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> ()
+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<!fir.heap<!fir.char<1,?>>> {{{.*}}uniq_name = "_QFtest_char_scalar_deferred_callEx"}
+  ! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,10>>> {{{.*}}uniq_name = "_QFtest_char_scalar_deferred_callEx2"}
+  call test_char_scalar_deferred(x)
+  ! CHECK: fir.call @_QPtest_char_scalar_deferred(%[[box]]) : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> ()
+  call test_char_scalar_deferred(x2)
+  ! CHECK: %[[box2cast:.*]] = fir.convert %[[box2]] : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>) -> !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+  ! CHECK: fir.call @_QPtest_char_scalar_deferred(%[[box2cast]]) : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> ()
+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<!fir.heap<!fir.char<1,10>>> {{{.*}}uniq_name = "_QFtest_char_scalar_explicit_callEx"}
+  ! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> {{{.*}}uniq_name = "_QFtest_char_scalar_explicit_callEx2"}
+  call test_char_scalar_explicit(x)
+  ! CHECK: fir.call @_QPtest_char_scalar_explicit(%[[box]]) : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>) -> ()
+  call test_char_scalar_explicit(x2)
+  ! CHECK: %[[box2cast:.*]] = fir.convert %[[box2]] : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>
+  ! CHECK: fir.call @_QPtest_char_scalar_explicit(%[[box2cast]]) : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>) -> ()
+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<!fir.heap<!fir.array<?x!fir.char<1,?>>>> {{{.*}}uniq_name = "_QFtest_char_array_deferred_callEx"}
+  ! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>> {{{.*}}uniq_name = "_QFtest_char_array_deferred_callEx2"}
+  call test_char_array_deferred(x)
+  ! CHECK: fir.call @_QPtest_char_array_deferred(%[[box]]) : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>) -> ()
+  call test_char_array_deferred(x2)
+  ! CHECK: %[[box2cast:.*]] = fir.convert %[[box2]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
+  ! CHECK: fir.call @_QPtest_char_array_deferred(%[[box2cast]]) : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>) -> ()
+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<!fir.heap<!fir.array<?x!fir.char<1,10>>>> {{{.*}}uniq_name = "_QFtest_char_array_explicit_callEx"}
+  ! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> {{{.*}}uniq_name = "_QFtest_char_array_explicit_callEx2"}
+  call test_char_array_explicit(x)
+  ! CHECK: fir.call @_QPtest_char_array_explicit(%[[box]]) : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>) -> ()
+  call test_char_array_explicit(x2)
+  ! CHECK: %[[box2cast:.*]] = fir.convert %[[box2]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>
+  ! CHECK: fir.call @_QPtest_char_array_explicit(%[[box2cast]]) : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>) -> ()
+end subroutine