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).
7program 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        STOP 1
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        STOP 2
48     end if
49  end do
50
51end program foo
52! { dg-final { scan-tree-dump-times "__var" 0 "original" } }
53