[flang] Add more lowering tests for dummy arguments

[clementval]

Summary

This patch adds more lowering tests for dummy arguments
and adds lowering for a specific case.

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

flang/lib/Lower/ConvertExpr.cpp

public:
   }
 
   template <typename T>
   ExtValue genMutableBoxValueImpl(const T &) {
     // NULL() case should not be handled here.
     fir::emitFatalError(getLoc(), "NULL() must be lowered in its context");
   }
 
+  /// A `NULL()` in a position where a mutable box is expected has the same
+  /// semantics as an absent optional box value.
+  ExtValue genMutableBoxValueImpl(const Fortran::evaluate::NullPointer &) {
+    mlir::Location loc = getLoc();
+    auto nullConst = builder.createNullConstant(loc);
+    auto noneTy = mlir::NoneType::get(builder.getContext());
+    auto polyRefTy = fir::LLVMPointerType::get(noneTy);
+    // MutableBoxValue will dereference the box, so create a bogus temporary for
+    // the `nullptr`. The LLVM optimizer will garbage collect the temp.
+    auto temp =
+        builder.createTemporary(loc, polyRefTy, /*shape=*/mlir::ValueRange{});
+    auto nullPtr = builder.createConvert(loc, polyRefTy, nullConst);
+    builder.create<fir::StoreOp>(loc, nullPtr, temp);
+    auto nullBoxTy = builder.getRefType(fir::BoxType::get(noneTy));
+    return fir::MutableBoxValue(builder.createConvert(loc, nullBoxTy, temp),
+                                /*lenParameters=*/mlir::ValueRange{},
+                                /*mutableProperties=*/{});
+  }
+
   template <typename T>
   ExtValue
   genMutableBoxValueImpl(const Fortran::evaluate::FunctionRef<T> &funRef) {
     return genRawProcedureRef(funRef, converter.genType(toEvExpr(funRef)));
   }
 
   template <typename T>
   ExtValue

