gcc/testsuite/gfortran.dg/gomp/workshare2.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fopenmp -ffrontend-optimize -fdump-tree-original" }
   3 ! PR 50690 - this used to ICE because workshare could not handle
   4 ! BLOCKs.
   5 ! To test for correct execution, run this program (but don't forget
   6 ! to unset the stack limit).
   7 program foo
   8   implicit none
   9   integer, parameter :: n = 10000000
  10   real, parameter :: eps = 3e-7
  11   integer :: i,j
  12   real :: A(n), B(5), C(n)
  13   real :: tmp
  14   B(1) = 3.344
  15   tmp = B(1)
  16   do i=1,10
  17      call random_number(a)
  18      c = a
  19      !$omp parallel default(shared)
  20      !$omp workshare
  21      A(:) = A(:)*cos(B(1))+A(:)*cos(B(1))
  22      !$omp end workshare nowait
  23      !$omp end parallel ! sync is implied here
  24   end do
  25
  26   c = c*tmp + c*tmp
  27
  28   do j=1,n
  29      if (abs(a(j)-c(j)) > eps) then
  30         print *,1,j,a(j), c(j)
  31         call abort
  32      end if
  33   end do
  34
  35   do i=1,10
  36      call random_number(a)
  37      c = a
  38      !$omp parallel workshare default(shared)
  39      A(:) = A(:)*cos(B(1))+A(:)*cos(B(1))
  40      !$omp end parallel workshare
  41   end do
  42
  43   c = c*tmp + c*tmp
  44   do j=1,n
  45      if (abs(a(j)-c(j)) > eps) then
  46         print *,2,j,a(j), c(j)
  47         call abort
  48      end if
  49   end do
  50
  51 end program foo
  52 ! { dg-final { scan-tree-dump-times "__var" 0 "original" } }
  53 ! { dg-final { cleanup-tree-dump "original" } }