1! PR fortran/79154
2! { dg-do compile }
3
4pure real function foo (a, b)
5  real, intent(in) :: a, b
6!$omp taskwait				! { dg-error "may not appear in PURE or ELEMENTAL" }
7  foo = a + b
8end function foo
9pure function bar (a, b)
10  real, intent(in) :: a(8), b(8)
11  real :: bar(8)
12  integer :: i
13!$omp do simd				! { dg-error "may not appear in PURE or ELEMENTAL" }
14  do i = 1, 8
15    bar(i) = a(i) + b(i)
16  end do
17end function bar
18pure function baz (a, b)
19  real, intent(in) :: a(8), b(8)
20  real :: baz(8)
21  integer :: i
22!$omp do				! { dg-error "may not appear in PURE or ELEMENTAL" }
23  do i = 1, 8
24    baz(i) = a(i) + b(i)
25  end do
26!$omp end do				! { dg-error "may not appear in PURE or ELEMENTAL" }
27end function baz
28pure real function baz2 (a, b)
29  real, intent(in) :: a, b
30!$omp target map(from:baz2)		! { dg-error "may not appear in PURE or ELEMENTAL" }
31  baz2 = a + b
32!$omp end target			! { dg-error "may not appear in PURE or ELEMENTAL" }
33end function baz2
34elemental real function fooe (a, b)
35  real, intent(in) :: a, b
36!$omp taskyield				! { dg-error "may not appear in PURE or ELEMENTAL" }
37  fooe = a + b
38end function fooe
39elemental real function baze (a, b)
40  real, intent(in) :: a, b
41!$omp target map(from:baz)		! { dg-error "may not appear in PURE or ELEMENTAL" }
42  baze = a + b
43!$omp end target			! { dg-error "may not appear in PURE or ELEMENTAL" }
44end function baze
45