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

   1 ! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s
   2 module tests
   3 interface
   4   subroutine takes_contiguous(a)
   5     real, contiguous :: a(:)
   6   end subroutine
   7   subroutine takes_contiguous_optional(a)
   8     real, contiguous, optional :: a(:)
   9   end subroutine
  10 end interface
  11
  12 contains
  13
  14 ! -----------------------------------------------------------------------------
  15 !     Test passing assumed shapes to contiguous assumed shapes
  16 ! -----------------------------------------------------------------------------
  17 ! Base case.
  18
  19 subroutine test_assumed_shape_to_contiguous(x)
  20   real :: x(:)
  21   call takes_contiguous(x)
  22 end subroutine
  23 ! CHECK-LABEL: func.func @_QMtestsPtest_assumed_shape_to_contiguous(
  24 ! CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) {
  25 ! CHECK:  %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
  26 ! CHECK:  %[[VAL_2:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_1]]) {{.*}}: (!fir.box<none>) -> i1
  27 ! CHECK:  %[[VAL_3:.*]] = fir.if %[[VAL_2]] -> (!fir.heap<!fir.array<?xf32>>) {
  28 ! CHECK:    %[[VAL_4:.*]] = fir.box_addr %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.heap<!fir.array<?xf32>>
  29 ! CHECK:    fir.result %[[VAL_4]] : !fir.heap<!fir.array<?xf32>>
  30 ! CHECK:  } else {
  31 ! CHECK:    %[[VAL_7:.*]] = fir.allocmem !fir.array<?xf32>
  32 ! CHECK:    fir.call @_FortranAAssign
  33 ! CHECK:    fir.result %[[VAL_7]] : !fir.heap<!fir.array<?xf32>>
  34 ! CHECK:  }
  35 ! CHECK:  %[[VAL_20:.*]] = arith.constant 0 : index
  36 ! CHECK:  %[[VAL_21:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_20]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
  37 ! CHECK:  %[[VAL_22:.*]] = arith.constant false
  38 ! CHECK:  %[[VAL_23:.*]] = arith.cmpi eq, %[[VAL_2]], %[[VAL_22]] : i1
  39 ! CHECK:  %[[VAL_24:.*]] = fir.shape %[[VAL_21]]#1 : (index) -> !fir.shape<1>
  40 ! CHECK:  %[[VAL_25:.*]] = fir.embox %[[VAL_3]](%[[VAL_24]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
  41 ! CHECK:  fir.call @_QPtakes_contiguous(%[[VAL_25]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
  42 ! CHECK:  fir.if %[[VAL_23]] {
  43 ! CHECK:    fir.call @_FortranACopyOutAssign
  44 ! CHECK:  }
  45 ! CHECK:  return
  46 ! CHECK:}
  47
  48 subroutine test_assumed_shape_contiguous_to_contiguous(x)
  49   real, contiguous :: x(:)
  50   call takes_contiguous(x)
  51 end subroutine
  52 ! CHECK-LABEL: func.func @_QMtestsPtest_assumed_shape_contiguous_to_contiguous(
  53 ! CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous}) {
  54 ! CHECK:  %[[VAL_1:.*]] = fir.box_addr %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
  55 ! CHECK:  %[[VAL_2:.*]] = arith.constant 0 : index
  56 ! CHECK:  %[[VAL_3:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_2]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
  57 ! CHECK:  %[[VAL_4:.*]] = arith.constant 1 : index
  58 ! CHECK:  %[[VAL_5:.*]] = fir.shape_shift %[[VAL_4]], %[[VAL_3]]#1 : (index, index) -> !fir.shapeshift<1>
  59 ! CHECK:  %[[VAL_6:.*]] = fir.embox %[[VAL_1]](%[[VAL_5]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xf32>>
  60 ! CHECK:  fir.call @_QPtakes_contiguous(%[[VAL_6]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
  61 ! CHECK-NEXT:  return
  62
  63 subroutine test_assumed_shape_opt_to_contiguous(x)
  64   real, optional :: x(:)
  65   call takes_contiguous(x)
  66 end subroutine
  67 ! CHECK-LABEL: func.func @_QMtestsPtest_assumed_shape_opt_to_contiguous(
  68 ! CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
  69 ! CHECK:  %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
  70 ! CHECK:  %[[VAL_2:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_1]]) {{.*}}: (!fir.box<none>) -> i1
  71 ! CHECK:  %[[VAL_3:.*]] = fir.if %[[VAL_2]] -> (!fir.heap<!fir.array<?xf32>>) {
  72 ! CHECK:    %[[VAL_4:.*]] = fir.box_addr %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.heap<!fir.array<?xf32>>
  73 ! CHECK:    fir.result %[[VAL_4]] : !fir.heap<!fir.array<?xf32>>
  74 ! CHECK:  } else {
  75 ! CHECK:    %[[VAL_7:.*]] = fir.allocmem !fir.array<?xf32>
  76 ! CHECK:    fir.call @_FortranAAssign
  77 ! CHECK:    fir.result %[[VAL_7]] : !fir.heap<!fir.array<?xf32>>
  78 ! CHECK:  }
  79 ! CHECK:  %[[VAL_20:.*]] = arith.constant 0 : index
  80 ! CHECK:  %[[VAL_21:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_20]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
  81 ! CHECK:  %[[VAL_22:.*]] = arith.constant false
  82 ! CHECK:  %[[VAL_23:.*]] = arith.cmpi eq, %[[VAL_2]], %[[VAL_22]] : i1
  83 ! CHECK:  %[[VAL_24:.*]] = fir.shape %[[VAL_21]]#1 : (index) -> !fir.shape<1>
  84 ! CHECK:  %[[VAL_25:.*]] = fir.embox %[[VAL_3]](%[[VAL_24]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
  85 ! CHECK:  fir.call @_QPtakes_contiguous(%[[VAL_25]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
  86 ! CHECK:  fir.if %[[VAL_23]] {
  87 ! CHECK:    fir.call @_FortranACopyOutAssign
  88 ! CHECK:  }
  89 ! CHECK:  return
  90 ! CHECK:}
  91
  92 subroutine test_assumed_shape_contiguous_opt_to_contiguous(x)
  93   real, optional, contiguous :: x(:)
  94   call takes_contiguous(x)
  95 end subroutine
  96 ! CHECK-LABEL: func.func @_QMtestsPtest_assumed_shape_contiguous_opt_to_contiguous(
  97 ! CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous, fir.optional}) {
  98 ! CHECK:  fir.call @_QPtakes_contiguous(%[[VAL_0]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
  99 ! CHECK-NEXT:  return
 100
 101
 102 ! -----------------------------------------------------------------------------
 103 !     Test passing assumed shapes to contiguous optional assumed shapes
 104 ! -----------------------------------------------------------------------------
 105 ! The copy-in/out must take into account the actual argument presence (which may
 106 ! not be known until runtime).
 107
 108 subroutine test_assumed_shape_to_contiguous_opt(x)
 109   real :: x(:)
 110   call takes_contiguous_optional(x)
 111 end subroutine
 112 ! CHECK-LABEL: func.func @_QMtestsPtest_assumed_shape_to_contiguous_opt(
 113 ! CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) {
 114 ! CHECK:  %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
 115 ! CHECK:  %[[VAL_2:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_1]]) {{.*}}: (!fir.box<none>) -> i1
 116 ! CHECK:  %[[VAL_3:.*]] = fir.if %[[VAL_2]] -> (!fir.heap<!fir.array<?xf32>>) {
 117 ! CHECK:    %[[VAL_4:.*]] = fir.box_addr %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.heap<!fir.array<?xf32>>
 118 ! CHECK:    fir.result %[[VAL_4]] : !fir.heap<!fir.array<?xf32>>
 119 ! CHECK:  } else {
 120 ! CHECK:    %[[VAL_7:.*]] = fir.allocmem !fir.array<?xf32>
 121 ! CHECK:    fir.call @_FortranAAssign
 122 ! CHECK:    fir.result %[[VAL_7]] : !fir.heap<!fir.array<?xf32>>
 123 ! CHECK:  }
 124 ! CHECK:  %[[VAL_20:.*]] = arith.constant 0 : index
 125 ! CHECK:  %[[VAL_21:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_20]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
 126 ! CHECK:  %[[VAL_22:.*]] = arith.constant false
 127 ! CHECK:  %[[VAL_23:.*]] = arith.cmpi eq, %[[VAL_2]], %[[VAL_22]] : i1
 128 ! CHECK:  %[[VAL_24:.*]] = fir.shape %[[VAL_21]]#1 : (index) -> !fir.shape<1>
 129 ! CHECK:  %[[VAL_25:.*]] = fir.embox %[[VAL_3]](%[[VAL_24]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
 130 ! CHECK:  fir.call @_QPtakes_contiguous_optional(%[[VAL_25]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
 131 ! CHECK:  fir.if %[[VAL_23]] {
 132 ! CHECK:    fir.call @_FortranACopyOutAssign
 133 ! CHECK:  }
 134 ! CHECK:  return
 135 ! CHECK:}
 136
 137 subroutine test_assumed_shape_contiguous_to_contiguous_opt(x)
 138   real, contiguous :: x(:)
 139   call takes_contiguous_optional(x)
 140 end subroutine
 141 ! CHECK-LABEL: func.func @_QMtestsPtest_assumed_shape_contiguous_to_contiguous_opt(
 142 ! CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous}) {
 143 ! CHECK:  %[[VAL_1:.*]] = fir.box_addr %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
 144 ! CHECK:  %[[VAL_2:.*]] = arith.constant 0 : index
 145 ! CHECK:  %[[VAL_3:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_2]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
 146 ! CHECK:  %[[VAL_4:.*]] = arith.constant 1 : index
 147 ! CHECK:  %[[VAL_5:.*]] = fir.shape_shift %[[VAL_4]], %[[VAL_3]]#1 : (index, index) -> !fir.shapeshift<1>
 148 ! CHECK:  %[[VAL_6:.*]] = fir.embox %[[VAL_1]](%[[VAL_5]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xf32>>
 149 ! CHECK:  fir.call @_QPtakes_contiguous_optional(%[[VAL_6]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
 150 ! CHECK-NEXT:  return
 151
 152 subroutine test_assumed_shape_opt_to_contiguous_opt(x)
 153   real, optional :: x(:)
 154   call takes_contiguous_optional(x)
 155 end subroutine
 156 ! CHECK-LABEL: func.func @_QMtestsPtest_assumed_shape_opt_to_contiguous_opt(
 157 ! CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
 158 ! CHECK:  %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.box<!fir.array<?xf32>>) -> i1
 159 ! CHECK:  %[[VAL_2:.*]] = fir.zero_bits !fir.ref<!fir.array<?xf32>>
 160 ! CHECK:  %[[VAL_3:.*]] = arith.constant 0 : index
 161 ! CHECK:  %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
 162 ! CHECK:  %[[VAL_5:.*]] = fir.embox %[[VAL_2]](%[[VAL_4]]) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
 163 ! CHECK:  %[[VAL_6:.*]] = arith.select %[[VAL_1]], %[[VAL_0]], %[[VAL_5]] : !fir.box<!fir.array<?xf32>>
 164 ! CHECK:  %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
 165 ! CHECK:  %[[VAL_8:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_7]]) {{.*}}: (!fir.box<none>) -> i1
 166 ! CHECK:  %[[VAL_9:.*]] = fir.if %[[VAL_1]] -> (!fir.heap<!fir.array<?xf32>>) {
 167 ! CHECK:    %[[VAL_10:.*]] = fir.if %[[VAL_8]] -> (!fir.heap<!fir.array<?xf32>>) {
 168 ! CHECK:      %[[VAL_11:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.array<?xf32>>) -> !fir.heap<!fir.array<?xf32>>
 169 ! CHECK:      fir.result %[[VAL_11]] : !fir.heap<!fir.array<?xf32>>
 170 ! CHECK:    } else {
 171 ! CHECK:      %[[VAL_14:.*]] = fir.allocmem !fir.array<?xf32>
 172 ! CHECK:      fir.call @_FortranAAssign
 173 ! CHECK:      fir.result %[[VAL_14]] : !fir.heap<!fir.array<?xf32>>
 174 ! CHECK:    }
 175 ! CHECK:    fir.result %[[VAL_10]] : !fir.heap<!fir.array<?xf32>>
 176 ! CHECK:  } else {
 177 ! CHECK:    %[[VAL_28:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
 178 ! CHECK:    fir.result %[[VAL_28]] : !fir.heap<!fir.array<?xf32>>
 179 ! CHECK:  }
 180 ! CHECK:  %[[VAL_29:.*]] = arith.constant 0 : index
 181 ! CHECK:  %[[VAL_30:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_29]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
 182 ! CHECK:  %[[VAL_31:.*]] = arith.constant false
 183 ! CHECK:  %[[VAL_32:.*]] = arith.cmpi eq, %[[VAL_8]], %[[VAL_31]] : i1
 184 ! CHECK:  %[[VAL_33:.*]] = arith.andi %[[VAL_1]], %[[VAL_32]] : i1
 185 ! CHECK:  %[[VAL_34:.*]] = fir.shape %[[VAL_30]]#1 : (index) -> !fir.shape<1>
 186 ! CHECK:  %[[VAL_35:.*]] = fir.embox %[[VAL_9]](%[[VAL_34]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
 187 ! CHECK:  %[[VAL_37:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
 188 ! CHECK:  %[[VAL_38:.*]] = arith.select %[[VAL_1]], %[[VAL_35]], %[[VAL_37]] : !fir.box<!fir.array<?xf32>>
 189 ! CHECK:  fir.call @_QPtakes_contiguous_optional(%[[VAL_38]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
 190 ! CHECK:  fir.if %[[VAL_33]] {
 191 ! CHECK:    fir.call @_FortranACopyOutAssign
 192 ! CHECK:  }
 193 ! CHECK:  return
 194 ! CHECK:}
 195
 196 subroutine test_assumed_shape_contiguous_opt_to_contiguous_opt(x)
 197   real, contiguous, optional :: x(:)
 198   call takes_contiguous_optional(x)
 199 end subroutine
 200 ! CHECK-LABEL: func.func @_QMtestsPtest_assumed_shape_contiguous_opt_to_contiguous_opt(
 201 ! CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous, fir.optional}) {
 202 ! CHECK:  fir.call @_QPtakes_contiguous_optional(%[[VAL_0]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
 203 ! CHECK-NEXT:  return
 204
 205 ! -----------------------------------------------------------------------------
 206 !     Test passing pointers to contiguous optional assumed shapes
 207 ! -----------------------------------------------------------------------------
 208 ! This case is interesting because pointers may be non contiguous, and also because
 209 ! a pointer passed to an optional assumed shape dummy is present if and only if the
 210 ! pointer is associated (regardless of the pointer optionality).
 211
 212 subroutine test_pointer_to_contiguous_opt(x)
 213   real, pointer :: x(:)
 214   call takes_contiguous_optional(x)
 215 end subroutine
 216 ! CHECK-LABEL: func.func @_QMtestsPtest_pointer_to_contiguous_opt(
 217 ! CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "x"}) {
 218 ! CHECK:  %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
 219 ! CHECK:  %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
 220 ! CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
 221 ! CHECK:  %[[VAL_4:.*]] = arith.constant 0 : i64
 222 ! CHECK:  %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64
 223 ! CHECK:  %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
 224 ! CHECK:  %[[VAL_7:.*]] = arith.constant 0 : index
 225 ! CHECK:  %[[VAL_8:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_7]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
 226 ! CHECK:  %[[VAL_9:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
 227 ! CHECK:  %[[VAL_10:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_9]]) {{.*}}: (!fir.box<none>) -> i1
 228 ! CHECK:  %[[VAL_11:.*]] = fir.if %[[VAL_5]] -> (!fir.heap<!fir.array<?xf32>>) {
 229 ! CHECK:    %[[VAL_12:.*]] = fir.if %[[VAL_10]] -> (!fir.heap<!fir.array<?xf32>>) {
 230 ! CHECK:      %[[VAL_13:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
 231 ! CHECK:      fir.result %[[VAL_13]] : !fir.heap<!fir.array<?xf32>>
 232 ! CHECK:    } else {
 233 ! CHECK:      %[[VAL_16:.*]] = fir.allocmem !fir.array<?xf32>
 234 ! CHECK:      fir.call @_FortranAAssign
 235 ! CHECK:      fir.result %[[VAL_16]] : !fir.heap<!fir.array<?xf32>>
 236 ! CHECK:    }
 237 ! CHECK:    fir.result %[[VAL_12]] : !fir.heap<!fir.array<?xf32>>
 238 ! CHECK:  } else {
 239 ! CHECK:    %[[VAL_31:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
 240 ! CHECK:    fir.result %[[VAL_31]] : !fir.heap<!fir.array<?xf32>>
 241 ! CHECK:  }
 242 ! CHECK:  %[[VAL_32:.*]] = arith.constant 0 : index
 243 ! CHECK:  %[[VAL_33:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_32]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
 244 ! CHECK:  %[[VAL_34:.*]] = arith.constant false
 245 ! CHECK:  %[[VAL_35:.*]] = arith.cmpi eq, %[[VAL_10]], %[[VAL_34]] : i1
 246 ! CHECK:  %[[VAL_36:.*]] = arith.andi %[[VAL_5]], %[[VAL_35]] : i1
 247 ! CHECK:  %[[VAL_37:.*]] = fir.shape_shift %[[VAL_8]]#0, %[[VAL_33]]#1 : (index, index) -> !fir.shapeshift<1>
 248 ! CHECK:  %[[VAL_38:.*]] = fir.embox %[[VAL_11]](%[[VAL_37]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xf32>>
 249 ! CHECK:  %[[VAL_40:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
 250 ! CHECK:  %[[VAL_41:.*]] = arith.select %[[VAL_5]], %[[VAL_38]], %[[VAL_40]] : !fir.box<!fir.array<?xf32>>
 251 ! CHECK:  fir.call @_QPtakes_contiguous_optional(%[[VAL_41]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
 252 ! CHECK:  fir.if %[[VAL_36]] {
 253 ! CHECK:    fir.call @_FortranACopyOutAssign
 254 ! CHECK:  }
 255 ! CHECK:  return
 256 ! CHECK:}
 257
 258 subroutine test_pointer_contiguous_to_contiguous_opt(x)
 259   real, pointer, contiguous :: x(:)
 260   call takes_contiguous_optional(x)
 261 end subroutine
 262 ! CHECK-LABEL: func.func @_QMtestsPtest_pointer_contiguous_to_contiguous_opt(
 263 ! CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "x", fir.contiguous}) {
 264 ! CHECK:  %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
 265 ! CHECK:  %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
 266 ! CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
 267 ! CHECK:  %[[VAL_4:.*]] = arith.constant 0 : i64
 268 ! CHECK:  %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64
 269 ! CHECK:  %[[VAL_6:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
 270 ! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
 271 ! CHECK:  %[[VAL_8:.*]] = arith.constant 0 : index
 272 ! CHECK:  %[[VAL_9:.*]]:3 = fir.box_dims %[[VAL_7]], %[[VAL_8]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
 273 ! CHECK:  %[[VAL_10:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
 274 ! CHECK:  %[[VAL_11:.*]] = fir.shape_shift %[[VAL_9]]#0, %[[VAL_9]]#1 : (index, index) -> !fir.shapeshift<1>
 275 ! CHECK:  %[[VAL_12:.*]] = fir.embox %[[VAL_10]](%[[VAL_11]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xf32>>
 276 ! CHECK:  %[[VAL_13:.*]] = arith.select %[[VAL_5]], %[[VAL_12]], %[[VAL_6]] : !fir.box<!fir.array<?xf32>>
 277 ! CHECK:  fir.call @_QPtakes_contiguous_optional(%[[VAL_13]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
 278 ! CHECK-NEXT:  return
 279
 280 subroutine test_pointer_opt_to_contiguous_opt(x)
 281   real, pointer, optional :: x(:)
 282   call takes_contiguous_optional(x)
 283 end subroutine
 284 ! CHECK-LABEL: func.func @_QMtestsPtest_pointer_opt_to_contiguous_opt(
 285 ! CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "x", fir.optional}) {
 286 ! CHECK:  %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
 287 ! CHECK:  %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
 288 ! CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
 289 ! CHECK:  %[[VAL_4:.*]] = arith.constant 0 : i64
 290 ! CHECK:  %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64
 291 ! CHECK:  %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
 292 ! CHECK:  %[[VAL_7:.*]] = arith.constant 0 : index
 293 ! CHECK:  %[[VAL_8:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_7]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
 294 ! CHECK:  %[[VAL_9:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
 295 ! CHECK:  %[[VAL_10:.*]] = fir.call @_FortranAIsContiguous(%[[VAL_9]]) {{.*}}: (!fir.box<none>) -> i1
 296 ! CHECK:  %[[VAL_11:.*]] = fir.if %[[VAL_5]] -> (!fir.heap<!fir.array<?xf32>>) {
 297 ! CHECK:    %[[VAL_12:.*]] = fir.if %[[VAL_10]] -> (!fir.heap<!fir.array<?xf32>>) {
 298 ! CHECK:      %[[VAL_13:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
 299 ! CHECK:      fir.result %[[VAL_13]] : !fir.heap<!fir.array<?xf32>>
 300 ! CHECK:    } else {
 301 ! CHECK:      %[[VAL_16:.*]] = fir.allocmem !fir.array<?xf32>
 302 ! CHECK:      fir.call @_FortranAAssign
 303 ! CHECK:      fir.result %[[VAL_16]] : !fir.heap<!fir.array<?xf32>>
 304 ! CHECK:    }
 305 ! CHECK:    fir.result %[[VAL_12]] : !fir.heap<!fir.array<?xf32>>
 306 ! CHECK:  } else {
 307 ! CHECK:    %[[VAL_31:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
 308 ! CHECK:    fir.result %[[VAL_31]] : !fir.heap<!fir.array<?xf32>>
 309 ! CHECK:  }
 310 ! CHECK:  %[[VAL_32:.*]] = arith.constant 0 : index
 311 ! CHECK:  %[[VAL_33:.*]]:3 = fir.box_dims %[[VAL_6]], %[[VAL_32]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
 312 ! CHECK:  %[[VAL_34:.*]] = arith.constant false
 313 ! CHECK:  %[[VAL_35:.*]] = arith.cmpi eq, %[[VAL_10]], %[[VAL_34]] : i1
 314 ! CHECK:  %[[VAL_36:.*]] = arith.andi %[[VAL_5]], %[[VAL_35]] : i1
 315 ! CHECK:  %[[VAL_37:.*]] = fir.shape_shift %[[VAL_8]]#0, %[[VAL_33]]#1 : (index, index) -> !fir.shapeshift<1>
 316 ! CHECK:  %[[VAL_38:.*]] = fir.embox %[[VAL_11]](%[[VAL_37]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xf32>>
 317 ! CHECK:  %[[VAL_40:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
 318 ! CHECK:  %[[VAL_41:.*]] = arith.select %[[VAL_5]], %[[VAL_38]], %[[VAL_40]] : !fir.box<!fir.array<?xf32>>
 319 ! CHECK:  fir.call @_QPtakes_contiguous_optional(%[[VAL_41]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
 320 ! CHECK:  fir.if %[[VAL_36]] {
 321 ! CHECK:    fir.call @_FortranACopyOutAssign
 322 ! CHECK:  }
 323 ! CHECK:  return
 324 ! CHECK:}
 325
 326 subroutine test_pointer_contiguous_opt_to_contiguous_opt(x)
 327   real, pointer, contiguous, optional :: x(:)
 328   call takes_contiguous_optional(x)
 329 end subroutine
 330 ! CHECK-LABEL: func.func @_QMtestsPtest_pointer_contiguous_opt_to_contiguous_opt(
 331 ! CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "x", fir.contiguous, fir.optional}) {
 332 ! CHECK:  %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
 333 ! CHECK:  %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
 334 ! CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
 335 ! CHECK:  %[[VAL_4:.*]] = arith.constant 0 : i64
 336 ! CHECK:  %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64
 337 ! CHECK:  %[[VAL_6:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
 338 ! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
 339 ! CHECK:  %[[VAL_8:.*]] = arith.constant 0 : index
 340 ! CHECK:  %[[VAL_9:.*]]:3 = fir.box_dims %[[VAL_7]], %[[VAL_8]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
 341 ! CHECK:  %[[VAL_10:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
 342 ! CHECK:  %[[VAL_11:.*]] = fir.shape_shift %[[VAL_9]]#0, %[[VAL_9]]#1 : (index, index) -> !fir.shapeshift<1>
 343 ! CHECK:  %[[VAL_12:.*]] = fir.embox %[[VAL_10]](%[[VAL_11]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xf32>>
 344 ! CHECK:  %[[VAL_13:.*]] = arith.select %[[VAL_5]], %[[VAL_12]], %[[VAL_6]] : !fir.box<!fir.array<?xf32>>
 345 ! CHECK-NEXT:  fir.call @_QPtakes_contiguous_optional(%[[VAL_13]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()
 346 ! CHECK:  return
 347 end module