flang/test/Lower/dummy-argument-contiguous.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+! RUN: bbc -emit-fir -gen-array-coor %s -o - | FileCheck %s --check-prefix=ArrayCoorCHECK
+
+! Test that non-contiguous assumed-shape memory layout is handled in lowering.
+! In practice, test that input fir.box is propagated to fir operations 
+
+! Also test that when the contiguous keyword is present, lowering adds the
+! attribute to the fir argument and that is takes the contiguity into account
+! In practice, test that the input fir.box is not propagated to fir operations.
+
+! CHECK-LABEL: func @_QPtest_element_ref(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous}, %arg1: !fir.box<!fir.array<?xf32>>{{.*}}) {
+! ArrayCoorCHECK-LABEL: func @_QPtest_element_ref
+subroutine test_element_ref(x, y)
+  real, contiguous :: x(:)
+  ! CHECK-DAG: %[[xaddr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+  real :: y(4:)
+  ! CHECK-DAG: %[[c4:.*]] = fir.convert %c4{{.*}} : (i64) -> index
+
+  call bar(x(100))
+  ! CHECK: fir.coordinate_of %[[xaddr]], %{{.*}} : (!fir.ref<!fir.array<?xf32>>, i64) -> !fir.ref<f32>
+  call bar(y(100))
+  ! Test that for an entity that is not know to be contiguous, the fir.box is passed
+  ! to coordinate of and that the lower bounds is already applied by lowering.
+  ! CHECK: %[[c4_2:.*]] = fir.convert %[[c4]] : (index) -> i64
+  ! CHECK: %[[index:.*]] = arith.subi %c100{{.*}}, %[[c4_2]] : i64
+  ! CHECK: fir.coordinate_of %arg1, %{{.*}} : (!fir.box<!fir.array<?xf32>>, i64) -> !fir.ref<f32>
+
+
+  ! Repeat test when lowering is using fir.array_coor
+  ! ArrayCoorCHECK-DAG: %[[xaddr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+  ! ArrayCoorCHECK-DAG: %[[xshape:.*]] = fir.shape
+  ! ArrayCoorCHECK-DAG: %[[c100:.*]] = fir.convert %c100{{.*}} : (i64) -> index
+  ! ArrayCoorCHECK: fir.array_coor %[[xaddr]](%[[xshape]]) %[[c100]] : (!fir.ref<!fir.array<?xf32>>, !fir.shapeshift<1>, index) -> !fir.ref<f32>
+
+  ! ArrayCoorCHECK-DAG: %[[c100_1:.*]] = fir.convert %c100{{.*}} : (i64) -> index
+  ! ArrayCoorCHECK-DAG: %[[shift:.*]] = fir.shift %{{.*}} : (index) -> !fir.shift<1>
+  ! ArrayCoorCHECK: fir.array_coor %arg1(%[[shift]]) %[[c100_1]] : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>, index) -> !fir.ref<f32>
+end subroutine
+
+! CHECK-LABEL: func @_QPtest_element_assign(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous}, %arg1: !fir.box<!fir.array<?xf32>>{{.*}}) {
+!  ArrayCoorCHECK-LABEL: func @_QPtest_element_assign
+subroutine test_element_assign(x, y)
+  real, contiguous :: x(:)
+  ! CHECK-DAG: %[[xaddr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+  real :: y(4:)
+  ! CHECK-DAG: %[[c4:.*]] = fir.convert %c4{{.*}} : (i64) -> index
+  x(100) = 42.
+  ! CHECK: fir.coordinate_of %[[xaddr]], %{{.*}} : (!fir.ref<!fir.array<?xf32>>, i64) -> !fir.ref<f32>
+  y(100) = 42.
+  ! CHECK: %[[c4_2:.*]] = fir.convert %[[c4]] : (index) -> i64
+  ! CHECK: %[[index:.*]] = arith.subi %c100{{.*}}, %[[c4_2]] : i64
+  ! CHECK: fir.coordinate_of %arg1, %{{.*}} : (!fir.box<!fir.array<?xf32>>, i64) -> !fir.ref<f32>
+
+  ! ArrayCoorCHECK-DAG: %[[xaddr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+  ! ArrayCoorCHECK-DAG: %[[xshape:.*]] = fir.shape
+  ! ArrayCoorCHECK-DAG: %[[c100:.*]] = fir.convert %c100{{.*}} : (i64) -> index
+  ! ArrayCoorCHECK: fir.array_coor %[[xaddr]](%[[xshape]]) %[[c100]] : (!fir.ref<!fir.array<?xf32>>, !fir.shapeshift<1>, index) -> !fir.ref<f32>
+
+  ! ArrayCoorCHECK-DAG: %[[c100_1:.*]] = fir.convert %c100{{.*}} : (i64) -> index
+  ! ArrayCoorCHECK-DAG: %[[shift:.*]] = fir.shift %{{.*}} : (index) -> !fir.shift<1>
+  ! ArrayCoorCHECK: fir.array_coor %arg1(%[[shift]]) %[[c100_1]] : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>, index) -> !fir.ref<f32>
+end subroutine
+
+! CHECK-LABEL: func @_QPtest_ref_in_array_expr(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous}, %arg1: !fir.box<!fir.array<?xf32>>{{.*}}) {
+subroutine test_ref_in_array_expr(x, y)
+  real, contiguous :: x(:)
+  ! CHECK: %[[xaddr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+  real :: y(:)
+  call bar2(x+1.)
+  ! CHECK: fir.array_load %[[xaddr]](%{{.*}}) : (!fir.ref<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.array<?xf32>
+  call bar2(y+1.)
+  ! CHECK: fir.array_load %arg1 : (!fir.box<!fir.array<?xf32>>) -> !fir.array<?xf32>
+end subroutine
+
+
+! CHECK-LABEL: func @_QPtest_assign_in_array_ref(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous}, %arg1: !fir.box<!fir.array<?xf32>>{{.*}}) {
+subroutine test_assign_in_array_ref(x, y)
+  real, contiguous :: x(:)
+  ! CHECK: %[[xaddr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+  real :: y(:)
+  x = 42.
+  ! CHECK: %[[xload:.*]] = fir.array_load %[[xaddr]]({{.*}}) : (!fir.ref<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.array<?xf32>
+  ! CHECK: %[[xloop:.*]] = fir.do_loop {{.*}} iter_args(%arg3 = %[[xload]]) -> (!fir.array<?xf32>)
+  ! CHECK: fir.array_merge_store %[[xload]], %[[xloop]] to %[[xaddr]] : !fir.array<?xf32>, !fir.array<?xf32>, !fir.ref<!fir.array<?xf32>>
+  y = 42.
+  ! CHECK: %[[yload:.*]] = fir.array_load %arg1 : (!fir.box<!fir.array<?xf32>>) -> !fir.array<?xf32>
+  ! CHECK: %[[yloop:.*]] = fir.do_loop {{.*}} iter_args(%arg3 = %[[yload]]) -> (!fir.array<?xf32>) {
+  ! CHECK: fir.array_merge_store %[[yload]], %[[yloop]] to %arg1 : !fir.array<?xf32>, !fir.array<?xf32>, !fir.box<!fir.array<?xf32>>
+end subroutine
+
+! CHECK-LABEL: func @_QPtest_slice_ref(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous}, %arg1: !fir.box<!fir.array<?xf32>>
+subroutine test_slice_ref(x, y, z1, z2, i, j, k, n)
+  real, contiguous :: x(:)
+  ! CHECK: %[[xaddr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+  real :: y(:)
+  integer :: i, j, k, n
+  real :: z1(n), z2(n)
+  z2 = x(i:j:k)
+  ! CHECK: %[[xslice:.*]] = fir.slice
+  ! CHECK: fir.array_load %[[xaddr]]{{.*}}%[[xslice]]{{.*}}: (!fir.ref<!fir.array<?xf32>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.array<?xf32>
+  z1 = y(i:j:k)
+  ! CHECK: %[[yslice:.*]] = fir.slice
+  ! CHECK: fir.array_load %arg1 {{.*}}%[[yslice]]{{.*}} : (!fir.box<!fir.array<?xf32>>, !fir.slice<1>) -> !fir.array<?xf32>
+end subroutine
+
+! CHECK-LABEL: func @_QPtest_slice_assign(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous}, %arg1: !fir.box<!fir.array<?xf32>>
+subroutine test_slice_assign(x, y, i, j, k)
+  real, contiguous :: x(:)
+  ! CHECK: %[[xaddr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+  real :: y(:)
+  integer :: i, j, k
+  x(i:j:k) = 42.
+  ! CHECK: %[[xslice:.*]] = fir.slice
+  ! CHECK: fir.array_load %[[xaddr]]{{.*}}%[[xslice]]{{.*}}: (!fir.ref<!fir.array<?xf32>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.array<?xf32>
+  y(i:j:k) = 42.
+  ! CHECK: %[[yslice:.*]] = fir.slice
+  ! CHECK: fir.array_load %arg1 {{.*}}%[[yslice]]{{.*}}: (!fir.box<!fir.array<?xf32>>, !fir.slice<1>) -> !fir.array<?xf32>
+end subroutine
+
+! test that allocatable are considered contiguous.
+! CHECK-LABEL: func @_QPfoo
+subroutine foo(x)
+  real, allocatable :: x(:)
+  call bar(x(100))
+  ! CHECK: fir.coordinate_of %{{.*}}, %{{.*}} (!fir.heap<!fir.array<?xf32>>, i64) -> !fir.ref<f32>
+end subroutine
+
+! Test that non-contiguous dummy are propagated with their memory layout (we
+! mainly do not want to create a new box that would ignore the original layout).
+! CHECK: func @_QPpropagate(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"})
+subroutine propagate(x)
+  interface
+    subroutine bar3(x)
+      real :: x(:)
+    end subroutine
+  end interface
+  real :: x(:)
+  call bar3(x)
+ ! CHECK: fir.call @_QPbar3(%arg0) : (!fir.box<!fir.array<?xf32>>) -> ()
+end subroutine

flang/test/Lower/dummy-argument-optional-2.f90

+! Test passing pointer, allocatables, and optional assumed shapes to optional
+! explicit shapes (see F2018 15.5.2.12).
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+module optional_tests
+  implicit none
+  interface
+  subroutine takes_opt_scalar(i)
+    integer, optional :: i
+  end subroutine
+  subroutine takes_opt_scalar_char(c)
+    character(*), optional :: c
+  end subroutine
+  subroutine takes_opt_explicit_shape(x)
+    real, optional :: x(100)
+  end subroutine
+  subroutine takes_opt_explicit_shape_intentout(x)
+    real, optional, intent(out) :: x(100)
+  end subroutine
+  subroutine takes_opt_explicit_shape_intentin(x)
+    real, optional, intent(in) :: x(100)
+  end subroutine
+  subroutine takes_opt_explicit_shape_char(c)
+    character(*), optional :: c(100)
+  end subroutine
+  function returns_pointer()
+    real, pointer :: returns_pointer(:)
+  end function
+  end interface
+  contains
+  
+  ! -----------------------------------------------------------------------------
+  !     Test passing scalar pointers and allocatables to an optional
+  ! -----------------------------------------------------------------------------
+  ! Here, nothing optional specific is expected, the address is passed, and its
+  ! allocation/association status match the dummy presence status.
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPpass_pointer_scalar(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<i32>>>{{.*}}) {
+  subroutine pass_pointer_scalar(i)
+    integer, pointer :: i
+    call takes_opt_scalar(i)
+  ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
+  ! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<i32>>) -> !fir.ptr<i32>
+  ! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<i32>) -> !fir.ref<i32>
+  ! CHECK:         fir.call @_QPtakes_opt_scalar(%[[VAL_3]]) : (!fir.ref<i32>) -> ()
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPpass_allocatable_scalar(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<i32>>>{{.*}}) {
+  subroutine pass_allocatable_scalar(i)
+    integer, allocatable :: i
+    call takes_opt_scalar(i)
+  ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<i32>>>
+  ! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.heap<i32>>) -> !fir.heap<i32>
+  ! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.heap<i32>) -> !fir.ref<i32>
+  ! CHECK:         fir.call @_QPtakes_opt_scalar(%[[VAL_3]]) : (!fir.ref<i32>) -> ()
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPpass_pointer_scalar_char(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>{{.*}}) {
+  subroutine pass_pointer_scalar_char(c)
+    character(:), pointer :: c
+    call takes_opt_scalar_char(c)
+  ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
+  ! CHECK:         %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> index
+  ! CHECK:         %[[VAL_3:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.ptr<!fir.char<1,?>>
+  ! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ptr<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,?>>
+  ! CHECK:         %[[VAL_5:.*]] = fir.emboxchar %[[VAL_4]], %[[VAL_2]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+  ! CHECK:         fir.call @_QPtakes_opt_scalar_char(%[[VAL_5]]) : (!fir.boxchar<1>) -> ()
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPpass_allocatable_scalar_char(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>{{.*}}) {
+  subroutine pass_allocatable_scalar_char(c)
+    character(:), allocatable :: c
+    call takes_opt_scalar_char(c)
+  ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+  ! CHECK:         %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> index
+  ! CHECK:         %[[VAL_3:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
+  ! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.heap<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,?>>
+  ! CHECK:         %[[VAL_5:.*]] = fir.emboxchar %[[VAL_4]], %[[VAL_2]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+  ! CHECK:         fir.call @_QPtakes_opt_scalar_char(%[[VAL_5]]) : (!fir.boxchar<1>) -> ()
+  end subroutine
+  
+  ! -----------------------------------------------------------------------------
+  !     Test passing non contiguous pointers to explicit shape optional
+  ! -----------------------------------------------------------------------------
+  ! The pointer descriptor can be unconditionally read, but the copy-in/copy-out
+  ! must be conditional on the pointer association status in order to get the
+  ! correct present/absent aspect.
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPpass_pointer_array(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}) {
+  subroutine pass_pointer_array(i)
+    real, pointer :: i(:)
+    call takes_opt_explicit_shape(i)
+  ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+  ! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
+  ! CHECK:         %[[VAL_4:.*]] = arith.constant 0 : i64
+  ! CHECK:         %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64
+  ! CHECK:         %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+  ! CHECK:         %[[VAL_7:.*]] = arith.constant 0 : index
+  ! CHECK:         %[[VAL_9:.*]] = fir.if %[[VAL_5]] -> (!fir.heap<!fir.array<?xf32>>) {
+  ! CHECK:           %[[VAL_10:.*]] = arith.constant 0 : index
+  ! CHECK:           %[[VAL_11:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_10]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
+  ! CHECK:           %[[VAL_12:.*]] = fir.allocmem !fir.array<?xf32>, %[[VAL_11]]#1 {uniq_name = ".copyinout"}
+  ! CHECK:           %[[VAL_20:.*]] = fir.do_loop {{.*}} {
+  ! CHECK:           }
+  ! CHECK:           fir.array_merge_store %{{.*}}, %[[VAL_20]] to %[[VAL_12]] : !fir.array<?xf32>, !fir.array<?xf32>, !fir.heap<!fir.array<?xf32>>
+  ! CHECK:           fir.result %[[VAL_12]] : !fir.heap<!fir.array<?xf32>>
+  ! CHECK:         } else {
+  ! CHECK:           %[[VAL_26:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
+  ! CHECK:           fir.result %[[VAL_26]] : !fir.heap<!fir.array<?xf32>>
+  ! CHECK:         }
+  ! CHECK:         %[[VAL_29:.*]] = fir.convert %[[VAL_9]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
+  ! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_29]]) : (!fir.ref<!fir.array<100xf32>>) -> ()
+  ! CHECK:         fir.if %[[VAL_5]] {
+  ! CHECK:           %[[VAL_40:.*]] = fir.do_loop {{.*}} {
+  ! CHECK:           }
+  ! CHECK:           fir.array_merge_store %{{.*}}, %[[VAL_40]] to %[[VAL_6]] : !fir.array<?xf32>, !fir.array<?xf32>, !fir.box<!fir.ptr<!fir.array<?xf32>>>
+  ! CHECK:           fir.freemem %[[VAL_9]]
+  ! CHECK:         }
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPpass_pointer_array_char(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>{{.*}}) {
+  subroutine pass_pointer_array_char(c)
+    character(:), pointer :: c(:)
+    call takes_opt_explicit_shape_char(c)
+  ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
+  ! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> !fir.ptr<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?x!fir.char<1,?>>>) -> i64
+  ! CHECK:         %[[VAL_4:.*]] = arith.constant 0 : i64
+  ! CHECK:         %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64
+  ! CHECK:         %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
+  ! CHECK:         %[[VAL_9:.*]] = fir.if %[[VAL_5]] -> (!fir.heap<!fir.array<?x!fir.char<1,?>>>) {
+  ! CHECK:           %[[VAL_10:.*]] = arith.constant 0 : index
+  ! CHECK:           %[[VAL_11:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_10]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>, index) -> (index, index, index)
+  ! CHECK:           %[[VAL_12:.*]] = fir.box_elesize %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> index
+  ! CHECK:           %[[VAL_13:.*]] = fir.allocmem !fir.array<?x!fir.char<1,?>>(%[[VAL_12]] : index), %[[VAL_11]]#1 {uniq_name = ".copyinout"}
+  ! CHECK:           %[[VAL_21:.*]] = fir.do_loop {{.*}} {
+  ! CHECK:           }
+  ! CHECK:           fir.array_merge_store %{{.*}}, %[[VAL_21]] to %[[VAL_13]] typeparams %[[VAL_12]] : !fir.array<?x!fir.char<1,?>>, !fir.array<?x!fir.char<1,?>>, !fir.heap<!fir.array<?x!fir.char<1,?>>>, index
+  ! CHECK:           fir.result %[[VAL_13]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:         } else {
+  ! CHECK:           %[[VAL_46:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:           fir.result %[[VAL_46]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:         }
+  ! CHECK:         %[[VAL_47:.*]] = fir.box_elesize %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> index
+  ! CHECK:         %[[VAL_50:.*]] = fir.convert %[[VAL_9]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>
+  ! CHECK:         %[[VAL_52:.*]] = fir.emboxchar %[[VAL_50]], %[[VAL_47]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+  ! CHECK:         fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_52]]) : (!fir.boxchar<1>) -> ()
+  ! CHECK:         fir.if %[[VAL_5]] {
+  ! CHECK:           %[[VAL_62:.*]] = fir.do_loop {{.*}} {
+  ! CHECK:           }
+  ! CHECK:           fir.array_merge_store %{{.*}}, %[[VAL_62]] to %[[VAL_6]] : !fir.array<?x!fir.char<1,?>>, !fir.array<?x!fir.char<1,?>>, !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>
+  ! CHECK:           fir.freemem %[[VAL_9]]
+  ! CHECK:         }
+  ! CHECK:         return
+  ! CHECK:       }
+  end subroutine
+  
+  ! This case is bit special because the pointer is not a symbol but a function
+  ! result. Test that the copy-in/copy-out is the same as with normal pointers.
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPforward_pointer_array() {
+  subroutine forward_pointer_array()
+    call takes_opt_explicit_shape(returns_pointer())
+  ! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = ".result"}
+  ! CHECK:         %[[VAL_1:.*]] = fir.call @_QPreturns_pointer() : () -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+  ! CHECK:         fir.save_result %[[VAL_1]] to %[[VAL_0]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+  ! CHECK:         %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+  ! CHECK:         %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
+  ! CHECK:         %[[VAL_5:.*]] = arith.constant 0 : i64
+  ! CHECK:         %[[VAL_6:.*]] = arith.cmpi ne, %[[VAL_4]], %[[VAL_5]] : i64
+  ! CHECK:         %[[VAL_7:.*]] = fir.if %[[VAL_6]] -> (!fir.heap<!fir.array<?xf32>>) {
+  ! CHECK:           %[[VAL_10:.*]] = fir.allocmem !fir.array<?xf32>
+  ! CHECK:           fir.do_loop {{.*}} {
+  ! CHECK:           }
+  ! CHECK:           fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>
+  ! CHECK:         } else {
+  ! CHECK:           %[[VAL_11:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
+  ! CHECK:           fir.result %[[VAL_11]] : !fir.heap<!fir.array<?xf32>>
+  ! CHECK:         }
+  ! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
+  ! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_14]]) : (!fir.ref<!fir.array<100xf32>>) -> ()
+  ! CHECK:         fir.if %[[VAL_6]] {
+  ! CHECK:           fir.do_loop {{.*}} {
+  ! CHECK:           }
+  ! CHECK:           fir.freemem %[[VAL_7]]
+  ! CHECK:         }
+  end subroutine
+  
+  ! -----------------------------------------------------------------------------
+  !    Test passing assumed shape optional to explicit shape optional
+  ! -----------------------------------------------------------------------------
+  ! The fix.box can only be read if the assumed shape is present,
+  ! and the copy-in/copy-out must also be conditional on the assumed
+  ! shape presence.
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPpass_opt_assumed_shape(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
+  subroutine pass_opt_assumed_shape(x)
+    real, optional :: x(:)
+    call takes_opt_explicit_shape(x)
+  ! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1
+  ! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
+  ! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
+  ! CHECK:         %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_7:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?xf32>>) {
+  ! CHECK:           %[[VAL_8:.*]] = arith.constant 0 : index
+  ! CHECK:           %[[VAL_9:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_8]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+  ! CHECK:           %[[VAL_10:.*]] = fir.allocmem !fir.array<?xf32>, %[[VAL_9]]#1 {uniq_name = ".copyinout"}
+  ! CHECK:           %[[VAL_17:.*]] = fir.do_loop {{.*}} {
+  ! CHECK:           }
+  ! CHECK:           fir.array_merge_store %{{.*}}, %[[VAL_17]] to %[[VAL_10]] : !fir.array<?xf32>, !fir.array<?xf32>, !fir.heap<!fir.array<?xf32>>
+  ! CHECK:           fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>
+  ! CHECK:         } else {
+  ! CHECK:           %[[VAL_23:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
+  ! CHECK:           fir.result %[[VAL_23]] : !fir.heap<!fir.array<?xf32>>
+  ! CHECK:         }
+  ! CHECK:         %[[VAL_26:.*]] = fir.convert %[[VAL_27:.*]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
+  ! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_26]]) : (!fir.ref<!fir.array<100xf32>>) -> ()
+  ! CHECK:         fir.if %[[VAL_1]] {
+  ! CHECK:           %[[VAL_36:.*]] = fir.do_loop {{.*}} { 
+  ! CHECK:           }
+  ! CHECK:           fir.array_merge_store %{{.*}}, %[[VAL_36]] to %[[VAL_6]] : !fir.array<?xf32>, !fir.array<?xf32>, !fir.box<!fir.array<?xf32>>
+  ! CHECK:           fir.freemem %[[VAL_27]]
+  ! CHECK:         }
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPpass_opt_assumed_shape_char(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "c", fir.optional}) {
+  subroutine pass_opt_assumed_shape_char(c)
+    character(*), optional :: c(:)
+    call takes_opt_explicit_shape_char(c)
+  ! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> i1
+  ! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
+  ! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
+  ! CHECK:         %[[VAL_5:.*]] = arith.constant 0 : index
+  ! CHECK:         %[[VAL_6:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) typeparams %[[VAL_5]] : (!fir.ref<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:         %[[VAL_7:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_6]] : !fir.box<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:         %[[VAL_8:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?x!fir.char<1,?>>>) {
+  ! CHECK:           %[[VAL_19:.*]] = fir.do_loop  {{.*}} {
+  ! CHECK:           }
+  ! CHECK:           fir.array_merge_store %{{.*}}, %[[VAL_19]] to %[[VAL_12]] typeparams %[[VAL_11]] : !fir.array<?x!fir.char<1,?>>, !fir.array<?x!fir.char<1,?>>, !fir.heap<!fir.array<?x!fir.char<1,?>>>, index
+  ! CHECK:           fir.result %[[VAL_12]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:         } else {
+  ! CHECK:           %[[VAL_44:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:           fir.result %[[VAL_44]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:         }
+  ! CHECK:         %[[VAL_45:.*]] = fir.box_elesize %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
+  ! CHECK:         %[[VAL_48:.*]] = fir.convert %[[VAL_49:.*]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>
+  ! CHECK:         %[[VAL_50:.*]] = fir.emboxchar %[[VAL_48]], %[[VAL_45]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+  ! CHECK:         fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_50]]) : (!fir.boxchar<1>) -> ()
+  ! CHECK:         fir.if %[[VAL_1]] {
+  ! CHECK:           %[[VAL_59:.*]] = fir.do_loop {{.*}} {
+  ! CHECK:           fir.array_merge_store %{{.*}}, %[[VAL_59]] to %[[VAL_7]] : !fir.array<?x!fir.char<1,?>>, !fir.array<?x!fir.char<1,?>>, !fir.box<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:           fir.freemem %[[VAL_49]]
+  ! CHECK:         }
+  end subroutine
+  
+  ! -----------------------------------------------------------------------------
+  !    Test passing contiguous optional assumed shape to explicit shape optional
+  ! -----------------------------------------------------------------------------
+  ! The fix.box can only be read if the assumed shape is present.
+  ! There should be no copy-in/copy-out
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPpass_opt_contiguous_assumed_shape(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous, fir.optional}) {
+  subroutine pass_opt_contiguous_assumed_shape(x)
+    real, optional, contiguous :: x(:)
+    call takes_opt_explicit_shape(x)
+  ! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1
+  ! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
+  ! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
+  ! CHECK:         %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.ref<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
+  ! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_8]]) : (!fir.ref<!fir.array<100xf32>>) -> ()
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPpass_opt_contiguous_assumed_shape_char(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "c", fir.contiguous, fir.optional}) {
+  subroutine pass_opt_contiguous_assumed_shape_char(c)
+    character(*), optional, contiguous :: c(:)
+    call takes_opt_explicit_shape_char(c)
+  ! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> i1
+  ! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
+  ! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
+  ! CHECK:         %[[VAL_5:.*]] = arith.constant 0 : index
+  ! CHECK:         %[[VAL_6:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) typeparams %[[VAL_5]] : (!fir.ref<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:         %[[VAL_7:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_6]] : !fir.box<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:         %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:         %[[VAL_9:.*]] = fir.box_elesize %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
+  ! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_8]] : (!fir.ref<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>
+  ! CHECK:         %[[VAL_11:.*]] = fir.emboxchar %[[VAL_10]], %[[VAL_9]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+  ! CHECK:         fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_11]]) : (!fir.boxchar<1>) -> ()
+  end subroutine
+  
+  ! -----------------------------------------------------------------------------
+  !    Test passing allocatables and contiguous pointers to explicit shape optional
+  ! -----------------------------------------------------------------------------
+  ! The fix.box can be read and its address directly passed. There should be no
+  ! copy-in/copy-out.
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPpass_allocatable_array(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>{{.*}}) {
+  subroutine pass_allocatable_array(i)
+    real, allocatable :: i(:)
+    call takes_opt_explicit_shape(i)
+  ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+  ! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
+  ! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_3]]) : (!fir.ref<!fir.array<100xf32>>) -> ()
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPpass_allocatable_array_char(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>{{.*}}) {
+  subroutine pass_allocatable_array_char(c)
+    character(:), allocatable :: c(:)
+    call takes_opt_explicit_shape_char(c)
+  ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
+  ! CHECK:         %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> index
+  ! CHECK:         %[[VAL_3:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>
+  ! CHECK:         %[[VAL_5:.*]] = fir.emboxchar %[[VAL_4]], %[[VAL_2]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+  ! CHECK:         fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_5]]) : (!fir.boxchar<1>) -> ()
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPpass_contiguous_pointer_array(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "i", fir.contiguous}) {
+  subroutine pass_contiguous_pointer_array(i)
+    real, pointer, contiguous :: i(:)
+    call takes_opt_explicit_shape(i)
+  ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+  ! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
+  ! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_3]]) : (!fir.ref<!fir.array<100xf32>>) -> ()
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPpass_contiguous_pointer_array_char(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>> {fir.bindc_name = "c", fir.contiguous}) {
+  subroutine pass_contiguous_pointer_array_char(c)
+    character(:), pointer, contiguous :: c(:)
+    call takes_opt_explicit_shape_char(c)
+  ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
+  ! CHECK:         %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> index
+  ! CHECK:         %[[VAL_3:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> !fir.ptr<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ptr<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>
+  ! CHECK:         %[[VAL_5:.*]] = fir.emboxchar %[[VAL_4]], %[[VAL_2]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+  ! CHECK:         fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_5]]) : (!fir.boxchar<1>) -> ()
+  end subroutine
+  
+  ! -----------------------------------------------------------------------------
+  !    Test passing assumed shape optional to explicit shape optional with intents
+  ! -----------------------------------------------------------------------------
+  ! The fix.box can only be read if the assumed shape is present,
+  ! and the copy-in/copy-out must also be conditional on the assumed
+  ! shape presence. For intent(in), there should be no copy-out while for
+  ! intent(out), there should be no copy-in.
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPpass_opt_assumed_shape_to_intentin(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
+  subroutine pass_opt_assumed_shape_to_intentin(x)
+    real, optional :: x(:)
+    call takes_opt_explicit_shape_intentin(x)
+  ! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1
+  ! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
+  ! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
+  ! CHECK:         %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_7:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?xf32>>) {
+  ! CHECK:           %[[VAL_10:.*]] = fir.allocmem !fir.array<?xf32>
+  ! CHECK:           fir.do_loop {{.*}} {
+  ! CHECK:           }
+  ! CHECK:           fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>
+  ! CHECK:         } else {
+  ! CHECK:           %[[VAL_23:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
+  ! CHECK:           fir.result %[[VAL_23]] : !fir.heap<!fir.array<?xf32>>
+  ! CHECK:         }
+  ! CHECK:         %[[VAL_24:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
+  ! CHECK:         fir.call @_QPtakes_opt_explicit_shape_intentin(%[[VAL_24]]) : (!fir.ref<!fir.array<100xf32>>) -> ()
+  ! CHECK:         fir.if %[[VAL_1]] {
+  ! CHECK-NOT:       fir.do_loop
+  ! CHECK:           fir.freemem %[[VAL_7]]
+  ! CHECK:         }
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QMoptional_testsPpass_opt_assumed_shape_to_intentout(
+  ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
+  subroutine pass_opt_assumed_shape_to_intentout(x)
+    real, optional :: x(:)
+    call takes_opt_explicit_shape_intentout(x)
+  ! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1
+  ! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
+  ! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
+  ! CHECK:         %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>
+  ! CHECK:         %[[VAL_7:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?xf32>>) {
+  ! CHECK:           %[[VAL_10:.*]] = fir.allocmem !fir.array<?xf32>
+  ! CHECK-NOT:       fir.do_loop
+  ! CHECK:           fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>
+  ! CHECK:         } else {
+  ! CHECK:           %[[VAL_11:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
+  ! CHECK:           fir.result %[[VAL_11]] : !fir.heap<!fir.array<?xf32>>
+  ! CHECK:         }
+  ! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
+  ! CHECK:         fir.call @_QPtakes_opt_explicit_shape_intentout(%[[VAL_14]]) : (!fir.ref<!fir.array<100xf32>>) -> ()
+  ! CHECK:         fir.if %[[VAL_1]] {
+  ! CHECK:           fir.do_loop {{.*}} {
+  ! CHECK:           }
+  ! CHECK:           fir.freemem %[[VAL_7]]
+  ! CHECK:         }
+  end subroutine
+  end module
+  
 No newline at end of file

flang/test/Lower/dummy-argument-optional.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Test OPTIONAL lowering on caller/callee and PRESENT intrinsic.
+module opt
+  implicit none
+  type t
+    real, allocatable :: p(:)
+  end type
+contains
+
+! Test simple scalar optional
+! CHECK-LABEL: func @_QMoptPintrinsic_scalar(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<f32> {fir.bindc_name = "x", fir.optional}) {
+subroutine intrinsic_scalar(x)
+  real, optional :: x
+  ! CHECK: fir.is_present %[[arg0]] : (!fir.ref<f32>) -> i1
+  print *, present(x)
+end subroutine
+! CHECK-LABEL: @_QMoptPcall_intrinsic_scalar()
+subroutine call_intrinsic_scalar()
+  ! CHECK: %[[x:.*]] = fir.alloca f32
+  real :: x
+  ! CHECK: fir.call @_QMoptPintrinsic_scalar(%[[x]]) : (!fir.ref<f32>) -> ()
+  call intrinsic_scalar(x)
+  ! CHECK: %[[absent:.*]] = fir.absent !fir.ref<f32>
+  ! CHECK: fir.call @_QMoptPintrinsic_scalar(%[[absent]]) : (!fir.ref<f32>) -> ()
+  call intrinsic_scalar()
+end subroutine
+
+! Test explicit shape array optional
+! CHECK-LABEL: func @_QMoptPintrinsic_f77_array(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.array<100xf32>> {fir.bindc_name = "x", fir.optional}) {
+subroutine intrinsic_f77_array(x)
+  real, optional :: x(100)
+  ! CHECK: fir.is_present %[[arg0]] : (!fir.ref<!fir.array<100xf32>>) -> i1
+  print *, present(x)
+end subroutine
+! CHECK-LABEL: func @_QMoptPcall_intrinsic_f77_array()
+subroutine call_intrinsic_f77_array()
+  ! CHECK: %[[x:.*]] = fir.alloca !fir.array<100xf32>
+  real :: x(100)
+  ! CHECK: fir.call @_QMoptPintrinsic_f77_array(%[[x]]) : (!fir.ref<!fir.array<100xf32>>) -> ()
+  call intrinsic_f77_array(x)
+  ! CHECK: %[[absent:.*]] = fir.absent !fir.ref<!fir.array<100xf32>>
+  ! CHECK: fir.call @_QMoptPintrinsic_f77_array(%[[absent]]) : (!fir.ref<!fir.array<100xf32>>) -> ()
+  call intrinsic_f77_array()
+end subroutine
+
+! Test optional character scalar
+! CHECK-LABEL: func @_QMoptPcharacter_scalar(
+! CHECK-SAME: %[[arg0:.*]]: !fir.boxchar<1> {fir.bindc_name = "x", fir.optional}) {
+subroutine character_scalar(x)
+  ! CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %[[arg0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+  character(10), optional :: x
+  ! CHECK: fir.is_present %[[unboxed]]#0 : (!fir.ref<!fir.char<1,?>>) -> i1
+  print *, present(x)
+end subroutine
+! CHECK-LABEL: func @_QMoptPcall_character_scalar()
+subroutine call_character_scalar()
+  ! CHECK: %[[addr:.*]] = fir.alloca !fir.char<1,10>
+  character(10) :: x
+  ! CHECK: %[[addrCast:.*]] = fir.convert %[[addr]]
+  ! CHECK: %[[x:.*]] = fir.emboxchar %[[addrCast]], {{.*}}
+  ! CHECK: fir.call @_QMoptPcharacter_scalar(%[[x]]) : (!fir.boxchar<1>) -> ()
+  call character_scalar(x)
+  ! CHECK: %[[absent:.*]] = fir.absent !fir.boxchar<1>
+  ! CHECK: fir.call @_QMoptPcharacter_scalar(%[[absent]]) : (!fir.boxchar<1>) -> ()
+  call character_scalar()
+end subroutine
+
+! Test optional assumed shape
+! CHECK-LABEL: func @_QMoptPassumed_shape(
+! CHECK-SAME: %[[arg0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
+subroutine assumed_shape(x)
+  real, optional :: x(:)
+  ! CHECK: fir.is_present %[[arg0]] : (!fir.box<!fir.array<?xf32>>) -> i1
+  print *, present(x)
+end subroutine
+! CHECK: func @_QMoptPcall_assumed_shape()
+subroutine call_assumed_shape()
+  ! CHECK: %[[addr:.*]] = fir.alloca !fir.array<100xf32>
+  real :: x(100)
+  ! CHECK: %[[embox:.*]] = fir.embox %[[addr]]
+  ! CHECK: %[[x:.*]] = fir.convert %[[embox]] : (!fir.box<!fir.array<100xf32>>) -> !fir.box<!fir.array<?xf32>>
+  ! CHECK: fir.call @_QMoptPassumed_shape(%[[x]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+  call assumed_shape(x)
+  ! CHECK: %[[absent:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
+  ! CHECK: fir.call @_QMoptPassumed_shape(%[[absent]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+  call assumed_shape()
+end subroutine
+
+! Test optional allocatable
+! CHECK: func @_QMoptPallocatable_array(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> {fir.bindc_name = "x", fir.optional}) {
+subroutine allocatable_array(x)
+  real, allocatable, optional :: x(:)
+  ! CHECK: fir.is_present %[[arg0]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> i1
+  print *, present(x)
+end subroutine
+! CHECK: func @_QMoptPcall_allocatable_array()
+subroutine call_allocatable_array()
+  ! CHECK: %[[x:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>>
+  real, allocatable :: x(:)
+  ! CHECK: fir.call @_QMoptPallocatable_array(%[[x]]) : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+  call allocatable_array(x)
+  ! CHECK: %[[absent:.*]] = fir.absent !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+  ! CHECK: fir.call @_QMoptPallocatable_array(%[[absent]]) : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+  call allocatable_array()
+end subroutine
+
+! CHECK: func @_QMoptPallocatable_to_assumed_optional_array(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>{{.*}}) {
+subroutine allocatable_to_assumed_optional_array(x)
+  real, allocatable :: x(:)
+
+  ! CHECK: %[[xboxload:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+  ! CHECK: %[[xptr:.*]] = fir.box_addr %[[xboxload]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
+  ! CHECK: %[[xaddr:.*]] = fir.convert %[[xptr]] : (!fir.heap<!fir.array<?xf32>>) -> i64
+  ! CHECK: %[[isAlloc:.*]] = arith.cmpi ne, %[[xaddr]], %c0{{.*}} : i64
+  ! CHECK: %[[absent:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
+  ! CHECK: %[[embox:.*]] = fir.embox %{{.*}}
+  ! CHECK: %[[actual:.*]] = arith.select %[[isAlloc]], %[[embox]], %[[absent]] : !fir.box<!fir.array<?xf32>>
+  ! CHECK: fir.call @_QMoptPassumed_shape(%[[actual]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+  call assumed_shape(x)
+end subroutine
+
+! CHECK-LABEL: func @_QMoptPalloc_component_to_optional_assumed_shape(
+subroutine alloc_component_to_optional_assumed_shape(x)
+  type(t) :: x(100)
+  ! CHECK-DAG: %[[isAlloc:.*]] = arith.cmpi ne
+  ! CHECK-DAG: %[[absent:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
+  ! CHECK: %[[select:.*]] = arith.select %[[isAlloc]], %{{.*}}, %[[absent]] : !fir.box<!fir.array<?xf32>>
+  ! CHECK: fir.call @_QMoptPassumed_shape(%[[select]])
+  call assumed_shape(x(55)%p)
+end subroutine
+
+! CHECK-LABEL: func @_QMoptPalloc_component_eval_only_once(
+subroutine alloc_component_eval_only_once(x)
+  integer, external :: ifoo
+  type(t) :: x(100)
+  ! Verify that the index in the component reference are not evaluated twice
+  ! because if the optional handling logic.
+  ! CHECK: fir.call @_QPifoo()
+  ! CHECK-NOT: fir.call @_QPifoo()
+  call assumed_shape(x(ifoo())%p)
+end subroutine
+
+! CHECK-LABEL: func @_QMoptPnull_as_optional() {
+subroutine null_as_optional
+  ! CHECK: %[[temp:.*]] = fir.alloca !fir.llvm_ptr<none>
+  ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ref<none>
+  ! CHECK: fir.store %{{.*}} to %[[temp]] : !fir.ref<!fir.llvm_ptr<none>>
+  ! CHECK: fir.call @_QMoptPassumed_shape(%{{.*}}) : (!fir.box<!fir.array<?xf32>>) -> ()
+ call assumed_shape(null())
+end subroutine null_as_optional
+
+end module

flang/test/Lower/dummy-arguments.f90

+! RUN: bbc %s -o - | FileCheck %s
+
+! CHECK-LABEL: _QQmain
+program test1
+  ! CHECK-DAG: %[[TMP:.*]] = fir.alloca
+  ! CHECK-DAG: %[[TEN:.*]] = arith.constant
+  ! CHECK: fir.store %[[TEN]] to %[[TMP]]
+  ! CHECK-NEXT: fir.call @_QFPfoo
+  call foo(10)
+contains
+
+! CHECK-LABEL: func @_QFPfoo
+subroutine foo(avar1)
+  integer :: avar1
+!  integer :: my_data, my_data2
+!  DATA my_data / 150 /
+!  DATA my_data2 / 150 /
+!  print *, my_data, my_data2
+  print *, avar1
+end subroutine
+! CHECK: }
+end program test1
+
+! CHECK-LABEL: func @_QPsub2
+function sub2(r)
+  real :: r(20)
+  ! CHECK: %[[coor:.*]] = fir.coordinate_of %arg0
+  ! CHECK: = fir.call @_QPf(%[[coor]]) : (!fir.ref<f32>) -> f32
+  sub2 = f(r(1))
+  ! CHECK: return %{{.*}} : f32
+end function sub2
+
+! Test TARGET attribute lowering
+! CHECK-LABEL: func @_QPtest_target(
+! CHECK-SAME: !fir.ref<i32> {fir.bindc_name = "i", fir.target},
+! CHECK-SAME: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.target})
+subroutine test_target(i, x)
+  integer, target :: i
+  real, target :: x(:)
+  print *, xs, xa
+end subroutine