1! RUN: bbc -emit-hlfir -fopenmp -o - %s | FileCheck %s 2 3subroutine sub(imax, jmax, x, y) 4 integer, intent(in) :: imax, jmax 5 real, intent(in), dimension(1:imax, 1:jmax) :: x, y 6 7 integer :: i, j, ii 8 9 ! collapse(2) is needed to reproduce the issue 10 !$omp parallel do collapse(2) 11 do j = 1, jmax 12 do i = 1, imax 13 do ii = 1, imax ! note that this loop is not collapsed 14 if (x(i,j) < y(ii,j)) then 15 ! exit needed to force unstructured control flow 16 exit 17 endif 18 enddo 19 enddo 20 enddo 21end subroutine sub 22 23! this is testing that we don't crash generating code for this: in particular 24! that all blocks are terminated 25 26! CHECK-LABEL: func.func @_QPsub( 27! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "imax"}, 28! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<i32> {fir.bindc_name = "jmax"}, 29! CHECK-SAME: %[[VAL_2:.*]]: !fir.ref<!fir.array<?x?xf32>> {fir.bindc_name = "x"}, 30! CHECK-SAME: %[[VAL_3:.*]]: !fir.ref<!fir.array<?x?xf32>> {fir.bindc_name = "y"}) { 31! [...] 32! CHECK: omp.wsloop { 33! CHECK-NEXT: omp.loop_nest (%[[VAL_53:.*]], %[[VAL_54:.*]]) : i32 = ({{.*}}) to ({{.*}}) inclusive step ({{.*}}) { 34! [...] 35! CHECK: cf.br ^bb1 36! CHECK: ^bb1: 37! CHECK: cf.br ^bb2 38! CHECK: ^bb2: 39! [...] 40! CHECK: cf.br ^bb3 41! CHECK: ^bb3: 42! [...] 43! CHECK: %[[VAL_63:.*]] = arith.cmpi sgt, %{{.*}}, %{{.*}} : i32 44! CHECK: cf.cond_br %[[VAL_63]], ^bb4, ^bb7 45! CHECK: ^bb4: 46! [...] 47! CHECK: %[[VAL_76:.*]] = arith.cmpf olt, %{{.*}}, %{{.*}} fastmath<contract> : f32 48! CHECK: cf.cond_br %[[VAL_76]], ^bb5, ^bb6 49! CHECK: ^bb5: 50! CHECK: cf.br ^bb7 51! CHECK: ^bb6: 52! [...] 53! CHECK: cf.br ^bb3 54! CHECK: ^bb7: 55! CHECK: omp.yield 56! CHECK: } 57! CHECK: } 58! CHECK: omp.terminator 59! CHECK: } 60! CHECK: cf.br ^bb1 61! CHECK: ^bb1: 62! CHECK: return 63! CHECK: } 64