1! This test checks lowering of complex OpenACC data operands. 2 3! RUN: bbc -fopenacc -emit-hlfir %s -o - | FileCheck %s 4 5module acc_data_operand 6 7 type wrapper 8 real :: data(100) 9 end type 10 11contains 12 13! Testing array sections as operands 14subroutine acc_operand_array_section() 15 real, dimension(100) :: a 16 17 !$acc data copyin(a(1:50)) copyout(a(51:100)) 18 !$acc end data 19end subroutine 20 21! CHECK-LABEL: func.func @_QMacc_data_operandPacc_operand_array_section 22! CHECK: %[[EXT:.*]] = arith.constant 100 : index 23! CHECK: %[[ARR:.*]] = fir.alloca !fir.array<100xf32> 24! CHECK: %[[DECL:.*]]:2 = hlfir.declare %[[ARR]] 25! CHECK: %[[ONE:.*]] = arith.constant 1 : index 26! CHECK: %[[LB:.*]] = arith.constant 0 : index 27! CHECK: %[[UB:.*]] = arith.constant 49 : index 28! CHECK: %[[BOUND_1_50:.*]] = acc.bounds lowerbound(%[[LB]] : index) upperbound(%[[UB]] : index) extent(%[[EXT]] : index) stride(%[[ONE]] : index) startIdx(%[[ONE]] : index) 29! CHECK: %[[COPYIN:.*]] = acc.copyin varPtr(%[[DECL]]#0 : !fir.ref<!fir.array<100xf32>>) bounds(%[[BOUND_1_50]]) -> !fir.ref<!fir.array<100xf32>> {name = "a(1:50)"} 30! CHECK: %[[ONE:.*]] = arith.constant 1 : index 31! CHECK: %[[LB:.*]] = arith.constant 50 : index 32! CHECK: %[[UB:.*]] = arith.constant 99 : index 33! CHECK: %[[BOUND_51_100:.*]] = acc.bounds lowerbound(%[[LB]] : index) upperbound(%[[UB]] : index) extent(%[[EXT]] : index) stride(%[[ONE]] : index) startIdx(%[[ONE]] : index) 34! CHECK: %[[COPYOUT_CREATE:.*]] = acc.create varPtr(%[[DECL]]#0 : !fir.ref<!fir.array<100xf32>>) bounds(%[[BOUND_51_100]]) -> !fir.ref<!fir.array<100xf32>> {dataClause = #acc<data_clause acc_copyout>, name = "a(51:100)"} 35! CHECK: acc.data dataOperands(%[[COPYIN]], %[[COPYOUT_CREATE]] : !fir.ref<!fir.array<100xf32>>, !fir.ref<!fir.array<100xf32>>) { 36! CHECK: acc.terminator 37! CHECK: } 38! CHECK: acc.delete accPtr(%[[COPYIN]] : !fir.ref<!fir.array<100xf32>>) bounds(%[[BOUND_1_50]]) {dataClause = #acc<data_clause acc_copyin>, name = "a(1:50)"} 39! CHECK: acc.copyout accPtr(%[[COPYOUT_CREATE]] : !fir.ref<!fir.array<100xf32>>) bounds(%[[BOUND_51_100]]) to varPtr(%[[DECL]]#0 : !fir.ref<!fir.array<100xf32>>) {name = "a(51:100)"} 40 41! Testing array sections of a derived-type component 42subroutine acc_operand_array_section_component() 43 44 type(wrapper) :: w 45 46 !$acc data copy(w%data(1:20)) 47 !$acc end data 48end subroutine 49 50! CHECK-LABEL: func.func @_QMacc_data_operandPacc_operand_array_section_component() { 51! CHECK: %[[W:.*]] = fir.alloca !fir.type<_QMacc_data_operandTwrapper{data:!fir.array<100xf32>}> {bindc_name = "w", uniq_name = "_QMacc_data_operandFacc_operand_array_section_componentEw"} 52! CHECK: %[[DECLW:.*]]:2 = hlfir.declare %[[W]] 53! CHECK: %[[EXT:.*]] = arith.constant 100 : index 54! CHECK: %[[COORD_DATA:.*]] = hlfir.designate %[[DECLW]]#0{"data"} shape %{{.*}} : (!fir.ref<!fir.type<_QMacc_data_operandTwrapper{data:!fir.array<100xf32>}>>, !fir.shape<1>) -> !fir.ref<!fir.array<100xf32>> 55! CHECK: %[[ONE:.*]] = arith.constant 1 : index 56! CHECK: %[[LB:.*]] = arith.constant 0 : index 57! CHECK: %[[UB:.*]] = arith.constant 19 : index 58! CHECK: %[[BOUND:.*]] = acc.bounds lowerbound(%[[LB]] : index) upperbound(%[[UB]] : index) extent(%[[EXT]] : index) stride(%[[ONE]] : index) startIdx(%[[ONE]] : index) 59! CHECK: %[[COPY_COPYIN:.*]] = acc.copyin varPtr(%[[COORD_DATA]] : !fir.ref<!fir.array<100xf32>>) bounds(%[[BOUND]]) -> !fir.ref<!fir.array<100xf32>> {dataClause = #acc<data_clause acc_copy>, name = "w%data(1:20)"} 60! CHECK: acc.data dataOperands(%[[COPY_COPYIN]] : !fir.ref<!fir.array<100xf32>>) { 61! CHECK: acc.terminator 62! CHECK: } 63! CHECK: acc.copyout accPtr(%[[COPY_COPYIN]] : !fir.ref<!fir.array<100xf32>>) bounds(%[[BOUND]]) to varPtr(%[[COORD_DATA]] : !fir.ref<!fir.array<100xf32>>) {dataClause = #acc<data_clause acc_copy>, name = "w%data(1:20)"} 64 65! Testing derived-type component without section 66subroutine acc_operand_derived_type_component() 67 type(wrapper) :: w 68 69 !$acc data copy(w%data) 70 !$acc end data 71end subroutine 72 73! CHECK-LABEL: func.func @_QMacc_data_operandPacc_operand_derived_type_component() { 74! CHECK: %[[W:.*]] = fir.alloca !fir.type<_QMacc_data_operandTwrapper{data:!fir.array<100xf32>}> {bindc_name = "w", uniq_name = "_QMacc_data_operandFacc_operand_derived_type_componentEw"} 75! CHECK: %[[DECLW:.*]]:2 = hlfir.declare %[[W]] 76! CHECK: %[[EXT:.*]] = arith.constant 100 : index 77! CHECK: %[[COORD_DATA:.*]] = hlfir.designate %[[DECLW]]#0{"data"} shape %{{.*}} : (!fir.ref<!fir.type<_QMacc_data_operandTwrapper{data:!fir.array<100xf32>}>>, !fir.shape<1>) -> !fir.ref<!fir.array<100xf32>> 78! CHECK: %[[ONE:.*]] = arith.constant 1 : index 79! CHECK: %[[LB:.*]] = arith.constant 0 : index 80! CHECK: %[[UB:.*]] = arith.subi %[[EXT]], %[[ONE]] : index 81! CHECK: %[[BOUND:.*]] = acc.bounds lowerbound(%[[LB]] : index) upperbound(%[[UB]] : index) extent(%[[EXT]] : index) stride(%[[ONE]] : index) startIdx(%[[ONE]] : index) 82! CHECK: %[[COPY_COPYIN:.*]] = acc.copyin varPtr(%[[COORD_DATA]] : !fir.ref<!fir.array<100xf32>>) bounds(%[[BOUND]]) -> !fir.ref<!fir.array<100xf32>> {dataClause = #acc<data_clause acc_copy>, name = "w%data"} 83! CHECK: acc.data dataOperands(%[[COPY_COPYIN]] : !fir.ref<!fir.array<100xf32>>) { 84! CHECK: acc.terminator 85! CHECK: } 86! CHECK: acc.copyout accPtr(%[[COPY_COPYIN]] : !fir.ref<!fir.array<100xf32>>) bounds(%[[BOUND]]) to varPtr(%[[COORD_DATA]] : !fir.ref<!fir.array<100xf32>>) {dataClause = #acc<data_clause acc_copy>, name = "w%data"} 87 88 89! Testing array of derived-type component without section 90subroutine acc_operand_array_derived_type_component() 91 type(wrapper) :: w(10) 92 93 !$acc data copy(w(1)%data) 94 !$acc end data 95end subroutine 96 97! CHECK-LABEL: func.func @_QMacc_data_operandPacc_operand_array_derived_type_component() { 98! CHECK: %[[W:.*]] = fir.alloca !fir.array<10x!fir.type<_QMacc_data_operandTwrapper{data:!fir.array<100xf32>}>> {bindc_name = "w", uniq_name = "_QMacc_data_operandFacc_operand_array_derived_type_componentEw"} 99! CHECK: %[[DECLW:.*]]:2 = hlfir.declare %[[W]] 100! CHECK: %[[C1:.*]] = arith.constant 1 : index 101! CHECK: %[[W_1:.*]] = hlfir.designate %[[DECLW]]#0 (%[[C1]]) : (!fir.ref<!fir.array<10x!fir.type<_QMacc_data_operandTwrapper{data:!fir.array<100xf32>}>>>, index) -> !fir.ref<!fir.type<_QMacc_data_operandTwrapper{data:!fir.array<100xf32>}>> 102! CHECK: %[[EXT:.*]] = arith.constant 100 : index 103! CHECK: %[[COORD_W1_DATA:.*]] = hlfir.designate %[[W_1]]{"data"} shape %{{.*}} : (!fir.ref<!fir.type<_QMacc_data_operandTwrapper{data:!fir.array<100xf32>}>>, !fir.shape<1>) -> !fir.ref<!fir.array<100xf32>> 104! CHECK: %[[ONE:.*]] = arith.constant 1 : index 105! CHECK: %[[LB:.*]] = arith.constant 0 : index 106! CHECK: %[[UB:.*]] = arith.subi %[[EXT]], %[[ONE]] : index 107! CHECK: %[[BOUND:.*]] = acc.bounds lowerbound(%[[LB]] : index) upperbound(%[[UB]] : index) extent(%[[EXT]] : index) stride(%[[ONE]] : index) startIdx(%[[ONE]] : index) 108! CHECK: %[[COPY_COPYIN:.*]] = acc.copyin varPtr(%[[COORD_W1_DATA]] : !fir.ref<!fir.array<100xf32>>) bounds(%[[BOUND]]) -> !fir.ref<!fir.array<100xf32>> {dataClause = #acc<data_clause acc_copy>, name = "w(1_8)%data"} 109! CHECK: acc.data dataOperands(%[[COPY_COPYIN]] : !fir.ref<!fir.array<100xf32>>) { 110! CHECK: acc.terminator 111! CHECK: } 112! CHECK: acc.copyout accPtr(%[[COPY_COPYIN]] : !fir.ref<!fir.array<100xf32>>) bounds(%[[BOUND]]) to varPtr(%[[COORD_W1_DATA]] : !fir.ref<!fir.array<100xf32>>) {dataClause = #acc<data_clause acc_copy>, name = "w(1_8)%data"} 113 114! Testing array sections on allocatable array 115subroutine acc_operand_array_section_allocatable() 116 real, allocatable :: a(:) 117 118 allocate(a(100)) 119 120 !$acc data copyin(a(1:50)) copyout(a(51:100)) 121 !$acc end data 122 123 deallocate(a) 124end subroutine 125 126! CHECK-LABEL: func.func @_QMacc_data_operandPacc_operand_array_section_allocatable() { 127! CHECK: %[[A:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>> {bindc_name = "a", uniq_name = "_QMacc_data_operandFacc_operand_array_section_allocatableEa"} 128! CHECK: %[[DECLA:.*]]:2 = hlfir.declare %[[A]] {fortran_attrs = #fir.var_attrs<allocatable> 129! CHECK: %[[LOAD_BOX_A_0:.*]] = fir.load %[[DECLA]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 130! CHECK: %[[LOAD_BOX_A_1:.*]] = fir.load %[[DECLA]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 131! CHECK: %[[C0:.*]] = arith.constant 0 : index 132! CHECK: %[[DIMS0_0:.*]]:3 = fir.box_dims %[[LOAD_BOX_A_1]], %[[C0]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index) 133! CHECK: %[[C0:.*]] = arith.constant 0 : index 134! CHECK: %[[DIMS0_1:.*]]:3 = fir.box_dims %[[LOAD_BOX_A_0]], %[[C0]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index) 135! CHECK: %[[C1:.*]] = arith.constant 1 : index 136! CHECK: %[[LB:.*]] = arith.subi %[[C1]], %[[DIMS0_0]]#0 : index 137! CHECK: %[[C50:.*]] = arith.constant 50 : index 138! CHECK: %[[UB:.*]] = arith.subi %[[C50]], %[[DIMS0_0]]#0 : index 139! CHECK: %[[LOAD_BOX_A_2:.*]] = fir.load %[[DECLA]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 140! CHECK: %[[C0:.*]] = arith.constant 0 : index 141! CHECK: %[[DIMS0_2:.*]]:3 = fir.box_dims %[[LOAD_BOX_A_2]], %[[C0]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index) 142! CHECK: %[[BOUND_1_50:.*]] = acc.bounds lowerbound(%[[LB]] : index) upperbound(%[[UB]] : index) extent(%[[DIMS0_2]]#1 : index) stride(%[[DIMS0_1]]#2 : index) startIdx(%[[DIMS0_0]]#0 : index) {strideInBytes = true} 143! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[LOAD_BOX_A_0]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>> 144! CHECK: %[[COPYIN:.*]] = acc.copyin varPtr(%[[BOX_ADDR]] : !fir.heap<!fir.array<?xf32>>) bounds(%[[BOUND_1_50]]) -> !fir.heap<!fir.array<?xf32>> {name = "a(1:50)"} 145! CHECK: %[[LOAD_BOX_A_0:.*]] = fir.load %[[DECLA]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 146! CHECK: %[[LOAD_BOX_A_1:.*]] = fir.load %[[DECLA]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 147! CHECK: %[[C0:.*]] = arith.constant 0 : index 148! CHECK: %[[DIMS0_0:.*]]:3 = fir.box_dims %[[LOAD_BOX_A_1]], %[[C0]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index) 149! CHECK: %[[C0:.*]] = arith.constant 0 : index 150! CHECK: %[[DIMS0_1:.*]]:3 = fir.box_dims %[[LOAD_BOX_A_0]], %[[C0]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index) 151! CHECK: %[[C51:.*]] = arith.constant 51 : index 152! CHECK: %[[LB:.*]] = arith.subi %[[C51]], %[[DIMS0_0]]#0 : index 153! CHECK: %[[C100:.*]] = arith.constant 100 : index 154! CHECK: %[[UB:.*]] = arith.subi %[[C100]], %[[DIMS0_0]]#0 : index 155! CHECK: %[[LOAD_BOX_A_2:.*]] = fir.load %[[DECLA]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 156! CHECK: %[[C0:.*]] = arith.constant 0 : index 157! CHECK: %[[DIMS0_2:.*]]:3 = fir.box_dims %[[LOAD_BOX_A_2]], %[[C0]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index) 158! CHECK: %[[BOUND_51_100:.*]] = acc.bounds lowerbound(%[[LB]] : index) upperbound(%[[UB]] : index) extent(%[[DIMS0_2]]#1 : index) stride(%[[DIMS0_1]]#2 : index) startIdx(%[[DIMS0_0]]#0 : index) {strideInBytes = true} 159! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[LOAD_BOX_A_0]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>> 160! CHECK: %[[COPYOUT_CREATE:.*]] = acc.create varPtr(%[[BOX_ADDR]] : !fir.heap<!fir.array<?xf32>>) bounds(%[[BOUND_51_100]]) -> !fir.heap<!fir.array<?xf32>> {dataClause = #acc<data_clause acc_copyout>, name = "a(51:100)"} 161! CHECK: acc.data dataOperands(%[[COPYIN]], %[[COPYOUT_CREATE]] : !fir.heap<!fir.array<?xf32>>, !fir.heap<!fir.array<?xf32>>) { 162! CHECK: acc.terminator 163! CHECK: } 164! CHECK: acc.delete accPtr(%[[COPYIN]] : !fir.heap<!fir.array<?xf32>>) bounds(%[[BOUND_1_50]]) {dataClause = #acc<data_clause acc_copyin>, name = "a(1:50)"} 165! CHECK: acc.copyout accPtr(%[[COPYOUT_CREATE]] : !fir.heap<!fir.array<?xf32>>) bounds(%[[BOUND_51_100]]) to varPtr(%[[BOX_ADDR]] : !fir.heap<!fir.array<?xf32>>) {name = "a(51:100)"} 166 167 168! Testing array sections on pointer array 169subroutine acc_operand_array_section_pointer() 170 real, target :: a(100) 171 real, pointer :: p(:) 172 173 p => a 174 175 !$acc data copyin(p(1:50)) 176 !$acc end data 177end subroutine 178 179! CHECK-LABEL: func.func @_QMacc_data_operandPacc_operand_array_section_pointer() { 180! CHECK: %[[P:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = "p", uniq_name = "_QMacc_data_operandFacc_operand_array_section_pointerEp"} 181! CHECK: %[[DECLP:.*]]:2 = hlfir.declare %[[P]] {fortran_attrs = #fir.var_attrs<pointer> 182! CHECK: %[[LOAD_BOX_P_0:.*]] = fir.load %[[DECLP]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 183! CHECK: %[[LOAD_BOX_P_1:.*]] = fir.load %[[DECLP]]#1 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 184! CHECK: %[[C0:.*]] = arith.constant 0 : index 185! CHECK: %[[DIMS0_0:.*]]:3 = fir.box_dims %[[LOAD_BOX_P_1]], %[[C0:.*]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index) 186! CHECK: %[[C0:.*]] = arith.constant 0 : index 187! CHECK: %[[DIMS0_1:.*]]:3 = fir.box_dims %[[LOAD_BOX_P_0]], %[[C0]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index) 188! CHECK: %[[C1:.*]] = arith.constant 1 : index 189! CHECK: %[[LB:.*]] = arith.subi %[[C1]], %[[DIMS0_0]]#0 : index 190! CHECK: %[[C50:.*]] = arith.constant 50 : index 191! CHECK: %[[UB:.*]] = arith.subi %[[C50]], %[[DIMS0_0]]#0 : index 192! CHECK: %[[LOAD_BOX_P_2:.*]] = fir.load %[[DECLP]]#1 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 193! CHECK: %[[C0:.*]] = arith.constant 0 : index 194! CHECK: %[[DIMS0_2:.*]]:3 = fir.box_dims %[[LOAD_BOX_P_2]], %[[C0]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index) 195! CHECK: %[[BOUND:.*]] = acc.bounds lowerbound(%[[LB]] : index) upperbound(%[[UB]] : index) extent(%[[DIMS0_2]]#1 : index) stride(%[[DIMS0_1]]#2 : index) startIdx(%[[DIMS0_0]]#0 : index) {strideInBytes = true} 196! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[LOAD_BOX_P_0]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>> 197! CHECK: %[[COPYIN:.*]] = acc.copyin varPtr(%[[BOX_ADDR]] : !fir.ptr<!fir.array<?xf32>>) bounds(%[[BOUND]]) -> !fir.ptr<!fir.array<?xf32>> {name = "p(1:50)"} 198! CHECK: acc.data dataOperands(%[[COPYIN]] : !fir.ptr<!fir.array<?xf32>>) { 199! CHECK: acc.terminator 200! CHECK: } 201! CHECK: acc.delete accPtr(%[[COPYIN]] : !fir.ptr<!fir.array<?xf32>>) bounds(%[[BOUND]]) {dataClause = #acc<data_clause acc_copyin>, name = "p(1:50)"} 202 203 204end module 205