1! RUN: bbc -emit-hlfir -fopenmp -o - %s | FileCheck %s 2! RUN: %flang_fc1 -emit-hlfir -fopenmp -o - %s | FileCheck %s 3 4module m1 5 intrinsic max 6end module m1 7program main 8 use m1, ren=>max 9 n=0 10 !$omp parallel reduction(ren:n) 11 print *, "par" 12 !$omp end parallel 13end program main 14 15! test that we understood that this should be a max reduction 16 17! CHECK-LABEL: omp.declare_reduction @max_i32 : i32 init { 18! CHECK: ^bb0(%[[VAL_0:.*]]: i32): 19! CHECK: %[[VAL_1:.*]] = arith.constant -2147483648 : i32 20! CHECK: omp.yield(%[[VAL_1]] : i32) 21 22! CHECK-LABEL: } combiner { 23! CHECK: ^bb0(%[[VAL_0:.*]]: i32, %[[VAL_1:.*]]: i32): 24! CHECK: %[[VAL_2:.*]] = arith.maxsi %[[VAL_0]], %[[VAL_1]] : i32 25! CHECK: omp.yield(%[[VAL_2]] : i32) 26! CHECK: } 27 28! CHECK-LABEL: func.func @_QQmain() attributes {fir.bindc_name = "main"} { 29! CHECK: %[[VAL_0:.*]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFEn"} 30! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFEn"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) 31! CHECK: %[[VAL_2:.*]] = arith.constant 0 : i32 32! CHECK: hlfir.assign %[[VAL_2]] to %[[VAL_1]]#0 : i32, !fir.ref<i32> 33! CHECK: omp.parallel reduction(@max_i32 %[[VAL_1]]#0 -> %[[VAL_3:.*]] : !fir.ref<i32>) { 34! ... 35! CHECK: omp.terminator 36 37