1! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s 2 3! CHECK-LABEL: associated_test 4! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>{{.*}}, %[[arg1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}) 5subroutine associated_test(scalar, array) 6 real, pointer :: scalar, array(:) 7 real, target :: ziel 8 ! CHECK: %[[ziel:.*]] = fir.alloca f32 {bindc_name = "ziel" 9 ! CHECK: %[[scalar:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.ptr<f32>>> 10 ! CHECK: %[[addr0:.*]] = fir.box_addr %[[scalar]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32> 11 ! CHECK: %[[addrToInt0:.*]] = fir.convert %[[addr0]] 12 ! CHECK: cmpi ne, %[[addrToInt0]], %c0{{.*}} 13 print *, associated(scalar) 14 ! CHECK: %[[array:.*]] = fir.load %[[arg1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 15 ! CHECK: %[[addr1:.*]] = fir.box_addr %[[array]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>> 16 ! CHECK: %[[addrToInt1:.*]] = fir.convert %[[addr1]] 17 ! CHECK: cmpi ne, %[[addrToInt1]], %c0{{.*}} 18 print *, associated(array) 19 ! CHECK: %[[zbox0:.*]] = fir.embox %[[ziel]] : (!fir.ref<f32>) -> !fir.box<f32> 20 ! CHECK: %[[scalar:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.ptr<f32>>> 21 ! CHECK: %[[sbox:.*]] = fir.convert %[[scalar]] : (!fir.box<!fir.ptr<f32>>) -> !fir.box<none> 22 ! CHECK: %[[zbox:.*]] = fir.convert %[[zbox0]] : (!fir.box<f32>) -> !fir.box<none> 23 ! CHECK: fir.call @_FortranAPointerIsAssociatedWith(%[[sbox]], %[[zbox]]) {{.*}}: (!fir.box<none>, !fir.box<none>) -> i1 24 print *, associated(scalar, ziel) 25 end subroutine 26 27 subroutine test_func_results() 28 interface 29 function get_pointer() 30 real, pointer :: get_pointer(:) 31 end function 32 end interface 33 ! CHECK: %[[result:.*]] = fir.call @_QPget_pointer() {{.*}}: () -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 34 ! CHECK: fir.save_result %[[result]] to %[[box_storage:.*]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 35 ! CHECK: %[[box:.*]] = fir.load %[[box_storage]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 36 ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>> 37 ! CHECK: %[[addr_cast:.*]] = fir.convert %[[addr]] : (!fir.ptr<!fir.array<?xf32>>) -> i64 38 ! CHECK: arith.cmpi ne, %[[addr_cast]], %c0{{.*}} : i64 39 print *, associated(get_pointer()) 40 end subroutine 41 42 ! CHECK-LABEL: func @_QPtest_optional_target_1( 43 ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "p"}, 44 ! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.array<10xf32>> {fir.bindc_name = "optionales_ziel", fir.optional, fir.target}) { 45 subroutine test_optional_target_1(p, optionales_ziel) 46 real, pointer :: p(:) 47 real, optional, target :: optionales_ziel(10) 48 print *, associated(p, optionales_ziel) 49 ! CHECK: %[[VAL_2:.*]] = arith.constant 10 : index 50 ! CHECK: %[[VAL_3:.*]] = fir.is_present %[[VAL_1]] : (!fir.ref<!fir.array<10xf32>>) -> i1 51 ! CHECK: %[[VAL_4:.*]] = fir.if %[[VAL_3]] -> (!fir.box<!fir.array<10xf32>>) { 52 ! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> 53 ! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_1]](%[[VAL_5]]) : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<10xf32>> 54 ! CHECK: fir.result %[[VAL_6]] : !fir.box<!fir.array<10xf32>> 55 ! CHECK: } else { 56 ! CHECK: %[[VAL_8:.*]] = fir.absent !fir.box<!fir.array<10xf32>> 57 ! CHECK: fir.result %[[VAL_8]] : !fir.box<!fir.array<10xf32>> 58 ! CHECK: } 59 ! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 60 ! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none> 61 ! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_4]] : (!fir.box<!fir.array<10xf32>>) -> !fir.box<none> 62 ! CHECK: fir.call @_FortranAPointerIsAssociatedWith(%[[VAL_14]], %[[VAL_15]]) {{.*}}: (!fir.box<none>, !fir.box<none>) -> i1 63 end subroutine 64 65 ! CHECK-LABEL: func @_QPtest_optional_target_2( 66 ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "p"}, 67 ! CHECK-SAME: %[[VAL_1:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "optionales_ziel", fir.optional, fir.target}) { 68 subroutine test_optional_target_2(p, optionales_ziel) 69 real, pointer :: p(:) 70 real, optional, target :: optionales_ziel(:) 71 print *, associated(p, optionales_ziel) 72 ! CHECK: %[[VAL_7:.*]] = fir.is_present %[[VAL_1]] : (!fir.box<!fir.array<?xf32>>) -> i1 73 ! CHECK: %[[VAL_8:.*]] = fir.if %[[VAL_7]] -> (!fir.box<!fir.array<?xf32>>) { 74 ! CHECK: fir.result %[[VAL_1]] : !fir.box<!fir.array<?xf32>> 75 ! CHECK: } else { 76 ! CHECK: %[[VAL_10:.*]] = fir.absent !fir.box<!fir.array<?xf32>> 77 ! CHECK: fir.result %[[VAL_10]] : !fir.box<!fir.array<?xf32>> 78 ! CHECK: } 79 ! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 80 ! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none> 81 ! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_8]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none> 82 ! CHECK: fir.call @_FortranAPointerIsAssociatedWith(%[[VAL_11]], %[[VAL_12]]) {{.*}}: (!fir.box<none>, !fir.box<none>) -> i1 83 end subroutine 84 85 ! CHECK-LABEL: func @_QPtest_optional_target_3( 86 ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "p"}, 87 ! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "optionales_ziel", fir.optional}) { 88 subroutine test_optional_target_3(p, optionales_ziel) 89 real, pointer :: p(:) 90 real, optional, pointer :: optionales_ziel(:) 91 print *, associated(p, optionales_ziel) 92 ! CHECK: %[[VAL_8:.*]] = fir.is_present %[[VAL_1]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> i1 93 ! CHECK: %[[VAL_9:.*]] = fir.if %[[VAL_8]] -> (!fir.box<!fir.ptr<!fir.array<?xf32>>>) { 94 ! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 95 ! CHECK: fir.result %[[VAL_10]] : !fir.box<!fir.ptr<!fir.array<?xf32>>> 96 ! CHECK: } else { 97 ! CHECK: %[[VAL_12:.*]] = fir.absent !fir.box<!fir.ptr<!fir.array<?xf32>>> 98 ! CHECK: fir.result %[[VAL_12]] : !fir.box<!fir.ptr<!fir.array<?xf32>>> 99 ! CHECK: } 100 ! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 101 ! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none> 102 ! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_9]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none> 103 ! CHECK: fir.call @_FortranAPointerIsAssociatedWith(%[[VAL_12]], %[[VAL_13]]) {{.*}}: (!fir.box<none>, !fir.box<none>) -> i1 104 end subroutine 105 106 ! CHECK-LABEL: func @_QPtest_optional_target_4( 107 ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "p"}, 108 ! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> {fir.bindc_name = "optionales_ziel", fir.optional, fir.target}) { 109 subroutine test_optional_target_4(p, optionales_ziel) 110 real, pointer :: p(:) 111 real, optional, allocatable, target :: optionales_ziel(:) 112 print *, associated(p, optionales_ziel) 113 ! CHECK: %[[VAL_8:.*]] = fir.is_present %[[VAL_1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> i1 114 ! CHECK: %[[VAL_9:.*]] = fir.if %[[VAL_8]] -> (!fir.box<!fir.heap<!fir.array<?xf32>>>) { 115 ! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 116 ! CHECK: fir.result %[[VAL_10]] : !fir.box<!fir.heap<!fir.array<?xf32>>> 117 ! CHECK: } else { 118 ! CHECK: %[[VAL_12:.*]] = fir.absent !fir.box<!fir.heap<!fir.array<?xf32>>> 119 ! CHECK: fir.result %[[VAL_12]] : !fir.box<!fir.heap<!fir.array<?xf32>>> 120 ! CHECK: } 121 ! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 122 ! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none> 123 ! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_9]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.box<none> 124 ! CHECK: fir.call @_FortranAPointerIsAssociatedWith(%[[VAL_12]], %[[VAL_13]]) {{.*}}: (!fir.box<none>, !fir.box<none>) -> i1 125 end subroutine 126 127 ! CHECK-LABEL: func @_QPtest_pointer_target( 128 ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "p"}, 129 ! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "pointer_ziel"}) { 130 subroutine test_pointer_target(p, pointer_ziel) 131 real, pointer :: p(:) 132 real, pointer :: pointer_ziel(:) 133 print *, associated(p, pointer_ziel) 134 ! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 135 ! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 136 ! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none> 137 ! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none> 138 ! CHECK: fir.call @_FortranAPointerIsAssociatedWith(%[[VAL_9]], %[[VAL_10]]) {{.*}}: (!fir.box<none>, !fir.box<none>) -> i1 139 end subroutine 140 141 ! CHECK-LABEL: func @_QPtest_allocatable_target( 142 ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "p"}, 143 ! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> {fir.bindc_name = "allocatable_ziel", fir.target}) { 144 subroutine test_allocatable_target(p, allocatable_ziel) 145 real, pointer :: p(:) 146 real, allocatable, target :: allocatable_ziel(:) 147 ! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 148 ! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 149 ! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none> 150 ! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.box<none> 151 ! CHECK: fir.call @_FortranAPointerIsAssociatedWith(%[[VAL_9]], %[[VAL_10]]) {{.*}}: (!fir.box<none>, !fir.box<none>) -> i1 152 print *, associated(p, allocatable_ziel) 153 end subroutine 154 155subroutine test_optional_argument(a, b) 156 integer, pointer :: a 157 integer, optional, pointer :: b 158 logical :: assoc 159 160 assoc = associated(a, b) 161end subroutine 162 163! CHECK-LABEL: func.func @_QPtest_optional_argument( 164! CHECK-SAME: %[[A:.*]]: !fir.ref<!fir.box<!fir.ptr<i32>>> {fir.bindc_name = "a"}, %[[B:.*]]: !fir.ref<!fir.box<!fir.ptr<i32>>> {fir.bindc_name = "b", fir.optional}) { 165! CHECK: %[[IS_PRESENT_B:.*]] = fir.is_present %[[B]] : (!fir.ref<!fir.box<!fir.ptr<i32>>>) -> i1 166! CHECK: %[[BOX_B:.*]] = fir.if %[[IS_PRESENT_B]] -> (!fir.box<!fir.ptr<i32>>) { 167! CHECK: %[[LOADED_B:.*]] = fir.load %[[B]] : !fir.ref<!fir.box<!fir.ptr<i32>>> 168! CHECK: fir.result %[[LOADED_B]] : !fir.box<!fir.ptr<i32>> 169! CHECK: } else { 170! CHECK: %[[ABSENT_B:.*]] = fir.absent !fir.box<!fir.ptr<i32>> 171! CHECK: fir.result %[[ABSENT_B]] : !fir.box<!fir.ptr<i32>> 172! CHECK: } 173! CHECK: %[[LOADED_A:.*]] = fir.load %[[A]] : !fir.ref<!fir.box<!fir.ptr<i32>>> 174! CHECK: %[[BOX_NONE_A:.*]] = fir.convert %[[LOADED_A]] : (!fir.box<!fir.ptr<i32>>) -> !fir.box<none> 175! CHECK: %[[BOX_NONE_B:.*]] = fir.convert %[[BOX_B]] : (!fir.box<!fir.ptr<i32>>) -> !fir.box<none> 176! CHECK: %{{.*}} fir.call @_FortranAPointerIsAssociatedWith(%[[BOX_NONE_A]], %[[BOX_NONE_B]]) fastmath<contract> : (!fir.box<none>, !fir.box<none>) -> i1 177