libgomp/testsuite/libgomp.fortran/cancel-parallel-3.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 :: x, i, j
   7   common /x/ x
   8
   9   call omp_set_dynamic (.false.)
  10   call omp_set_schedule (omp_sched_static, 1)
  11   !$omp parallel num_threads(16) private (i, j)
  12     call do_some_work
  13     !$omp barrier
  14     if (omp_get_thread_num ().eq.1) then
  15       call sleep (2)
  16       !$omp cancellation point parallel
  17     end if
  18     do j = 3, 16
  19       !$omp do schedule(runtime)
  20         do i = 0, j - 1
  21           call do_some_work
  22         end do
  23       !$omp enddo nowait
  24     end do
  25     if (omp_get_thread_num ().eq.0) then
  26       call sleep (1)
  27       !$omp cancel parallel
  28     end if
  29   !$omp end parallel
  30 contains
  31   subroutine do_some_work
  32     integer :: x
  33     common /x/ x
  34     !$omp atomic
  35       x = x + 1
  36     !$omp end atomic
  37   endsubroutine do_some_work
  38 end