libgomp/testsuite/libgomp.fortran/cancel-do-2.f90

   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)
  13 contains
  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           call abort
  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) call abort
  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           call abort
  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) call abort
  89   end subroutine
  90 end