flang/test/Lower/pointer-references.f90

   1 ! Test lowering of references to pointers
   2 ! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s
   3
   4 ! Assigning/reading to scalar pointer target.
   5 ! CHECK-LABEL: func @_QPscal_ptr(
   6 ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>{{.*}})
   7 subroutine scal_ptr(p)
   8   real, pointer :: p
   9   real :: x
  10   ! CHECK: %[[boxload:.*]] = fir.load %[[arg0]]
  11   ! CHECK: %[[addr:.*]] = fir.box_addr %[[boxload]]
  12   ! CHECK: fir.store %{{.*}} to %[[addr]]
  13   p = 3.
  14
  15   ! CHECK: %[[boxload2:.*]] = fir.load %[[arg0]]
  16   ! CHECK: %[[addr2:.*]] = fir.box_addr %[[boxload2]]
  17   ! CHECK: %[[val:.*]] = fir.load %[[addr2]]
  18   ! CHECK: fir.store %[[val]] to %{{.*}}
  19   x = p
  20 end subroutine
  21
  22 ! Assigning/reading scalar character pointer target.
  23 ! CHECK-LABEL: func @_QPchar_ptr(
  24 ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,12>>>>{{.*}})
  25 subroutine char_ptr(p)
  26   character(12), pointer :: p
  27   character(12) :: x
  28
  29   ! CHECK-DAG: %[[str:.*]] = fir.address_of(@_QQclX68656C6C6F20776F726C6421) : !fir.ref<!fir.char<1,12>>
  30   ! CHECK: %[[boxload:.*]] = fir.load %[[arg0]]
  31   ! CHECK: %[[addr:.*]] = fir.box_addr %[[boxload]]
  32   ! CHECK-DAG: %[[one:.*]] = arith.constant 1
  33   ! CHECK-DAG: %[[size:.*]] = fir.convert %{{.*}} : (index) -> i64
  34   ! CHECK: %[[count:.*]] = arith.muli %[[one]], %[[size]] : i64
  35   ! CHECK: %[[dst:.*]] = fir.convert %[[addr]] : (!fir.ptr<!fir.char<1,12>>) -> !fir.ref<i8>
  36   ! CHECK: %[[src:.*]] = fir.convert %[[str]] : (!fir.ref<!fir.char<1,12>>) -> !fir.ref<i8>
  37   ! CHECK: fir.call @llvm.memmove.p0.p0.i64(%[[dst]], %[[src]], %{{[0-9]+}}, %false) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
  38   p = "hello world!"
  39
  40   ! CHECK: %[[boxload2:.*]] = fir.load %[[arg0]]
  41   ! CHECK: %[[addr2:.*]] = fir.box_addr %[[boxload2]]
  42   ! CHECK: %[[count:.*]] = arith.muli %{{.*}}, %{{.*}} : i64
  43   ! CHECK: %[[dst:.*]] = fir.convert %{{.*}} : (!fir.ref<!fir.char<1,12>>) -> !fir.ref<i8>
  44   ! CHECK: %[[src:.*]] = fir.convert %[[addr2]] : (!fir.ptr<!fir.char<1,12>>) -> !fir.ref<i8>
  45   ! CHECK: fir.call @llvm.memmove.p0.p0.i64(%[[dst]], %[[src]], %[[count]], %{{.*}}) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
  46   x = p
  47 end subroutine
  48
  49 ! Reading from pointer in array expression
  50 ! CHECK-LABEL: func @_QParr_ptr_read(
  51 ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}})
  52 subroutine arr_ptr_read(p)
  53   real, pointer :: p(:)
  54   real :: x(100)
  55   ! CHECK: %[[boxload:.*]] = fir.load %[[arg0]]
  56   ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[boxload]], %c0{{.*}} : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
  57   ! CHECK: %[[lb:.*]] = fir.shift %[[dims]]#0 : (index) -> !fir.shift<1>
  58   ! CHECK: fir.array_load %[[boxload]](%[[lb]]) : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.shift<1>) -> !fir.array<?xf32>
  59   x = p
  60 end subroutine
  61
  62 ! Reading from contiguous pointer in array expression
  63 ! CHECK-LABEL: func @_QParr_contig_ptr_read(
  64 ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {{{.*}}, fir.contiguous})
  65 subroutine arr_contig_ptr_read(p)
  66   real, pointer, contiguous :: p(:)
  67   real :: x(100)
  68   ! CHECK: %[[boxload:.*]] = fir.load %[[arg0]]
  69   ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[boxload]], %c0{{.*}} : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
  70   ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[boxload]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
  71   ! CHECK-DAG: %[[shape:.*]] = fir.shape_shift %[[dims]]#0, %[[dims]]#1 : (index, index) -> !fir.shapeshift<1>
  72   ! CHECK: fir.array_load %[[addr]](%[[shape]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.array<?xf32>
  73   x = p
  74 end subroutine
  75
  76 ! Assigning to pointer target in array expression
  77
  78   ! CHECK-LABEL: func @_QParr_ptr_target_write(
  79   ! CHECK-SAME:                                %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}) {
  80   ! CHECK:         %[[VAL_1:.*]] = arith.constant 100 : index
  81   ! CHECK:         %[[VAL_2:.*]] = fir.alloca !fir.array<100xf32> {bindc_name = "x", uniq_name = "_QFarr_ptr_target_writeEx"}
  82   ! CHECK:         %[[VAL_3:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
  83   ! CHECK:         %[[VAL_4:.*]] = arith.constant 0 : index
  84   ! CHECK:         %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]], %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
  85   ! CHECK:         %[[VAL_6:.*]] = arith.constant 2 : i64
  86   ! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> index
  87   ! CHECK:         %[[VAL_8:.*]] = arith.constant 6 : i64
  88   ! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> index
  89   ! CHECK:         %[[VAL_10:.*]] = arith.constant 601 : i64
  90   ! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> index
  91   ! CHECK:         %[[VAL_12:.*]] = arith.constant 0 : index
  92   ! CHECK:         %[[VAL_13:.*]] = arith.subi %[[VAL_11]], %[[VAL_7]] : index
  93   ! CHECK:         %[[VAL_14:.*]] = arith.addi %[[VAL_13]], %[[VAL_9]] : index
  94   ! CHECK:         %[[VAL_15:.*]] = arith.divsi %[[VAL_14]], %[[VAL_9]] : index
  95   ! CHECK:         %[[VAL_16:.*]] = arith.cmpi sgt, %[[VAL_15]], %[[VAL_12]] : index
  96   ! CHECK:         %[[VAL_17:.*]] = arith.select %[[VAL_16]], %[[VAL_15]], %[[VAL_12]] : index
  97   ! CHECK:         %[[VAL_18:.*]] = fir.shift %[[VAL_5]]#0 : (index) -> !fir.shift<1>
  98   ! CHECK:         %[[VAL_19:.*]] = fir.slice %[[VAL_7]], %[[VAL_11]], %[[VAL_9]] : (index, index, index) -> !fir.slice<1>
  99   ! CHECK:         %[[VAL_20:.*]] = fir.array_load %[[VAL_3]](%[[VAL_18]]) {{\[}}%[[VAL_19]]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.shift<1>, !fir.slice<1>) -> !fir.array<?xf32>
 100   ! CHECK:         %[[VAL_21:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
 101   ! CHECK:         %[[VAL_22:.*]] = fir.array_load %[[VAL_2]](%[[VAL_21]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.array<100xf32>
 102   ! CHECK:         %[[VAL_23:.*]] = arith.constant 1 : index
 103   ! CHECK:         %[[VAL_24:.*]] = arith.constant 0 : index
 104   ! CHECK:         %[[VAL_25:.*]] = arith.subi %[[VAL_17]], %[[VAL_23]] : index
 105   ! CHECK:         %[[VAL_26:.*]] = fir.do_loop %[[VAL_27:.*]] = %[[VAL_24]] to %[[VAL_25]] step %[[VAL_23]] unordered iter_args(%[[VAL_28:.*]] = %[[VAL_20]]) -> (!fir.array<?xf32>) {
 106   ! CHECK:           %[[VAL_29:.*]] = fir.array_fetch %[[VAL_22]], %[[VAL_27]] : (!fir.array<100xf32>, index) -> f32
 107   ! CHECK:           %[[VAL_30:.*]] = fir.array_update %[[VAL_28]], %[[VAL_29]], %[[VAL_27]] : (!fir.array<?xf32>, f32, index) -> !fir.array<?xf32>
 108   ! CHECK:           fir.result %[[VAL_30]] : !fir.array<?xf32>
 109   ! CHECK:         }
 110   ! CHECK:         fir.array_merge_store %[[VAL_20]], %[[VAL_31:.*]] to %[[VAL_3]]{{\[}}%[[VAL_19]]] : !fir.array<?xf32>, !fir.array<?xf32>, !fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.slice<1>
 111   ! CHECK:         return
 112   ! CHECK:       }
 113
 114 subroutine arr_ptr_target_write(p)
 115   real, pointer :: p(:)
 116   real :: x(100)
 117   p(2:601:6) = x
 118 end subroutine
 119
 120 ! Assigning to contiguous pointer target in array expression
 121
 122   ! CHECK-LABEL: func @_QParr_contig_ptr_target_write(
 123   ! CHECK-SAME:                                       %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {{{.*}}, fir.contiguous}) {
 124   ! CHECK:         %[[VAL_1:.*]] = arith.constant 100 : index
 125   ! CHECK:         %[[VAL_2:.*]] = fir.alloca !fir.array<100xf32> {bindc_name = "x", uniq_name = "_QFarr_contig_ptr_target_writeEx"}
 126   ! CHECK:         %[[VAL_3:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
 127   ! CHECK:         %[[VAL_4:.*]] = arith.constant 0 : index
 128   ! CHECK:         %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]], %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
 129   ! CHECK:         %[[VAL_6:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
 130   ! CHECK:         %[[VAL_7:.*]] = arith.constant 2 : i64
 131   ! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
 132   ! CHECK:         %[[VAL_9:.*]] = arith.constant 6 : i64
 133   ! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index
 134   ! CHECK:         %[[VAL_11:.*]] = arith.constant 601 : i64
 135   ! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index
 136   ! CHECK:         %[[VAL_13:.*]] = arith.constant 0 : index
 137   ! CHECK:         %[[VAL_14:.*]] = arith.subi %[[VAL_12]], %[[VAL_8]] : index
 138   ! CHECK:         %[[VAL_15:.*]] = arith.addi %[[VAL_14]], %[[VAL_10]] : index
 139   ! CHECK:         %[[VAL_16:.*]] = arith.divsi %[[VAL_15]], %[[VAL_10]] : index
 140   ! CHECK:         %[[VAL_17:.*]] = arith.cmpi sgt, %[[VAL_16]], %[[VAL_13]] : index
 141   ! CHECK:         %[[VAL_18:.*]] = arith.select %[[VAL_17]], %[[VAL_16]], %[[VAL_13]] : index
 142   ! CHECK:         %[[VAL_19:.*]] = fir.shape_shift %[[VAL_5]]#0, %[[VAL_5]]#1 : (index, index) -> !fir.shapeshift<1>
 143   ! CHECK:         %[[VAL_20:.*]] = fir.slice %[[VAL_8]], %[[VAL_12]], %[[VAL_10]] : (index, index, index) -> !fir.slice<1>
 144   ! CHECK:         %[[VAL_21:.*]] = fir.array_load %[[VAL_6]](%[[VAL_19]]) {{\[}}%[[VAL_20]]] : (!fir.ptr<!fir.array<?xf32>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.array<?xf32>
 145   ! CHECK:         %[[VAL_22:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
 146   ! CHECK:         %[[VAL_23:.*]] = fir.array_load %[[VAL_2]](%[[VAL_22]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.array<100xf32>
 147   ! CHECK:         %[[VAL_24:.*]] = arith.constant 1 : index
 148   ! CHECK:         %[[VAL_25:.*]] = arith.constant 0 : index
 149   ! CHECK:         %[[VAL_26:.*]] = arith.subi %[[VAL_18]], %[[VAL_24]] : index
 150   ! CHECK:         %[[VAL_27:.*]] = fir.do_loop %[[VAL_28:.*]] = %[[VAL_25]] to %[[VAL_26]] step %[[VAL_24]] unordered iter_args(%[[VAL_29:.*]] = %[[VAL_21]]) -> (!fir.array<?xf32>) {
 151   ! CHECK:           %[[VAL_30:.*]] = fir.array_fetch %[[VAL_23]], %[[VAL_28]] : (!fir.array<100xf32>, index) -> f32
 152   ! CHECK:           %[[VAL_31:.*]] = fir.array_update %[[VAL_29]], %[[VAL_30]], %[[VAL_28]] : (!fir.array<?xf32>, f32, index) -> !fir.array<?xf32>
 153   ! CHECK:           fir.result %[[VAL_31]] : !fir.array<?xf32>
 154   ! CHECK:         }
 155   ! CHECK:         fir.array_merge_store %[[VAL_21]], %[[VAL_32:.*]] to %[[VAL_6]]{{\[}}%[[VAL_20]]] : !fir.array<?xf32>, !fir.array<?xf32>, !fir.ptr<!fir.array<?xf32>>, !fir.slice<1>
 156   ! CHECK:         return
 157   ! CHECK:       }
 158
 159 subroutine arr_contig_ptr_target_write(p)
 160   real, pointer, contiguous :: p(:)
 161   real :: x(100)
 162   p(2:601:6) = x
 163 end subroutine
 164
 165 ! CHECK-LABEL: func @_QPpointer_result_as_value
 166 subroutine pointer_result_as_value()
 167   ! Test that function pointer results used as values are correctly loaded.
 168   interface
 169     function returns_int_pointer()
 170       integer, pointer :: returns_int_pointer
 171     end function
 172   end interface
 173 ! CHECK:  %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<i32>> {bindc_name = ".result"}
 174 ! CHECK:  %[[VAL_6:.*]] = fir.call @_QPreturns_int_pointer() {{.*}}: () -> !fir.box<!fir.ptr<i32>>
 175 ! CHECK:  fir.save_result %[[VAL_6]] to %[[VAL_0]] : !fir.box<!fir.ptr<i32>>, !fir.ref<!fir.box<!fir.ptr<i32>>>
 176 ! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
 177 ! CHECK:  %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box<!fir.ptr<i32>>) -> !fir.ptr<i32>
 178 ! CHECK:  fir.load %[[VAL_8]] : !fir.ptr<i32>
 179   print *, returns_int_pointer()
 180 end subroutine