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>>>{{.*}}) 7subroutine 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 20end 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>>>>{{.*}}) 25subroutine 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 47end 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>>>>{{.*}}) 52subroutine 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 60end 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}) 65subroutine 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 74end 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 114subroutine arr_ptr_target_write(p) 115 real, pointer :: p(:) 116 real :: x(100) 117 p(2:601:6) = x 118end 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 159subroutine arr_contig_ptr_target_write(p) 160 real, pointer, contiguous :: p(:) 161 real :: x(100) 162 p(2:601:6) = x 163end subroutine 164 165! CHECK-LABEL: func @_QPpointer_result_as_value 166subroutine 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() 180end subroutine 181