1! { dg-do run } 2! { dg-options "-fno-inline -fno-ipa-sra -fno-ipa-cp -fno-ipa-cp-clone" } 3! { dg-set-target-env-var OMP_CANCELLATION "true" } 4 5 use omp_lib 6 integer :: i 7 logical :: x(5) 8 9 x(:) = .false. 10 x(1) = .true. 11 x(3) = .true. 12 if (omp_get_cancellation ()) call foo (x) 13contains 14 subroutine foo (x) 15 use omp_lib 16 logical :: x(5) 17 integer :: v, w, i 18 19 v = 0 20 w = 0 21 !$omp parallel num_threads (32) shared (v, w) 22 !$omp do 23 do i = 0, 999 24 !$omp cancel do if (x(1)) 25 STOP 1 26 end do 27 !$omp do 28 do i = 0, 999 29 !$omp cancel do if (x(2)) 30 !$omp atomic 31 v = v + 1 32 !$omp endatomic 33 enddo 34 !$omp do 35 do i = 0, 999 36 !$omp cancel do if (x(3)) 37 !$omp atomic 38 w = w + 8 39 !$omp end atomic 40 end do 41 !$omp do 42 do i = 0, 999 43 !$omp cancel do if (x(4)) 44 !$omp atomic 45 v = v + 2 46 !$omp end atomic 47 end do 48 !$omp end do 49 !$omp end parallel 50 if (v.ne.3000.or.w.ne.0) STOP 2 51 !$omp parallel num_threads (32) shared (v, w) 52 ! None of these cancel directives should actually cancel anything, 53 ! but the compiler shouldn't know that and thus should use cancellable 54 ! barriers at the end of all the workshares. 55 !$omp cancel parallel if (omp_get_thread_num ().eq.1.and.x(5)) 56 !$omp do 57 do i = 0, 999 58 !$omp cancel do if (x(1)) 59 STOP 3 60 end do 61 !$omp cancel parallel if (omp_get_thread_num ().eq.2.and.x(5)) 62 !$omp do 63 do i = 0, 999 64 !$omp cancel do if (x(2)) 65 !$omp atomic 66 v = v + 1 67 !$omp endatomic 68 enddo 69 !$omp cancel parallel if (omp_get_thread_num ().eq.3.and.x(5)) 70 !$omp do 71 do i = 0, 999 72 !$omp cancel do if (x(3)) 73 !$omp atomic 74 w = w + 8 75 !$omp end atomic 76 end do 77 !$omp cancel parallel if (omp_get_thread_num ().eq.4.and.x(5)) 78 !$omp do 79 do i = 0, 999 80 !$omp cancel do if (x(4)) 81 !$omp atomic 82 v = v + 2 83 !$omp end atomic 84 end do 85 !$omp end do 86 !$omp cancel parallel if (omp_get_thread_num ().eq.5.and.x(5)) 87 !$omp end parallel 88 if (v.ne.6000.or.w.ne.0) STOP 4 89 end subroutine 90end 91