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" }
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" }
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" }
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" }
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" }
31  baz2 = a + b
32!$omp end target			! { dg-error "may not appear in PURE" }
33end function baz2
34! ELEMENTAL implies PURE
35elemental real function fooe (a, b)
36  real, intent(in) :: a, b
37!$omp taskyield				! { dg-error "may not appear in PURE" }
38  fooe = a + b
39end function fooe
40elemental real function baze (a, b)
41  real, intent(in) :: a, b
42!$omp target map(from:baz)		! { dg-error "may not appear in PURE" }
43  baze = a + b
44!$omp end target			! { dg-error "may not appear in PURE" }
45end function baze
46elemental impure real function fooei (a, b)
47  real, intent(in) :: a, b
48!$omp taskyield				! { dg-bogus "may not appear in PURE" }
49  fooe = a + b
50end function fooei
51elemental impure real function bazei (a, b)
52  real, intent(in) :: a, b
53!$omp target map(from:baz)		! { dg-bogus "may not appear in PURE" }
54  baze = a + b
55!$omp end target			! { dg-bogus "may not appear in PURE" }
56end function bazei
57