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

   1 ! Test passing pointer, allocatables, and optional assumed shapes to optional
   2 ! explicit shapes (see F2018 15.5.2.12).
   3 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
   4 module optional_tests
   5 implicit none
   6 interface
   7 subroutine takes_opt_scalar(i)
   8   integer, optional :: i
   9 end subroutine
  10 subroutine takes_opt_scalar_char(c)
  11   character(*), optional :: c
  12 end subroutine
  13 subroutine takes_opt_explicit_shape(x)
  14   real, optional :: x(100)
  15 end subroutine
  16 subroutine takes_opt_explicit_shape_intentout(x)
  17   real, optional, intent(out) :: x(100)
  18 end subroutine
  19 subroutine takes_opt_explicit_shape_intentin(x)
  20   real, optional, intent(in) :: x(100)
  21 end subroutine
  22 subroutine takes_opt_explicit_shape_char(c)
  23   character(*), optional :: c(100)
  24 end subroutine
  25 function returns_pointer()
  26   real, pointer :: returns_pointer(:)
  27 end function
  28 end interface
  29 contains
  30
  31 ! -----------------------------------------------------------------------------
  32 !     Test passing scalar pointers and allocatables to an optional
  33 ! -----------------------------------------------------------------------------
  34 ! Here, nothing optional specific is expected, the address is passed, and its
  35 ! allocation/association status match the dummy presence status.
  36
  37 ! CHECK-LABEL: func @_QMoptional_testsPpass_pointer_scalar(
  38 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<i32>>>{{.*}}) {
  39 subroutine pass_pointer_scalar(i)
  40   integer, pointer :: i
  41   call takes_opt_scalar(i)
  42 ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
  43 ! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<i32>>) -> !fir.ptr<i32>
  44 ! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<i32>) -> !fir.ref<i32>
  45 ! CHECK:         fir.call @_QPtakes_opt_scalar(%[[VAL_3]]) {{.*}}: (!fir.ref<i32>) -> ()
  46 end subroutine
  47
  48 ! CHECK-LABEL: func @_QMoptional_testsPpass_allocatable_scalar(
  49 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<i32>>>{{.*}}) {
  50 subroutine pass_allocatable_scalar(i)
  51   integer, allocatable :: i
  52   call takes_opt_scalar(i)
  53 ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<i32>>>
  54 ! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.heap<i32>>) -> !fir.heap<i32>
  55 ! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.heap<i32>) -> !fir.ref<i32>
  56 ! CHECK:         fir.call @_QPtakes_opt_scalar(%[[VAL_3]]) {{.*}}: (!fir.ref<i32>) -> ()
  57 end subroutine
  58
  59 ! CHECK-LABEL: func @_QMoptional_testsPpass_pointer_scalar_char(
  60 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>{{.*}}) {
  61 subroutine pass_pointer_scalar_char(c)
  62   character(:), pointer :: c
  63   call takes_opt_scalar_char(c)
  64 ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
  65 ! CHECK:         %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> index
  66 ! CHECK:         %[[VAL_3:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.ptr<!fir.char<1,?>>
  67 ! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ptr<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,?>>
  68 ! CHECK:         %[[VAL_5:.*]] = fir.emboxchar %[[VAL_4]], %[[VAL_2]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
  69 ! CHECK:         fir.call @_QPtakes_opt_scalar_char(%[[VAL_5]]) {{.*}}: (!fir.boxchar<1>) -> ()
  70 end subroutine
  71
  72 ! CHECK-LABEL: func @_QMoptional_testsPpass_allocatable_scalar_char(
  73 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>{{.*}}) {
  74 subroutine pass_allocatable_scalar_char(c)
  75   character(:), allocatable :: c
  76   call takes_opt_scalar_char(c)
  77 ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
  78 ! CHECK:         %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> index
  79 ! CHECK:         %[[VAL_3:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
  80 ! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.heap<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,?>>
  81 ! CHECK:         %[[VAL_5:.*]] = fir.emboxchar %[[VAL_4]], %[[VAL_2]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
  82 ! CHECK:         fir.call @_QPtakes_opt_scalar_char(%[[VAL_5]]) {{.*}}: (!fir.boxchar<1>) -> ()
  83 end subroutine
  84
  85 ! -----------------------------------------------------------------------------
  86 !     Test passing non contiguous pointers to explicit shape optional
  87 ! -----------------------------------------------------------------------------
  88 ! The pointer descriptor can be unconditionally read, but the copy-in/copy-out
  89 ! must be conditional on the pointer association status in order to get the
  90 ! correct present/absent aspect.
  91
  92 ! CHECK-LABEL: func @_QMoptional_testsPpass_pointer_array(
  93 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}) {
  94 subroutine pass_pointer_array(i)
  95   real, pointer :: i(:)
  96   call takes_opt_explicit_shape(i)
  97 ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
  98 ! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
  99 ! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
 100 ! CHECK:         %[[VAL_4:.*]] = arith.constant 0 : i64
 101 ! CHECK:         %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64
 102 ! CHECK:         %[[box:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
 103 ! CHECK:         %[[VAL_7:.*]] = arith.constant 0 : index
 104 ! CHECK:         %[[box_none:.*]] = fir.convert %[[box]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
 105 ! CHECK:         %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) {{.*}}: (!fir.box<none>) -> i1
 106 ! CHECK:         %[[VAL_9:.*]] = fir.if %[[VAL_5]] -> (!fir.heap<!fir.array<?xf32>>) {
 107 ! CHECK:           %[[addr:.*]] = fir.if %[[is_contiguous]] -> (!fir.heap<!fir.array<?xf32>>) {
 108 ! CHECK:             %[[box_addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
 109 ! CHECK:             fir.result %[[box_addr]] : !fir.heap<!fir.array<?xf32>>
 110 ! CHECK:           } else {
 111 ! CHECK:           %[[VAL_10:.*]] = arith.constant 0 : index
 112 ! CHECK:           %[[VAL_11:.*]]:3 = fir.box_dims %[[box]], %[[VAL_10]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
 113 ! CHECK:           %[[VAL_12:.*]] = fir.allocmem !fir.array<?xf32>, %[[VAL_11]]#1 {uniq_name = ".copyinout"}
 114 ! CHECK:           fir.call @_FortranAAssign
 115 ! CHECK:           fir.result %[[VAL_12]] : !fir.heap<!fir.array<?xf32>>
 116 ! CHECK:         } else {
 117 ! CHECK:           %[[VAL_26:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
 118 ! CHECK:           fir.result %[[VAL_26]] : !fir.heap<!fir.array<?xf32>>
 119 ! CHECK:         }
 120 ! CHECK:         %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1
 121 ! CHECK:         %[[and:.*]] = arith.andi %[[VAL_5]], %[[not_contiguous]] : i1
 122 ! CHECK:         %[[VAL_29:.*]] = fir.convert %[[VAL_9]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
 123 ! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_29]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
 124 ! CHECK:         fir.if %[[and]] {
 125 ! CHECK:           fir.call @_FortranAAssign
 126 ! CHECK:           fir.freemem %[[VAL_9]] : !fir.heap<!fir.array<?xf32>>
 127 ! CHECK:         }
 128 end subroutine
 129
 130 ! CHECK-LABEL: func @_QMoptional_testsPpass_pointer_array_char(
 131 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>{{.*}}) {
 132 subroutine pass_pointer_array_char(c)
 133   character(:), pointer :: c(:)
 134   call takes_opt_explicit_shape_char(c)
 135 ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
 136 ! 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,?>>>
 137 ! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?x!fir.char<1,?>>>) -> i64
 138 ! CHECK:         %[[VAL_4:.*]] = arith.constant 0 : i64
 139 ! CHECK:         %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64
 140 ! CHECK:         %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
 141 ! CHECK:         %[[box_none:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> !fir.box<none>
 142 ! CHECK:         %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) {{.*}}: (!fir.box<none>) -> i1
 143 ! CHECK:         %[[VAL_9:.*]] = fir.if %[[VAL_5]] -> (!fir.heap<!fir.array<?x!fir.char<1,?>>>) {
 144 ! CHECK:           %[[VAL_10:.*]] = arith.constant 0 : index
 145 ! 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)
 146 ! CHECK:           %[[VAL_12:.*]] = fir.box_elesize %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> index
 147 ! CHECK:           %[[VAL_13:.*]] = fir.allocmem !fir.array<?x!fir.char<1,?>>(%[[VAL_12]] : index), %[[VAL_11]]#1 {uniq_name = ".copyinout"}
 148 ! CHECK:           fir.call @_FortranAAssign
 149 ! CHECK:           fir.result %[[VAL_13]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
 150 ! CHECK:         } else {
 151 ! CHECK:           %[[VAL_46:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.char<1,?>>>
 152 ! CHECK:           fir.result %[[VAL_46]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
 153 ! CHECK:         }
 154 ! CHECK:         %[[VAL_47:.*]] = fir.box_elesize %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> index
 155 ! CHECK:         %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1
 156 ! CHECK:         %[[and:.*]] = arith.andi %[[VAL_5]], %[[not_contiguous]] : i1
 157 ! CHECK:         %[[VAL_50:.*]] = fir.convert %[[VAL_9]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>
 158 ! CHECK:         %[[VAL_52:.*]] = fir.emboxchar %[[VAL_50]], %[[VAL_47]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
 159 ! CHECK:         fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_52]]) {{.*}}: (!fir.boxchar<1>) -> ()
 160 ! CHECK:         fir.if %[[and]] {
 161 ! CHECK:           fir.call @_FortranAAssign
 162 ! CHECK:           fir.freemem %[[VAL_9]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
 163 ! CHECK:         }
 164 ! CHECK:         return
 165 ! CHECK:       }
 166 end subroutine
 167
 168 ! This case is bit special because the pointer is not a symbol but a function
 169 ! result. Test that the copy-in/copy-out is the same as with normal pointers.
 170
 171 ! CHECK-LABEL: func @_QMoptional_testsPforward_pointer_array() {
 172 subroutine forward_pointer_array()
 173   call takes_opt_explicit_shape(returns_pointer())
 174 ! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = ".result"}
 175 ! CHECK:         %[[VAL_1:.*]] = fir.call @_QPreturns_pointer() {{.*}}: () -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
 176 ! 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>>>>
 177 ! CHECK:         %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
 178 ! CHECK:         %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
 179 ! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
 180 ! CHECK:         %[[VAL_5:.*]] = arith.constant 0 : i64
 181 ! CHECK:         %[[VAL_6:.*]] = arith.cmpi ne, %[[VAL_4]], %[[VAL_5]] : i64
 182 ! CHECK:         %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%{{.*}}) {{.*}}: (!fir.box<none>) -> i1
 183 ! CHECK:         %[[VAL_7:.*]] = fir.if %[[VAL_6]] -> (!fir.heap<!fir.array<?xf32>>) {
 184 ! CHECK:           %[[VAL_10:.*]] = fir.allocmem !fir.array<?xf32>
 185 ! CHECK:           fir.call @_FortranAAssign
 186 ! CHECK:           fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>
 187 ! CHECK:         } else {
 188 ! CHECK:           %[[VAL_11:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
 189 ! CHECK:           fir.result %[[VAL_11]] : !fir.heap<!fir.array<?xf32>>
 190 ! CHECK:         }
 191 ! CHECK:         %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1
 192 ! CHECK:         %[[and:.*]] = arith.andi %[[VAL_6]], %[[not_contiguous]] : i1
 193 ! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
 194 ! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_14]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
 195 ! CHECK:         fir.if %[[and]] {
 196 ! CHECK:           fir.call @_FortranAAssign
 197 ! CHECK:           fir.freemem %[[VAL_7]] : !fir.heap<!fir.array<?xf32>>
 198 ! CHECK:         }
 199 end subroutine
 200
 201 ! -----------------------------------------------------------------------------
 202 !    Test passing assumed shape optional to explicit shape optional
 203 ! -----------------------------------------------------------------------------
 204 ! The fix.box can only be read if the assumed shape is present,
 205 ! and the copy-in/copy-out must also be conditional on the assumed
 206 ! shape presence.
 207
 208 ! CHECK-LABEL: func @_QMoptional_testsPpass_opt_assumed_shape(
 209 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
 210 subroutine pass_opt_assumed_shape(x)
 211   real, optional :: x(:)
 212   call takes_opt_explicit_shape(x)
 213 ! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1
 214 ! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>
 215 ! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
 216 ! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
 217 ! CHECK:         %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
 218 ! CHECK:         %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>
 219 ! CHECK:         %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%{{.*}}) {{.*}}: (!fir.box<none>) -> i1
 220 ! CHECK:         %[[VAL_7:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?xf32>>) {
 221 ! CHECK:           %[[VAL_8:.*]] = arith.constant 0 : index
 222 ! CHECK:           %[[VAL_9:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_8]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
 223 ! CHECK:           %[[VAL_10:.*]] = fir.allocmem !fir.array<?xf32>, %[[VAL_9]]#1 {uniq_name = ".copyinout"}
 224 ! CHECK:           fir.call @_FortranAAssign
 225 ! CHECK:           fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>
 226 ! CHECK:         } else {
 227 ! CHECK:           %[[VAL_23:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
 228 ! CHECK:           fir.result %[[VAL_23]] : !fir.heap<!fir.array<?xf32>>
 229 ! CHECK:         }
 230 ! CHECK:         %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1
 231 ! CHECK:         %[[and:.*]] = arith.andi %[[VAL_1]], %[[not_contiguous]] : i1
 232 ! CHECK:         %[[VAL_26:.*]] = fir.convert %[[VAL_27:.*]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
 233 ! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_26]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
 234 ! CHECK:         fir.if %[[and]] {
 235 ! CHECK:           fir.call @_FortranAAssign
 236 ! CHECK:           fir.freemem %[[VAL_27]] : !fir.heap<!fir.array<?xf32>>
 237 ! CHECK:         }
 238 end subroutine
 239
 240 ! CHECK-LABEL: func @_QMoptional_testsPpass_opt_assumed_shape_char(
 241 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "c", fir.optional}) {
 242 subroutine pass_opt_assumed_shape_char(c)
 243   character(*), optional :: c(:)
 244   call takes_opt_explicit_shape_char(c)
 245 ! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> i1
 246 ! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?x!fir.char<1,?>>>
 247 ! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
 248 ! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
 249 ! CHECK:         %[[VAL_5:.*]] = arith.constant 0 : index
 250 ! 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,?>>>
 251 ! CHECK:         %[[VAL_7:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_6]] : !fir.box<!fir.array<?x!fir.char<1,?>>>
 252 ! CHECK:         %[[box_none:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.box<none>
 253 ! CHECK:         %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) {{.*}}: (!fir.box<none>) -> i1
 254 ! CHECK:         %[[VAL_8:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?x!fir.char<1,?>>>) {
 255 ! CHECK:         %[[addr:.*]] = fir.if %[[is_contiguous]] -> (!fir.heap<!fir.array<?x!fir.char<1,?>>>) {
 256 ! CHECK:           %[[res:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.heap<!fir.array<?x!fir.char<1,?>>>
 257 ! CHECK:           fir.result %[[res]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
 258 ! CHECK:         } else {
 259 ! CHECK:           %[[box_elesize:.*]] = fir.box_elesize %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
 260 ! CHECK:           %[[temp:.*]] = fir.allocmem !fir.array<?x!fir.char<1,?>>(%[[box_elesize]] : index), %{{.*}}#1 {uniq_name = ".copyinout"}
 261 ! CHECK:           fir.call @_FortranAAssign
 262 ! CHECK:           fir.result %[[VAL_12]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
 263 ! CHECK:         } else {
 264 ! CHECK:           %[[VAL_44:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.char<1,?>>>
 265 ! CHECK:           fir.result %[[VAL_44]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
 266 ! CHECK:         }
 267 ! CHECK:         %[[VAL_45:.*]] = fir.box_elesize %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
 268 ! CHECK:         %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1
 269 ! CHECK:         %[[and:.*]] = arith.andi %[[VAL_1]], %[[not_contiguous]] : i1
 270 ! CHECK:         %[[VAL_48:.*]] = fir.convert %[[VAL_49:.*]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>
 271 ! CHECK:         %[[VAL_50:.*]] = fir.emboxchar %[[VAL_48]], %[[VAL_45]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
 272 ! CHECK:         fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_50]]) {{.*}}: (!fir.boxchar<1>) -> ()
 273 ! CHECK:         fir.if %[[and]] {
 274 ! CHECK:           fir.call @_FortranAAssign
 275 ! CHECK:           fir.freemem %[[VAL_49]] : !fir.heap<!fir.array<?x!fir.char<1,?>>>
 276 ! CHECK:         }
 277 end subroutine
 278
 279 ! -----------------------------------------------------------------------------
 280 !    Test passing contiguous optional assumed shape to explicit shape optional
 281 ! -----------------------------------------------------------------------------
 282 ! The fix.box can only be read if the assumed shape is present.
 283 ! There should be no copy-in/copy-out
 284
 285 ! CHECK-LABEL: func @_QMoptional_testsPpass_opt_contiguous_assumed_shape(
 286 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous, fir.optional}) {
 287 subroutine pass_opt_contiguous_assumed_shape(x)
 288   real, optional, contiguous :: x(:)
 289   call takes_opt_explicit_shape(x)
 290 ! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1
 291 ! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>
 292 ! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
 293 ! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
 294 ! CHECK:         %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
 295 ! CHECK:         %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>
 296 ! CHECK:         %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
 297 ! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.ref<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
 298 ! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_8]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
 299 end subroutine
 300
 301 ! CHECK-LABEL: func @_QMoptional_testsPpass_opt_contiguous_assumed_shape_char(
 302 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "c", fir.contiguous, fir.optional}) {
 303 subroutine pass_opt_contiguous_assumed_shape_char(c)
 304   character(*), optional, contiguous :: c(:)
 305   call takes_opt_explicit_shape_char(c)
 306 ! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> i1
 307 ! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?x!fir.char<1,?>>>
 308 ! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
 309 ! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
 310 ! CHECK:         %[[VAL_5:.*]] = arith.constant 0 : index
 311 ! 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,?>>>
 312 ! CHECK:         %[[VAL_7:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_6]] : !fir.box<!fir.array<?x!fir.char<1,?>>>
 313 ! CHECK:         %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>>
 314 ! CHECK:         %[[VAL_9:.*]] = fir.box_elesize %[[VAL_7]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
 315 ! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_8]] : (!fir.ref<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>
 316 ! CHECK:         %[[VAL_11:.*]] = fir.emboxchar %[[VAL_10]], %[[VAL_9]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
 317 ! CHECK:         fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_11]]) {{.*}}: (!fir.boxchar<1>) -> ()
 318 end subroutine
 319
 320 ! -----------------------------------------------------------------------------
 321 !    Test passing allocatables and contiguous pointers to explicit shape optional
 322 ! -----------------------------------------------------------------------------
 323 ! The fix.box can be read and its address directly passed. There should be no
 324 ! copy-in/copy-out.
 325
 326 ! CHECK-LABEL: func @_QMoptional_testsPpass_allocatable_array(
 327 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>{{.*}}) {
 328 subroutine pass_allocatable_array(i)
 329   real, allocatable :: i(:)
 330   call takes_opt_explicit_shape(i)
 331 ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
 332 ! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
 333 ! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
 334 ! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_3]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
 335 end subroutine
 336
 337 ! CHECK-LABEL: func @_QMoptional_testsPpass_allocatable_array_char(
 338 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>{{.*}}) {
 339 subroutine pass_allocatable_array_char(c)
 340   character(:), allocatable :: c(:)
 341   call takes_opt_explicit_shape_char(c)
 342 ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
 343 ! CHECK:         %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> index
 344 ! 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,?>>>
 345 ! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.heap<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>
 346 ! CHECK:         %[[VAL_5:.*]] = fir.emboxchar %[[VAL_4]], %[[VAL_2]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
 347 ! CHECK:         fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_5]]) {{.*}}: (!fir.boxchar<1>) -> ()
 348 end subroutine
 349
 350 ! CHECK-LABEL: func @_QMoptional_testsPpass_contiguous_pointer_array(
 351 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "i", fir.contiguous}) {
 352 subroutine pass_contiguous_pointer_array(i)
 353   real, pointer, contiguous :: i(:)
 354   call takes_opt_explicit_shape(i)
 355 ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
 356 ! CHECK:         %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
 357 ! CHECK:         %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
 358 ! CHECK:         fir.call @_QPtakes_opt_explicit_shape(%[[VAL_3]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
 359 end subroutine
 360
 361 ! CHECK-LABEL: func @_QMoptional_testsPpass_contiguous_pointer_array_char(
 362 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>> {fir.bindc_name = "c", fir.contiguous}) {
 363 subroutine pass_contiguous_pointer_array_char(c)
 364   character(:), pointer, contiguous :: c(:)
 365   call takes_opt_explicit_shape_char(c)
 366 ! CHECK:         %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
 367 ! CHECK:         %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>) -> index
 368 ! 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,?>>>
 369 ! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ptr<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>
 370 ! CHECK:         %[[VAL_5:.*]] = fir.emboxchar %[[VAL_4]], %[[VAL_2]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
 371 ! CHECK:         fir.call @_QPtakes_opt_explicit_shape_char(%[[VAL_5]]) {{.*}}: (!fir.boxchar<1>) -> ()
 372 end subroutine
 373
 374 ! -----------------------------------------------------------------------------
 375 !    Test passing assumed shape optional to explicit shape optional with intents
 376 ! -----------------------------------------------------------------------------
 377 ! The fix.box can only be read if the assumed shape is present,
 378 ! and the copy-in/copy-out must also be conditional on the assumed
 379 ! shape presence. For intent(in), there should be no copy-out while for
 380 ! intent(out), there should be no copy-in.
 381
 382 ! CHECK-LABEL: func @_QMoptional_testsPpass_opt_assumed_shape_to_intentin(
 383 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
 384 subroutine pass_opt_assumed_shape_to_intentin(x)
 385   real, optional :: x(:)
 386   call takes_opt_explicit_shape_intentin(x)
 387 ! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1
 388 ! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>
 389 ! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
 390 ! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
 391 ! CHECK:         %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
 392 ! CHECK:         %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>
 393 ! CHECK:         %[[box_none:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
 394 ! CHECK:         %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) {{.*}}: (!fir.box<none>) -> i1
 395 ! CHECK:         %[[VAL_7:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?xf32>>) {
 396 ! CHECK:           %[[VAL_10:.*]] = fir.allocmem !fir.array<?xf32>
 397 ! CHECK:           fir.call @_FortranAAssign
 398 ! CHECK:           fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>
 399 ! CHECK:         } else {
 400 ! CHECK:           %[[VAL_23:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
 401 ! CHECK:           fir.result %[[VAL_23]] : !fir.heap<!fir.array<?xf32>>
 402 ! CHECK:         }
 403 ! CHECK:         %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1
 404 ! CHECK:         %[[and:.*]] = arith.andi %[[VAL_1]], %[[not_contiguous]] : i1
 405 ! CHECK:         %[[VAL_24:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
 406 ! CHECK:         fir.call @_QPtakes_opt_explicit_shape_intentin(%[[VAL_24]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
 407 ! CHECK:         fir.if %[[and]] {
 408 ! CHECK-NOT:       fir.call @_FortranAAssign
 409 ! CHECK:           fir.freemem %[[VAL_7]] : !fir.heap<!fir.array<?xf32>>
 410 ! CHECK:         }
 411 end subroutine
 412
 413 ! CHECK-LABEL: func @_QMoptional_testsPpass_opt_assumed_shape_to_intentout(
 414 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
 415 subroutine pass_opt_assumed_shape_to_intentout(x)
 416   real, optional :: x(:)
 417   call takes_opt_explicit_shape_intentout(x)
 418 ! CHECK:         %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1
 419 ! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>
 420 ! CHECK:         %[[VAL_3:.*]] = arith.constant 0 : index
 421 ! CHECK:         %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
 422 ! CHECK:         %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
 423 ! CHECK:         %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>
 424 ! CHECK:         %[[box_none:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
 425 ! CHECK:         %[[is_contiguous:.*]] = fir.call @_FortranAIsContiguous(%[[box_none]]) {{.*}}: (!fir.box<none>) -> i1
 426 ! CHECK:         %[[VAL_7:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?xf32>>) {
 427 ! CHECK:           %[[VAL_10:.*]] = fir.allocmem !fir.array<?xf32>
 428 ! CHECK-NOT:       fir.call @_FortranAAssign
 429 ! CHECK:           fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>
 430 ! CHECK:         } else {
 431 ! CHECK:           %[[VAL_11:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
 432 ! CHECK:           fir.result %[[VAL_11]] : !fir.heap<!fir.array<?xf32>>
 433 ! CHECK:         }
 434 ! CHECK:         %[[not_contiguous:.*]] = arith.cmpi eq, %[[is_contiguous]], %false : i1
 435 ! CHECK:         %[[and:.*]] = arith.andi %[[VAL_1]], %[[not_contiguous]] : i1
 436 ! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<100xf32>>
 437 ! CHECK:         fir.call @_QPtakes_opt_explicit_shape_intentout(%[[VAL_14]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()
 438 ! CHECK:         fir.if %[[and]] {
 439 ! CHECK:           fir.call @_FortranAAssign
 440 ! CHECK:           fir.freemem %[[VAL_7]] : !fir.heap<!fir.array<?xf32>>
 441 ! CHECK:         }
 442 end subroutine
 443 end module