flang/test/HLFIR/assumed-type-actual-args.f90

   1 ! Test lowering to FIR of actual arguments that are assumed type
   2 ! variables (Fortran 2018 7.3.2.2 point 3).
   3 ! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
   4
   5 subroutine test1(x)
   6   interface
   7     subroutine s1(x)
   8       type(*) :: x
   9     end subroutine
  10   end interface
  11   type(*) :: x
  12   call s1(x)
  13 end subroutine
  14
  15 subroutine test2(x)
  16   interface
  17     subroutine s2(x)
  18       type(*) :: x(*)
  19     end subroutine
  20   end interface
  21   type(*) :: x(*)
  22   call s2(x)
  23 end subroutine
  24
  25 subroutine test3(x)
  26   interface
  27     subroutine s3(x)
  28       type(*) :: x(:)
  29     end subroutine
  30   end interface
  31   type(*) :: x(:)
  32   call s3(x)
  33 end subroutine
  34
  35 subroutine test4(x)
  36   interface
  37     subroutine s4(x)
  38       type(*) :: x(*)
  39     end subroutine
  40   end interface
  41   type(*) :: x(:)
  42   call s4(x)
  43 end subroutine
  44
  45 subroutine test3b(x)
  46   interface
  47     subroutine s3b(x)
  48       type(*), optional, contiguous :: x(:)
  49     end subroutine
  50   end interface
  51   type(*), optional :: x(:)
  52   call s3b(x)
  53 end subroutine
  54
  55 subroutine test4b(x)
  56   interface
  57     subroutine s4b(x)
  58       type(*), optional :: x(*)
  59     end subroutine
  60   end interface
  61   type(*), optional :: x(:)
  62   call s4b(x)
  63 end subroutine
  64
  65 subroutine test4c(x)
  66   interface
  67     subroutine s4c(x)
  68       type(*), optional :: x(*)
  69     end subroutine
  70   end interface
  71   type(*), contiguous, optional :: x(:)
  72   call s4c(x)
  73 end subroutine
  74
  75 subroutine test4d(x)
  76   interface
  77     subroutine s4d(x)
  78       type(*) :: x(*)
  79     end subroutine
  80   end interface
  81   type(*), contiguous :: x(:)
  82   call s4d(x)
  83 end subroutine
  84
  85 subroutine test5(x)
  86   interface
  87     subroutine s5(x)
  88       type(*) :: x(..)
  89     end subroutine
  90   end interface
  91   type(*) :: x(:)
  92   call s5(x)
  93 end subroutine
  94
  95 subroutine test5b(x)
  96   interface
  97     subroutine s5b(x)
  98       type(*), optional, contiguous :: x(..)
  99     end subroutine
 100   end interface
 101   type(*), optional :: x(:)
 102   call s5b(x)
 103 end subroutine
 104
 105 ! CHECK-LABEL:   func.func @_QPtest1(
 106 ! CHECK-SAME:                        %[[VAL_0:.*]]: !fir.ref<none> {fir.bindc_name = "x"}) {
 107 ! CHECK:           %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
 108 ! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[DSCOPE]] {uniq_name = "_QFtest1Ex"} : (!fir.ref<none>, !fir.dscope) -> (!fir.ref<none>, !fir.ref<none>)
 109 ! CHECK:           fir.call @_QPs1(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<none>) -> ()
 110 ! CHECK:           return
 111 ! CHECK:         }
 112
 113 ! CHECK-LABEL:   func.func @_QPtest2(
 114 ! CHECK-SAME:                        %[[VAL_0:.*]]: !fir.ref<!fir.array<?xnone>> {fir.bindc_name = "x"}) {
 115 ! CHECK:           %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
 116 ! CHECK:           %[[VAL_1:.*]] = arith.constant -1 : index
 117 ! CHECK:           %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
 118 ! CHECK:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]](%[[VAL_2]]) dummy_scope %[[DSCOPE]] {uniq_name = "_QFtest2Ex"} : (!fir.ref<!fir.array<?xnone>>, !fir.shape<1>, !fir.dscope) -> (!fir.box<!fir.array<?xnone>>, !fir.ref<!fir.array<?xnone>>)
 119 ! CHECK:           fir.call @_QPs2(%[[VAL_3]]#1) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
 120 ! CHECK:           return
 121 ! CHECK:         }
 122
 123 ! CHECK-LABEL:   func.func @_QPtest3(
 124 ! CHECK-SAME:                        %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x"}) {
 125 ! CHECK:           %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
 126 ! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[DSCOPE]] {uniq_name = "_QFtest3Ex"} : (!fir.box<!fir.array<?xnone>>, !fir.dscope) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
 127 ! CHECK:           fir.call @_QPs3(%[[VAL_1]]#0) fastmath<contract> : (!fir.box<!fir.array<?xnone>>) -> ()
 128 ! CHECK:           return
 129 ! CHECK:         }
 130
 131 ! CHECK-LABEL:   func.func @_QPtest4(
 132 ! CHECK-SAME:                        %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x"}) {
 133 ! CHECK:           %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
 134 ! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[DSCOPE]] {uniq_name = "_QFtest4Ex"} : (!fir.box<!fir.array<?xnone>>, !fir.dscope) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
 135 ! CHECK:           %[[VAL_2:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 to %[[TMP_BOX:.*]] : (!fir.box<!fir.array<?xnone>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xnone>>>>) -> (!fir.box<!fir.array<?xnone>>, i1)
 136 ! CHECK:           %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]]#0 : (!fir.box<!fir.array<?xnone>>) -> !fir.ref<!fir.array<?xnone>>
 137 ! CHECK:           fir.call @_QPs4(%[[VAL_3]]) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
 138 ! CHECK:           hlfir.copy_out %[[TMP_BOX]], %[[VAL_2]]#1 to %[[VAL_1]]#0 : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xnone>>>>, i1, !fir.box<!fir.array<?xnone>>) -> ()
 139 ! CHECK:           return
 140 ! CHECK:         }
 141
 142 ! CHECK-LABEL:   func.func @_QPtest3b(
 143 ! CHECK-SAME:                         %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x", fir.optional}) {
 144 ! CHECK:           %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
 145 ! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[DSCOPE]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFtest3bEx"} : (!fir.box<!fir.array<?xnone>>, !fir.dscope) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
 146 ! CHECK:           %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> i1
 147 ! CHECK:           %[[VAL_3:.*]]:3 = fir.if %[[VAL_2]] -> (!fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) {
 148 ! CHECK:             %[[VAL_4:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 to %[[TMP_BOX:.*]] : (!fir.box<!fir.array<?xnone>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xnone>>>>) -> (!fir.box<!fir.array<?xnone>>, i1)
 149 ! CHECK:             fir.result %[[VAL_4]]#0, %[[VAL_4]]#1, %[[VAL_1]]#0 : !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
 150 ! CHECK:           } else {
 151 ! CHECK:             %[[VAL_6:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
 152 ! CHECK:             %[[VAL_7:.*]] = arith.constant false
 153 ! CHECK:             %[[VAL_8:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
 154 ! CHECK:             fir.result %[[VAL_6]], %[[VAL_7]], %[[VAL_8]] : !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
 155 ! CHECK:           }
 156 ! CHECK:           fir.call @_QPs3b(%[[VAL_9:.*]]#0) fastmath<contract> : (!fir.box<!fir.array<?xnone>>) -> ()
 157 ! CHECK:           hlfir.copy_out %[[TMP_BOX]], %[[VAL_9]]#1 to %[[VAL_9]]#2 : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xnone>>>>, i1, !fir.box<!fir.array<?xnone>>) -> ()
 158 ! CHECK:           return
 159 ! CHECK:         }
 160
 161 ! CHECK-LABEL:   func.func @_QPtest4b(
 162 ! CHECK-SAME:                         %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x", fir.optional}) {
 163 ! CHECK:           %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
 164 ! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[DSCOPE]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFtest4bEx"} : (!fir.box<!fir.array<?xnone>>, !fir.dscope) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
 165 ! CHECK:           %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> i1
 166 ! CHECK:           %[[VAL_3:.*]]:3 = fir.if %[[VAL_2]] -> (!fir.ref<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) {
 167 ! CHECK:             %[[VAL_4:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 to %[[TMP_BOX:.*]] : (!fir.box<!fir.array<?xnone>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xnone>>>>) -> (!fir.box<!fir.array<?xnone>>, i1)
 168 ! CHECK:             %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]]#0 : (!fir.box<!fir.array<?xnone>>) -> !fir.ref<!fir.array<?xnone>>
 169 ! CHECK:             fir.result %[[VAL_5]], %[[VAL_4]]#1, %[[VAL_1]]#0 : !fir.ref<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
 170 ! CHECK:           } else {
 171 ! CHECK:             %[[VAL_7:.*]] = fir.absent !fir.ref<!fir.array<?xnone>>
 172 ! CHECK:             %[[VAL_8:.*]] = arith.constant false
 173 ! CHECK:             %[[VAL_9:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
 174 ! CHECK:             fir.result %[[VAL_7]], %[[VAL_8]], %[[VAL_9]] : !fir.ref<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
 175 ! CHECK:           }
 176 ! CHECK:           fir.call @_QPs4b(%[[VAL_10:.*]]#0) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
 177 ! CHECK:           hlfir.copy_out %[[TMP_BOX]], %[[VAL_10]]#1 to %[[VAL_10]]#2 : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xnone>>>>, i1, !fir.box<!fir.array<?xnone>>) -> ()
 178 ! CHECK:           return
 179 ! CHECK:         }
 180
 181 ! CHECK-LABEL:   func.func @_QPtest4c(
 182 ! CHECK-SAME:                         %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x", fir.contiguous, fir.optional}) {
 183 ! CHECK:           %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
 184 ! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[DSCOPE]] {fortran_attrs = #fir.var_attrs<contiguous, optional>, uniq_name = "_QFtest4cEx"} : (!fir.box<!fir.array<?xnone>>, !fir.dscope) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
 185 ! CHECK:           %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> i1
 186 ! CHECK:           %[[VAL_3:.*]] = fir.if %[[VAL_2]] -> (!fir.ref<!fir.array<?xnone>>) {
 187 ! CHECK:             %[[VAL_4:.*]] = fir.box_addr %[[VAL_1]]#1 : (!fir.box<!fir.array<?xnone>>) -> !fir.ref<!fir.array<?xnone>>
 188 ! CHECK:             fir.result %[[VAL_4]] : !fir.ref<!fir.array<?xnone>>
 189 ! CHECK:           } else {
 190 ! CHECK:             %[[VAL_5:.*]] = fir.absent !fir.ref<!fir.array<?xnone>>
 191 ! CHECK:             fir.result %[[VAL_5]] : !fir.ref<!fir.array<?xnone>>
 192 ! CHECK:           }
 193 ! CHECK:           fir.call @_QPs4c(%[[VAL_3]]) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
 194 ! CHECK:           return
 195 ! CHECK:         }
 196
 197 ! CHECK-LABEL:   func.func @_QPtest4d(
 198 ! CHECK-SAME:                         %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x", fir.contiguous}) {
 199 ! CHECK:           %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
 200 ! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[DSCOPE]] {fortran_attrs = #fir.var_attrs<contiguous>, uniq_name = "_QFtest4dEx"} : (!fir.box<!fir.array<?xnone>>, !fir.dscope) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
 201 ! CHECK:           %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#1 : (!fir.box<!fir.array<?xnone>>) -> !fir.ref<!fir.array<?xnone>>
 202 ! CHECK:           fir.call @_QPs4d(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?xnone>>) -> ()
 203 ! CHECK:           return
 204 ! CHECK:         }
 205
 206 ! CHECK-LABEL:   func.func @_QPtest5(
 207 ! CHECK-SAME:                        %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x"}) {
 208 ! CHECK:           %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
 209 ! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[DSCOPE]] {uniq_name = "_QFtest5Ex"} : (!fir.box<!fir.array<?xnone>>, !fir.dscope) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
 210 ! CHECK:           %[[VAL_2:.*]] = fir.convert %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> !fir.box<!fir.array<*:none>>
 211 ! CHECK:           fir.call @_QPs5(%[[VAL_2]]) fastmath<contract> : (!fir.box<!fir.array<*:none>>) -> ()
 212 ! CHECK:           return
 213 ! CHECK:         }
 214
 215 ! CHECK-LABEL:   func.func @_QPtest5b(
 216 ! CHECK-SAME:                         %[[VAL_0:.*]]: !fir.box<!fir.array<?xnone>> {fir.bindc_name = "x", fir.optional}) {
 217 ! CHECK:           %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
 218 ! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[DSCOPE]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFtest5bEx"} : (!fir.box<!fir.array<?xnone>>, !fir.dscope) -> (!fir.box<!fir.array<?xnone>>, !fir.box<!fir.array<?xnone>>)
 219 ! CHECK:           %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box<!fir.array<?xnone>>) -> i1
 220 ! CHECK:           %[[VAL_3:.*]]:3 = fir.if %[[VAL_2]] -> (!fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>) {
 221 ! CHECK:             %[[VAL_4:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 to %[[TMP_BOX:.*]] : (!fir.box<!fir.array<?xnone>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xnone>>>>) -> (!fir.box<!fir.array<?xnone>>, i1)
 222 ! CHECK:             fir.result %[[VAL_4]]#0, %[[VAL_4]]#1, %[[VAL_1]]#0 : !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
 223 ! CHECK:           } else {
 224 ! CHECK:             %[[VAL_6:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
 225 ! CHECK:             %[[VAL_7:.*]] = arith.constant false
 226 ! CHECK:             %[[VAL_8:.*]] = fir.absent !fir.box<!fir.array<?xnone>>
 227 ! CHECK:             fir.result %[[VAL_6]], %[[VAL_7]], %[[VAL_8]] : !fir.box<!fir.array<?xnone>>, i1, !fir.box<!fir.array<?xnone>>
 228 ! CHECK:           }
 229 ! CHECK:           %[[VAL_9:.*]] = fir.convert %[[VAL_10:.*]]#0 : (!fir.box<!fir.array<?xnone>>) -> !fir.box<!fir.array<*:none>>
 230 ! CHECK:           fir.call @_QPs5b(%[[VAL_9]]) fastmath<contract> : (!fir.box<!fir.array<*:none>>) -> ()
 231 ! CHECK:           hlfir.copy_out %[[TMP_BOX]], %[[VAL_10]]#1 to %[[VAL_10]]#2 : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xnone>>>>, i1, !fir.box<!fir.array<?xnone>>) -> ()
 232 ! CHECK:           return
 233 ! CHECK:         }