1! This test checks lowering of OpenMP DO Directive (Worksharing). 2 3! RUN: bbc -fopenmp -emit-hlfir %s -o - | FileCheck %s 4 5!CHECK-LABEL: func @_QPsimple_loop() 6subroutine simple_loop 7 integer :: i 8 ! CHECK: omp.parallel 9 !$OMP PARALLEL 10 ! CHECK: %[[ALLOCA_IV:.*]] = fir.alloca i32 {{{.*}}, pinned, {{.*}}} 11 ! CHECK: %[[IV_DECL:.*]]:2 = hlfir.declare %[[ALLOCA_IV]] {uniq_name = "_QFsimple_loopEi"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) 12 ! CHECK: %[[WS_LB:.*]] = arith.constant 1 : i32 13 ! CHECK: %[[WS_UB:.*]] = arith.constant 9 : i32 14 ! CHECK: %[[WS_STEP:.*]] = arith.constant 1 : i32 15 ! CHECK: omp.wsloop { 16 ! CHECK-NEXT: omp.loop_nest (%[[I:.*]]) : i32 = (%[[WS_LB]]) to (%[[WS_UB]]) inclusive step (%[[WS_STEP]]) { 17 !$OMP DO 18 do i=1, 9 19 ! CHECK: fir.store %[[I]] to %[[IV_DECL:.*]]#1 : !fir.ref<i32> 20 ! CHECK: %[[LOAD_IV:.*]] = fir.load %[[IV_DECL]]#0 : !fir.ref<i32> 21 ! CHECK: fir.call @_FortranAioOutputInteger32({{.*}}, %[[LOAD_IV]]) {{.*}}: (!fir.ref<i8>, i32) -> i1 22 print*, i 23 end do 24 ! CHECK: omp.yield 25 !$OMP END DO 26 ! CHECK: omp.terminator 27 !$OMP END PARALLEL 28end subroutine 29 30!CHECK-LABEL: func @_QPsimple_loop_with_step() 31subroutine simple_loop_with_step 32 integer :: i 33 ! CHECK: omp.parallel 34 !$OMP PARALLEL 35 ! CHECK: %[[ALLOCA_IV:.*]] = fir.alloca i32 {{{.*}}, pinned, {{.*}}} 36 ! CHECK: %[[IV_DECL:.*]]:2 = hlfir.declare %[[ALLOCA_IV]] {uniq_name = "_QFsimple_loop_with_stepEi"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) 37 ! CHECK: %[[WS_LB:.*]] = arith.constant 1 : i32 38 ! CHECK: %[[WS_UB:.*]] = arith.constant 9 : i32 39 ! CHECK: %[[WS_STEP:.*]] = arith.constant 2 : i32 40 ! CHECK: omp.wsloop { 41 ! CHECK-NEXT: omp.loop_nest (%[[I:.*]]) : i32 = (%[[WS_LB]]) to (%[[WS_UB]]) inclusive step (%[[WS_STEP]]) { 42 ! CHECK: fir.store %[[I]] to %[[IV_DECL]]#1 : !fir.ref<i32> 43 ! CHECK: %[[LOAD_IV:.*]] = fir.load %[[IV_DECL]]#0 : !fir.ref<i32> 44 !$OMP DO 45 do i=1, 9, 2 46 ! CHECK: fir.call @_FortranAioOutputInteger32({{.*}}, %[[LOAD_IV]]) {{.*}}: (!fir.ref<i8>, i32) -> i1 47 print*, i 48 end do 49 ! CHECK: omp.yield 50 !$OMP END DO 51 ! CHECK: omp.terminator 52 !$OMP END PARALLEL 53end subroutine 54 55!CHECK-LABEL: func @_QPloop_with_schedule_nowait() 56subroutine loop_with_schedule_nowait 57 integer :: i 58 ! CHECK: omp.parallel 59 !$OMP PARALLEL 60 ! CHECK: %[[ALLOCA_IV:.*]] = fir.alloca i32 {{{.*}}, pinned, {{.*}}} 61 ! CHECK: %[[IV_DECL:.*]]:2 = hlfir.declare %[[ALLOCA_IV]] {uniq_name = "_QFloop_with_schedule_nowaitEi"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) 62 ! CHECK: %[[WS_LB:.*]] = arith.constant 1 : i32 63 ! CHECK: %[[WS_UB:.*]] = arith.constant 9 : i32 64 ! CHECK: %[[WS_STEP:.*]] = arith.constant 1 : i32 65 ! CHECK: omp.wsloop nowait schedule(runtime) { 66 ! CHECK-NEXT: omp.loop_nest (%[[I:.*]]) : i32 = (%[[WS_LB]]) to (%[[WS_UB]]) inclusive step (%[[WS_STEP]]) { 67 !$OMP DO SCHEDULE(runtime) 68 do i=1, 9 69 ! CHECK: fir.store %[[I]] to %[[IV_DECL]]#1 : !fir.ref<i32> 70 ! CHECK: %[[LOAD_IV:.*]] = fir.load %[[IV_DECL]]#0 : !fir.ref<i32> 71 ! CHECK: fir.call @_FortranAioOutputInteger32({{.*}}, %[[LOAD_IV]]) {{.*}}: (!fir.ref<i8>, i32) -> i1 72 print*, i 73 end do 74 ! CHECK: omp.yield 75 !$OMP END DO NOWAIT 76 ! CHECK: omp.terminator 77 !$OMP END PARALLEL 78end subroutine 79