1! RUN: bbc -emit-hlfir -fopenmp -o - %s | FileCheck %s 2! RUN: %flang_fc1 -emit-hlfir -fopenmp -o - %s | FileCheck %s 3 4program main 5 implicit none 6 7 integer:: i 8 REAL(8) :: scalar 9 REAL(8) :: array(3,3) 10 11 scalar = 0 12 array = 0 13 14 !$omp parallel do reduction(+:scalar) reduction(+:array) 15 do i=1,10 16 scalar = i 17 array(1, 1) = i + 1 18 array(2, 2) = i + 2 19 array(3, 3) = i + 3 20 enddo 21 22 print *,scalar 23 print *,array 24 25endprogram 26 27! CHECK-LABEL: omp.declare_reduction @add_reduction_byref_box_3x3xf64 : !fir.ref<!fir.box<!fir.array<3x3xf64>>> alloc { 28! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.box<!fir.array<3x3xf64>> 29! CHECK: omp.yield(%[[VAL_3]] : !fir.ref<!fir.box<!fir.array<3x3xf64>>>) 30! CHECK-LABEL: } init { 31! CHECK: ^bb0(%[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.array<3x3xf64>>>, %[[ALLOC:.*]]: !fir.ref<!fir.box<!fir.array<3x3xf64>>>): 32! CHECK: %[[VAL_1:.*]] = arith.constant 0.000000e+00 : f64 33! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.array<3x3xf64>>> 34! CHECK: %[[VAL_4:.*]] = arith.constant 3 : index 35! CHECK: %[[VAL_5:.*]] = arith.constant 3 : index 36! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_4]], %[[VAL_5]] : (index, index) -> !fir.shape<2> 37! CHECK: %[[VAL_7:.*]] = fir.allocmem !fir.array<3x3xf64> {bindc_name = ".tmp", uniq_name = ""} 38! CHECK: %[[VAL_8:.*]] = arith.constant true 39! CHECK: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_7]](%[[VAL_6]]) {uniq_name = ".tmp"} : (!fir.heap<!fir.array<3x3xf64>>, !fir.shape<2>) -> (!fir.heap<!fir.array<3x3xf64>>, !fir.heap<!fir.array<3x3xf64>>) 40! CHECK: %[[VAL_10:.*]] = arith.constant 0 : index 41! CHECK: %[[VAL_11:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_10]] : (!fir.box<!fir.array<3x3xf64>>, index) -> (index, index, index) 42! CHECK: %[[VAL_12:.*]] = arith.constant 1 : index 43! CHECK: %[[VAL_13:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_12]] : (!fir.box<!fir.array<3x3xf64>>, index) -> (index, index, index) 44! CHECK: %[[VAL_14:.*]] = fir.shape_shift %[[VAL_11]]#0, %[[VAL_11]]#1, %[[VAL_13]]#0, %[[VAL_13]]#1 : (index, index, index, index) -> !fir.shapeshift<2> 45! CHECK: %[[VAL_15:.*]] = fir.embox %[[VAL_9]]#0(%[[VAL_14]]) : (!fir.heap<!fir.array<3x3xf64>>, !fir.shapeshift<2>) -> !fir.box<!fir.array<3x3xf64>> 46! CHECK: hlfir.assign %[[VAL_1]] to %[[VAL_15]] : f64, !fir.box<!fir.array<3x3xf64>> 47! CHECK: fir.store %[[VAL_15]] to %[[ALLOC]] : !fir.ref<!fir.box<!fir.array<3x3xf64>>> 48! CHECK: omp.yield(%[[ALLOC]] : !fir.ref<!fir.box<!fir.array<3x3xf64>>>) 49 50! CHECK-LABEL: } combiner { 51! CHECK: ^bb0(%[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.array<3x3xf64>>>, %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.array<3x3xf64>>>): 52! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.array<3x3xf64>>> 53! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.array<3x3xf64>>> 54! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index 55! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_4]] : (!fir.box<!fir.array<3x3xf64>>, index) -> (index, index, index) 56! CHECK: %[[VAL_6:.*]] = arith.constant 1 : index 57! CHECK: %[[VAL_7:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_6]] : (!fir.box<!fir.array<3x3xf64>>, index) -> (index, index, index) 58! CHECK: %[[VAL_8:.*]] = fir.shape_shift %[[VAL_5]]#0, %[[VAL_5]]#1, %[[VAL_7]]#0, %[[VAL_7]]#1 : (index, index, index, index) -> !fir.shapeshift<2> 59! CHECK: %[[VAL_9:.*]] = arith.constant 1 : index 60! CHECK: fir.do_loop %[[VAL_10:.*]] = %[[VAL_9]] to %[[VAL_7]]#1 step %[[VAL_9]] unordered { 61! CHECK: fir.do_loop %[[VAL_11:.*]] = %[[VAL_9]] to %[[VAL_5]]#1 step %[[VAL_9]] unordered { 62! CHECK: %[[VAL_12:.*]] = fir.array_coor %[[VAL_2]](%[[VAL_8]]) %[[VAL_11]], %[[VAL_10]] : (!fir.box<!fir.array<3x3xf64>>, !fir.shapeshift<2>, index, index) -> !fir.ref<f64> 63! CHECK: %[[VAL_13:.*]] = fir.array_coor %[[VAL_3]](%[[VAL_8]]) %[[VAL_11]], %[[VAL_10]] : (!fir.box<!fir.array<3x3xf64>>, !fir.shapeshift<2>, index, index) -> !fir.ref<f64> 64! CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_12]] : !fir.ref<f64> 65! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_13]] : !fir.ref<f64> 66! CHECK: %[[VAL_16:.*]] = arith.addf %[[VAL_14]], %[[VAL_15]] fastmath<contract> : f64 67! CHECK: fir.store %[[VAL_16]] to %[[VAL_12]] : !fir.ref<f64> 68! CHECK: } 69! CHECK: } 70! CHECK: omp.yield(%[[VAL_0]] : !fir.ref<!fir.box<!fir.array<3x3xf64>>>) 71 72! CHECK-LABEL: } cleanup { 73! CHECK: ^bb0(%[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.array<3x3xf64>>>): 74! CHECK: %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.array<3x3xf64>>> 75! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.box<!fir.array<3x3xf64>>) -> !fir.ref<!fir.array<3x3xf64>> 76! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.array<3x3xf64>>) -> i64 77! CHECK: %[[VAL_4:.*]] = arith.constant 0 : i64 78! CHECK: %[[VAL_5:.*]] = arith.cmpi ne, %[[VAL_3]], %[[VAL_4]] : i64 79! CHECK: fir.if %[[VAL_5]] { 80! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.array<3x3xf64>>) -> !fir.heap<!fir.array<3x3xf64>> 81! CHECK: fir.freemem %[[VAL_6]] : !fir.heap<!fir.array<3x3xf64>> 82! CHECK: } 83! CHECK: omp.yield 84! CHECK: } 85 86! CHECK-LABEL: omp.declare_reduction @add_reduction_f64 : f64 init { 87! CHECK: ^bb0(%[[VAL_0:.*]]: f64): 88! CHECK: %[[VAL_1:.*]] = arith.constant 0.000000e+00 : f64 89! CHECK: omp.yield(%[[VAL_1]] : f64) 90 91! CHECK-LABEL: } combiner { 92! CHECK: ^bb0(%[[VAL_0:.*]]: f64, %[[VAL_1:.*]]: f64): 93! CHECK: %[[VAL_2:.*]] = arith.addf %[[VAL_0]], %[[VAL_1]] fastmath<contract> : f64 94! CHECK: omp.yield(%[[VAL_2]] : f64) 95! CHECK: } 96 97! CHECK-LABEL: func.func @_QQmain() attributes {fir.bindc_name = "main"} { 98! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFEarray) : !fir.ref<!fir.array<3x3xf64>> 99! CHECK: %[[VAL_1:.*]] = arith.constant 3 : index 100! CHECK: %[[VAL_2:.*]] = arith.constant 3 : index 101! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_1]], %[[VAL_2]] : (index, index) -> !fir.shape<2> 102! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0]](%[[VAL_3]]) {uniq_name = "_QFEarray"} : (!fir.ref<!fir.array<3x3xf64>>, !fir.shape<2>) -> (!fir.ref<!fir.array<3x3xf64>>, !fir.ref<!fir.array<3x3xf64>>) 103! CHECK: %[[VAL_5:.*]] = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFEi"} 104! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]] {uniq_name = "_QFEi"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) 105! CHECK: %[[VAL_7:.*]] = fir.alloca f64 {bindc_name = "scalar", uniq_name = "_QFEscalar"} 106! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_7]] {uniq_name = "_QFEscalar"} : (!fir.ref<f64>) -> (!fir.ref<f64>, !fir.ref<f64>) 107! CHECK: %[[VAL_9:.*]] = arith.constant 0.000000e+00 : f64 108! CHECK: hlfir.assign %[[VAL_9]] to %[[VAL_8]]#0 : f64, !fir.ref<f64> 109! CHECK: %[[VAL_10:.*]] = arith.constant 0.000000e+00 : f64 110! CHECK: hlfir.assign %[[VAL_10]] to %[[VAL_4]]#0 : f64, !fir.ref<!fir.array<3x3xf64>> 111! CHECK: omp.parallel { 112! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_4]]#0(%[[VAL_3]]) : (!fir.ref<!fir.array<3x3xf64>>, !fir.shape<2>) -> !fir.box<!fir.array<3x3xf64>> 113! CHECK: %[[VAL_12:.*]] = fir.alloca !fir.box<!fir.array<3x3xf64>> 114! CHECK: fir.store %[[VAL_11]] to %[[VAL_12]] : !fir.ref<!fir.box<!fir.array<3x3xf64>>> 115! CHECK: %[[VAL_13:.*]] = fir.alloca i32 {bindc_name = "i", pinned, {{.*}}} 116! CHECK: %[[VAL_14:.*]]:2 = hlfir.declare %[[VAL_13]] {uniq_name = "_QFEi"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) 117! CHECK: %[[VAL_15:.*]] = arith.constant 1 : i32 118! CHECK: %[[VAL_16:.*]] = arith.constant 10 : i32 119! CHECK: %[[VAL_17:.*]] = arith.constant 1 : i32 120! CHECK: omp.wsloop reduction(@add_reduction_f64 %[[VAL_8]]#0 -> %[[VAL_18:.*]], byref @add_reduction_byref_box_3x3xf64 %[[VAL_12]] -> %[[VAL_19:.*]] : !fir.ref<f64>, !fir.ref<!fir.box<!fir.array<3x3xf64>>>) { 121! CHECK: omp.loop_nest (%[[VAL_20:.*]]) : i32 = (%[[VAL_15]]) to (%[[VAL_16]]) inclusive step (%[[VAL_17]]) { 122! CHECK: %[[VAL_21:.*]]:2 = hlfir.declare %[[VAL_18]] {uniq_name = "_QFEscalar"} : (!fir.ref<f64>) -> (!fir.ref<f64>, !fir.ref<f64>) 123! CHECK: %[[VAL_22:.*]]:2 = hlfir.declare %[[VAL_19]] {uniq_name = "_QFEarray"} : (!fir.ref<!fir.box<!fir.array<3x3xf64>>>) -> (!fir.ref<!fir.box<!fir.array<3x3xf64>>>, !fir.ref<!fir.box<!fir.array<3x3xf64>>>) 124! CHECK: fir.store %[[VAL_20]] to %[[VAL_14]]#1 : !fir.ref<i32> 125! CHECK: %[[VAL_23:.*]] = fir.load %[[VAL_14]]#0 : !fir.ref<i32> 126! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (i32) -> f64 127! CHECK: hlfir.assign %[[VAL_24]] to %[[VAL_21]]#0 : f64, !fir.ref<f64> 128! CHECK: %[[VAL_25:.*]] = fir.load %[[VAL_14]]#0 : !fir.ref<i32> 129! CHECK: %[[VAL_26:.*]] = arith.constant 1 : i32 130! CHECK: %[[VAL_27:.*]] = arith.addi %[[VAL_25]], %[[VAL_26]] : i32 131! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_27]] : (i32) -> f64 132! CHECK: %[[VAL_29:.*]] = fir.load %[[VAL_22]]#0 : !fir.ref<!fir.box<!fir.array<3x3xf64>>> 133! CHECK: %[[VAL_30:.*]] = arith.constant 1 : index 134! CHECK: %[[VAL_31:.*]] = arith.constant 1 : index 135! CHECK: %[[VAL_32:.*]] = hlfir.designate %[[VAL_29]] (%[[VAL_30]], %[[VAL_31]]) : (!fir.box<!fir.array<3x3xf64>>, index, index) -> !fir.ref<f64> 136! CHECK: hlfir.assign %[[VAL_28]] to %[[VAL_32]] : f64, !fir.ref<f64> 137! CHECK: %[[VAL_33:.*]] = fir.load %[[VAL_14]]#0 : !fir.ref<i32> 138! CHECK: %[[VAL_34:.*]] = arith.constant 2 : i32 139! CHECK: %[[VAL_35:.*]] = arith.addi %[[VAL_33]], %[[VAL_34]] : i32 140! CHECK: %[[VAL_36:.*]] = fir.convert %[[VAL_35]] : (i32) -> f64 141! CHECK: %[[VAL_37:.*]] = fir.load %[[VAL_22]]#0 : !fir.ref<!fir.box<!fir.array<3x3xf64>>> 142! CHECK: %[[VAL_38:.*]] = arith.constant 2 : index 143! CHECK: %[[VAL_39:.*]] = arith.constant 2 : index 144! CHECK: %[[VAL_40:.*]] = hlfir.designate %[[VAL_37]] (%[[VAL_38]], %[[VAL_39]]) : (!fir.box<!fir.array<3x3xf64>>, index, index) -> !fir.ref<f64> 145! CHECK: hlfir.assign %[[VAL_36]] to %[[VAL_40]] : f64, !fir.ref<f64> 146! CHECK: %[[VAL_41:.*]] = fir.load %[[VAL_14]]#0 : !fir.ref<i32> 147! CHECK: %[[VAL_42:.*]] = arith.constant 3 : i32 148! CHECK: %[[VAL_43:.*]] = arith.addi %[[VAL_41]], %[[VAL_42]] : i32 149! CHECK: %[[VAL_44:.*]] = fir.convert %[[VAL_43]] : (i32) -> f64 150! CHECK: %[[VAL_45:.*]] = fir.load %[[VAL_22]]#0 : !fir.ref<!fir.box<!fir.array<3x3xf64>>> 151! CHECK: %[[VAL_46:.*]] = arith.constant 3 : index 152! CHECK: %[[VAL_47:.*]] = arith.constant 3 : index 153! CHECK: %[[VAL_48:.*]] = hlfir.designate %[[VAL_45]] (%[[VAL_46]], %[[VAL_47]]) : (!fir.box<!fir.array<3x3xf64>>, index, index) -> !fir.ref<f64> 154! CHECK: hlfir.assign %[[VAL_44]] to %[[VAL_48]] : f64, !fir.ref<f64> 155! CHECK: omp.yield 156! CHECK: } 157! CHECK: } 158! CHECK: omp.terminator 159! CHECK: } 160 161! CHECK-LABEL: fir.global internal @_QFEarray : !fir.array<3x3xf64> { 162! CHECK: %[[VAL_0:.*]] = fir.zero_bits !fir.array<3x3xf64> 163! CHECK: fir.has_value %[[VAL_0]] : !fir.array<3x3xf64> 164! CHECK: } 165! CHECK: func.func private @_FortranAioBeginExternalListOutput(i32, !fir.ref<i8>, i32) -> !fir.ref<i8> attributes {fir.io, fir.runtime} 166