flang/test/Lower/Intrinsics/loc.f90

   1 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
   2 ! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s
   3
   4 ! Test LOC intrinsic
   5
   6 ! CHECK-LABEL: func.func @_QPloc_scalar() {
   7 subroutine loc_scalar()
   8   integer(8) :: p
   9   integer :: x
  10   p = loc(x)
  11 ! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
  12 ! CHECK: %[[x:.*]] = fir.alloca i32 {{.*}}
  13 ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref<i32>) -> !fir.box<i32>
  14 ! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box<i32>) -> !fir.ref<i32>
  15 ! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref<i32>) -> i64
  16 ! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref<i64>
  17 end
  18
  19 ! CHECK-LABEL: func.func @_QPloc_char() {
  20 subroutine loc_char()
  21   integer(8) :: p
  22   character(5) :: x = "abcde"
  23   p = loc(x)
  24 ! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
  25 ! CHECK: %[[x:.*]] = fir.address_of(@_QFloc_charEx) : !fir.ref<!fir.char<1,5>>
  26 ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.char<1,5>>) -> !fir.box<!fir.char<1,5>>
  27 ! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box<!fir.char<1,5>>) -> !fir.ref<!fir.char<1,5>>
  28 ! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref<!fir.char<1,5>>) -> i64
  29 ! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref<i64>
  30 end
  31
  32 ! CHECK-LABEL: func.func @_QPloc_substring() {
  33 subroutine loc_substring()
  34   integer(8) :: p
  35   character(5) :: x = "abcde"
  36   p = loc(x(2:))
  37 ! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
  38 ! CHECK: %[[x:.*]] = fir.address_of(@_QFloc_substringEx) : !fir.ref<!fir.char<1,5>>
  39 ! CHECK: %[[sslb:.*]] = arith.constant 2 : i64
  40 ! CHECK: %[[ssub:.*]] = arith.constant 5 : i64
  41 ! CHECK: %[[sslbidx:.*]] = fir.convert %[[sslb]] : (i64) -> index
  42 ! CHECK: %[[ssubidx:.*]] = fir.convert %[[ssub]] : (i64) -> index
  43 ! CHECK: %[[one:.*]] = arith.constant 1 : index
  44 ! CHECK: %[[lboffset:.*]] = arith.subi %[[sslbidx]], %c1 : index
  45 ! CHECK: %[[xarr:.*]] = fir.convert %[[x]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<!fir.array<5x!fir.char<1>>>
  46 ! CHECK: %[[xarrcoord:.*]] = fir.coordinate_of %[[xarr]], %[[lboffset]] : (!fir.ref<!fir.array<5x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
  47 ! CHECK: %[[xss:.*]] = fir.convert %[[xarrcoord]] : (!fir.ref<!fir.char<1>>) -> !fir.ref<!fir.char<1,?>>
  48 ! CHECK: %[[rng:.*]] = arith.subi %[[ssubidx]], %[[sslbidx]] : index
  49 ! CHECK: %[[rngp1:.*]] = arith.addi %[[rng]], %[[one]] : index
  50 ! CHECK: %[[zero:.*]] = arith.constant 0 : index
  51 ! CHECK: %[[cmpval:.*]] = arith.cmpi slt, %[[rngp1]], %[[zero]] : index
  52 ! CHECK: %[[sltval:.*]] = arith.select %[[cmpval]], %[[zero]], %[[rngp1]] : index
  53 ! CHECK: %[[xssbox:.*]] = fir.embox %[[xss]] typeparams %[[sltval]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
  54 ! CHECK: %[[xssaddr:.*]] = fir.box_addr %[[xssbox]] : (!fir.box<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,?>>
  55 ! CHECK: %[[xssaddrval:.*]] = fir.convert %[[xssaddr]] : (!fir.ref<!fir.char<1,?>>) -> i64
  56 ! CHECK: fir.store %[[xssaddrval]] to %[[p]] : !fir.ref<i64>
  57 end
  58
  59 ! CHECK-LABEL: func.func @_QPloc_array() {
  60 subroutine loc_array
  61   integer(8) :: p
  62   integer :: x(10)
  63   p = loc(x)
  64 ! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
  65 ! CHECK: %[[ten:.*]] = arith.constant 10 : index
  66 ! CHECK: %[[x:.*]] = fir.alloca !fir.array<10xi32> {{.*}}
  67 ! CHECK: %[[xshp:.*]] = fir.shape %[[ten]] : (index) -> !fir.shape<1>
  68 ! CHECK: %[[xbox:.*]] = fir.embox %[[x]](%[[xshp]]) : (!fir.ref<!fir.array<10xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<10xi32>>
  69 ! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box<!fir.array<10xi32>>) -> !fir.ref<!fir.array<10xi32>>
  70 ! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref<!fir.array<10xi32>>) -> i64
  71 ! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref<i64>
  72 end
  73
  74 ! CHECK-LABEL: func.func @_QPloc_chararray() {
  75 subroutine loc_chararray()
  76   integer(8) :: p
  77   character(5) :: x(2)
  78   p = loc(x)
  79 ! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
  80 ! CHECK: %[[two:.*]] = arith.constant 2 : index
  81 ! CHECK: %[[x:.*]] = fir.alloca !fir.array<2x!fir.char<1,5>> {{.*}}
  82 ! CHECK: %[[xshp:.*]] = fir.shape %[[two]] : (index) -> !fir.shape<1>
  83 ! CHECK: %[[xbox:.*]] = fir.embox %[[x]](%[[xshp]]) : (!fir.ref<!fir.array<2x!fir.char<1,5>>>, !fir.shape<1>) -> !fir.box<!fir.array<2x!fir.char<1,5>>>
  84 ! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box<!fir.array<2x!fir.char<1,5>>>) -> !fir.ref<!fir.array<2x!fir.char<1,5>>>
  85 ! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref<!fir.array<2x!fir.char<1,5>>>) -> i64
  86 ! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref<i64>
  87 end
  88
  89 ! CHECK-LABEL: func.func @_QPloc_arrayelement() {
  90 subroutine loc_arrayelement()
  91   integer(8) :: p
  92   integer :: x(10)
  93   p = loc(x(7))
  94 ! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
  95 ! CHECK: %[[x:.*]] = fir.alloca !fir.array<10xi32> {{.*}}
  96 ! CHECK: %[[idx:.*]] = arith.constant 7 : i64
  97 ! CHECK: %[[lb:.*]] = arith.constant 1 : i64
  98 ! CHECK: %[[offset:.*]] = arith.subi %[[idx]], %[[lb]] : i64
  99 ! CHECK: %[[xelemcoord:.*]] = fir.coordinate_of %[[x]], %[[offset]] : (!fir.ref<!fir.array<10xi32>>, i64) -> !fir.ref<i32>
 100 ! CHECK: %[[xelembox:.*]] = fir.embox %[[xelemcoord]] : (!fir.ref<i32>) -> !fir.box<i32>
 101 ! CHECK: %[[xelemaddr:.*]] = fir.box_addr %[[xelembox]] : (!fir.box<i32>) -> !fir.ref<i32>
 102 ! CHECK: %[[xelemaddrval:.*]] = fir.convert %[[xelemaddr]] : (!fir.ref<i32>) -> i64
 103 ! CHECK: fir.store %[[xelemaddrval]] to %[[p]] : !fir.ref<i64>
 104 end
 105
 106 ! CHECK-LABEL: func.func @_QPloc_arraysection(
 107 ! CHECK-SAME: %[[arg:.*]]: !fir.ref<i32> {{.*}}) {
 108 subroutine loc_arraysection(i)
 109   integer(8) :: p
 110   integer :: i
 111   real :: x(11)
 112   p = loc(x(i:))
 113 ! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
 114 ! CHECK: %[[eleven:.*]] = arith.constant 11 : index
 115 ! CHECK: %[[x:.*]] = fir.alloca !fir.array<11xf32> {{.*}}
 116 ! CHECK: %[[one:.*]] = arith.constant 1 : index
 117 ! CHECK: %[[i:.*]] = fir.load %[[arg]] : !fir.ref<i32>
 118 ! CHECK: %[[il:.*]] = fir.convert %[[i]] : (i32) -> i64
 119 ! CHECK: %[[iidx:.*]] = fir.convert %[[il]] : (i64) -> index
 120 ! CHECK: %[[onel:.*]] = arith.constant 1 : i64
 121 ! CHECK: %[[stpidx:.*]] = fir.convert %[[onel]] : (i64) -> index
 122 ! CHECK: %[[xrng:.*]] = arith.addi %[[one]], %[[eleven]] : index
 123 ! CHECK: %[[xub:.*]] = arith.subi %[[xrng]], %[[one]] : index
 124 ! CHECK: %[[xshp:.*]] = fir.shape %[[eleven]] : (index) -> !fir.shape<1>
 125 ! CHECK: %[[xslice:.*]] = fir.slice %[[iidx]], %[[xub]], %[[stpidx]] : (index, index, index) -> !fir.slice<1>
 126 ! CHECK: %[[xbox:.*]] = fir.embox %[[x]](%[[xshp]]) [%[[xslice]]] : (!fir.ref<!fir.array<11xf32>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<?xf32>>
 127 ! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
 128 ! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref<!fir.array<?xf32>>) -> i64
 129 ! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref<i64>
 130 end
 131
 132 ! CHECK-LABEL: func.func @_QPloc_non_save_pointer_scalar() {
 133 subroutine loc_non_save_pointer_scalar()
 134   integer(8) :: p
 135   real, pointer :: x
 136   real, target :: t
 137   x => t
 138   p = loc(x)
 139 ! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
 140 ! CHECK: %[[t:.*]] = fir.alloca f32 {{.*}}
 141 ! CHECK: %2 = fir.alloca !fir.box<!fir.ptr<f32>> {{.*}}
 142 ! CHECK: %[[xa:.*]] = fir.alloca !fir.ptr<f32> {{.*}}
 143 ! CHECK: %[[zero:.*]] = fir.zero_bits !fir.ptr<f32>
 144 ! CHECK: fir.store %[[zero]] to %[[xa]] : !fir.ref<!fir.ptr<f32>>
 145 ! CHECK: %[[taddr:.*]] = fir.convert %[[t]] : (!fir.ref<f32>) -> !fir.ptr<f32>
 146 ! CHECK: fir.store %[[taddr]] to %[[xa]] : !fir.ref<!fir.ptr<f32>>
 147 ! CHECK: %[[x:.*]] = fir.load %[[xa]] : !fir.ref<!fir.ptr<f32>>
 148 ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ptr<f32>) -> !fir.box<f32>
 149 ! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box<f32>) -> !fir.ref<f32>
 150 ! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref<f32>) -> i64
 151 ! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref<i64>
 152 end
 153
 154 ! CHECK-LABEL: func.func @_QPloc_save_pointer_scalar() {
 155 subroutine loc_save_pointer_scalar()
 156   integer :: p
 157   real, pointer, save :: x
 158   p = loc(x)
 159 ! CHECK: %[[p:.*]] = fir.alloca i32 {{.*}}
 160 ! CHECK: %[[x:.*]] = fir.address_of(@_QFloc_save_pointer_scalarEx) : !fir.ref<!fir.box<!fir.ptr<f32>>>
 161 ! CHECK: %[[xref:.*]] = fir.load %[[x]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
 162 ! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xref]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
 163 ! CHECK: %[[xbox:.*]] = fir.embox %[[xaddr]] : (!fir.ptr<f32>) -> !fir.box<f32>
 164 ! CHECK: %[[xaddr2:.*]] = fir.box_addr %[[xbox]] : (!fir.box<f32>) -> !fir.ref<f32>
 165 ! CHECK: %[[xaddr2vall:.*]] = fir.convert %[[xaddr2]] : (!fir.ref<f32>) -> i64
 166 ! CHECK: %[[xaddr2val:.*]] = fir.convert %[[xaddr2vall]] : (i64) -> i32
 167 ! CHECK: fir.store %[[xaddr2val]] to %[[p]] : !fir.ref<i32>
 168 end
 169
 170 ! CHECK-LABEL: func.func @_QPloc_derived_type() {
 171 subroutine loc_derived_type
 172   integer(8) :: p
 173   type dt
 174     integer :: i
 175   end type
 176   type(dt) :: xdt
 177   p = loc(xdt)
 178 ! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
 179 ! CHECK: %[[xdt:.*]] = fir.alloca !fir.type<_QFloc_derived_typeTdt{i:i32}> {{.*}}
 180 ! CHECK: %[[xdtbox:.*]] = fir.embox %[[xdt]] : (!fir.ref<!fir.type<_QFloc_derived_typeTdt{i:i32}>>) -> !fir.box<!fir.type<_QFloc_derived_typeTdt{i:i32}>>
 181 ! CHECK: %[[xdtaddr:.*]] = fir.box_addr %[[xdtbox]] : (!fir.box<!fir.type<_QFloc_derived_typeTdt{i:i32}>>) -> !fir.ref<!fir.type<_QFloc_derived_typeTdt{i:i32}>>
 182 ! CHECK: %[[xdtaddrval:.*]] = fir.convert %[[xdtaddr]] : (!fir.ref<!fir.type<_QFloc_derived_typeTdt{i:i32}>>) -> i64
 183 ! CHECK: fir.store %[[xdtaddrval]] to %[[p]] : !fir.ref<i64>
 184 end
 185
 186 ! CHECK-LABEL: func.func @_QPloc_pointer_array() {
 187 subroutine loc_pointer_array
 188   integer(8) :: p
 189   integer, pointer :: x(:)
 190   p = loc(x)
 191 ! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
 192 ! CHECK: %[[x:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>> {{.*}}
 193 ! CHECK: %2 = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
 194 ! CHECK: %[[zero:.*]] = arith.constant 0 : index
 195 ! CHECK: %[[xshp:.*]] = fir.shape %[[zero]] : (index) -> !fir.shape<1>
 196 ! CHECK: %[[xbox0:.*]] = fir.embox %2(%[[xshp]]) : (!fir.ptr<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
 197 ! CHECK: fir.store %[[xbox0]] to %[[x]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
 198 ! CHECK: %[[xbox:.*]] = fir.load %[[x]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
 199 ! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box<!fir.ptr<!fir.array<?xi32>>>) -> !fir.ptr<!fir.array<?xi32>>
 200 ! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ptr<!fir.array<?xi32>>) -> i64
 201 ! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref<i64>
 202 end
 203
 204 ! CHECK-LABEL: func.func @_QPloc_allocatable_array() {
 205 subroutine loc_allocatable_array
 206   integer(8) :: p
 207   integer, allocatable :: x(:)
 208   p = loc(x)
 209 ! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
 210 ! CHECK: %1 = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>> {{.*}}
 211 ! CHECK: %[[stg:.*]] = fir.alloca !fir.heap<!fir.array<?xi32>> {{.*}}
 212 ! CHECK: %[[lb:.*]] = fir.alloca index {{.*}}
 213 ! CHECK: %[[ext:.*]] = fir.alloca index {{.*}}
 214 ! CHECK: %[[zstg:.*]] = fir.zero_bits !fir.heap<!fir.array<?xi32>>
 215 ! CHECK: fir.store %[[zstg]] to %[[stg]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
 216 ! CHECK: %[[lbval:.*]] = fir.load %[[lb]] : !fir.ref<index>
 217 ! CHECK: %[[extval:.*]] = fir.load %[[ext]] : !fir.ref<index>
 218 ! CHECK: %[[stgaddr:.*]] = fir.load %[[stg]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
 219 ! CHECK: %[[ss:.*]] = fir.shape_shift %[[lbval]], %[[extval]] : (index, index) -> !fir.shapeshift<1>
 220 ! CHECK: %[[xbox:.*]] = fir.embox %[[stgaddr]](%[[ss]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xi32>>
 221 ! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box<!fir.array<?xi32>>) -> !fir.ref<!fir.array<?xi32>>
 222 ! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref<!fir.array<?xi32>>) -> i64
 223 ! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref<i64>
 224 end
 225
 226 ! CHECK-LABEL: func.func @_QPtest_external() {
 227 subroutine test_external()
 228   integer(8) :: p
 229   integer, external :: f
 230   p = loc(x=f)
 231 ! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
 232 ! CHECK: %[[f:.*]] = fir.address_of(@_QPf) : () -> i32
 233 ! CHECK: %[[fbox:.*]] = fir.emboxproc %[[f]] : (() -> i32) -> !fir.boxproc<() -> i32>
 234 ! CHECK: %[[faddr:.*]] = fir.box_addr %[[fbox]] : (!fir.boxproc<() -> i32>) -> (() -> i32)
 235 ! CHECK: %[[faddrval:.*]] = fir.convert %[[faddr]] : (() -> i32) -> i64
 236 ! CHECK: fir.store %[[faddrval]] to %[[p]] : !fir.ref<i64>
 237 end
 238
 239 ! CHECK-LABEL: func.func @_QPtest_proc() {
 240 subroutine test_proc()
 241   integer(8) :: p
 242   procedure() :: g
 243   p = loc(x=g)
 244 ! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
 245 ! CHECK: %[[g:.*]] = fir.address_of(@_QPg) : () -> ()
 246 ! CHECK: %[[gbox:.*]] = fir.emboxproc %[[g]] : (() -> ()) -> !fir.boxproc<() -> ()>
 247 ! CHECK: %[[gaddr:.*]] = fir.box_addr %[[gbox]] : (!fir.boxproc<() -> ()>) -> (() -> ())
 248 ! CHECK: %[[gaddrval:.*]] = fir.convert %[[gaddr]] : (() -> ()) -> i64
 249 ! CHECK: fir.store %[[gaddrval]] to %[[p]] : !fir.ref<i64>
 250 end