1! { dg-do compile }
2
3  integer, parameter :: n = 10
4  integer :: a(n), i
5  integer, external :: fact
6  i = 1
7  !$acc routine (fact)  ! { dg-error "Unexpected \\\!\\\$ACC ROUTINE" }
8  !$acc routine ()  ! { dg-error "Syntax error in \\\!\\\$ACC ROUTINE \\\( NAME \\\)" }
9  !$acc parallel
10  !$acc loop
11  do i = 1, n
12     a(i) = fact (i)
13     call incr (a(i))
14  end do
15  !$acc end parallel
16  do i = 1, n
17     write (*, "(I10)") a(i)
18  end do
19end
20recursive function fact (x) result (res)
21  integer, intent(in) :: x
22  integer :: res
23  res = 1
24  !$acc routine  ! { dg-error "Unexpected \\\!\\\$ACC ROUTINE" }
25  if (x < 1) then
26     res = 1
27  else
28     res = x * fact (x - 1)
29  end if
30end function fact
31subroutine incr (x)
32  integer, intent(inout) :: x
33  integer i
34  i = 0
35  !$acc routine  ! { dg-error "Unexpected \\\!\\\$ACC ROUTINE" }
36  x = x + 1
37end subroutine incr
38