[flang-commits] [flang] bc274b8 - [flang] Add test for allocatable on the caller side

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2022-03-01T23:26:43+01:00
New Revision: bc274b854d2327c0a3a62202456d2d43258adb12

URL: https://github.com/llvm/llvm-project/commit/bc274b854d2327c0a3a62202456d2d43258adb12
DIFF: https://github.com/llvm/llvm-project/commit/bc274b854d2327c0a3a62202456d2d43258adb12.diff

LOG: [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 at nvidia.com>
Co-authored-by: Jean Perier <jperier at nvidia.com>

Added: 
    flang/test/Lower/allocatable-caller.f90

Modified: 
    flang/lib/Lower/ConvertExpr.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index d0dd4bbd558d..7d4a4d0f27f7 100644
--- 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
new file mode 100644
index 000000000000..16d661b91d30
--- /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<!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