[flang] Add test for allocatable on the caller side

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 Reviewed By: PeteSteinfeld, schweitz Differential Revision: https://reviews.llvm.org/D120748 Co-authored-by: Eric Schweitz <eschweitz@nvidia.com> Co-authored-by: Jean Perier <jperier@nvidia.com>
llvm · Mar 1, 2022 · bc274b8 · bc274b8
1 parent b901c40
commit bc274b8
Show file tree

Hide file tree

Showing 2 changed files with 127 additions and 1 deletion.
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
@@ -1443,7 +1443,32 @@ class ScalarExprLowering {
       }
 
       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) {

diff --git a/flang/test/Lower/allocatable-caller.f90 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<!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