Hi, The original patch still missed some situations (thanks Cesar!) and the attached patch addresses those. It also adds some new tests.
Jim
Index: libgomp/ChangeLog.gomp =================================================================== --- libgomp/ChangeLog.gomp (revision 228245) +++ libgomp/ChangeLog.gomp (working copy) @@ -1,3 +1,7 @@ +2015-09-29 James Norris <jnor...@codesourcery.com> + + * testsuite/libgomp.oacc-fortran/routine-9.f90: New test. + 2015-09-29 Nathan Sidwell <nat...@codesourcery.com> * oacc-init.c (acc_on_device): Compile with optimization. Index: libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 =================================================================== --- libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 (revision 0) +++ libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 (revision 0) @@ -0,0 +1,31 @@ +! { dg-do run } +! { dg-options "-fno-inline" } + +program main + implicit none + integer, parameter :: n = 10 + integer :: a(n), i + integer, external :: fact + !$acc routine (fact) + !$acc parallel + !$acc loop + do i = 1, n + a(i) = fact (i) + end do + !$acc end parallel + do i = 1, n + if (a(i) .ne. fact(i)) call abort + end do +end program main + +recursive function fact (x) result (res) + implicit none + !$acc routine (fact) + integer, intent(in) :: x + integer :: res + if (x < 1) then + res = 1 + else + res = x * fact(x - 1) + end if +end function fact Index: gcc/testsuite/ChangeLog.gomp =================================================================== --- gcc/testsuite/ChangeLog.gomp (revision 228245) +++ gcc/testsuite/ChangeLog.gomp (working copy) @@ -1,3 +1,7 @@ +2015-08-29 James Norris <jnor...@codesourcery.com> + + * gfortran.dg/goacc/routine-6.f90: New test. + 2015-09-29 Tom de Vries <t...@codesourcery.com> * c-c++-common/goacc/kernels-acc-loop-smaller-equal.c: New test. Index: gcc/testsuite/gfortran.dg/goacc/routine-6.f90 =================================================================== --- gcc/testsuite/gfortran.dg/goacc/routine-6.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/goacc/routine-6.f90 (revision 0) @@ -0,0 +1,79 @@ + +module m + integer m1int +contains + subroutine subr5 (x) + implicit none + !$acc routine (subr5) + !$acc routine (m1int) ! { dg-error "invalid function name" } + integer, intent(inout) :: x + if (x < 1) then + x = 1 + else + x = x * x - 1 + end if + end subroutine subr5 +end module m + +program main + implicit none + interface + function subr6 (x) + !$acc routine (subr6) ! { dg-error "without list is allowed in interface" } + integer, intent (in) :: x + integer :: subr6 + end function subr6 + end interface + integer, parameter :: n = 10 + integer :: a(n), i + !$acc routine (subr1) ! { dg-error "invalid function name" } + external :: subr2 + !$acc routine (subr2) + !$acc parallel + !$acc loop + do i = 1, n + call subr1 (i) + call subr2 (i) + end do + !$acc end parallel +end program main + +subroutine subr1 (x) + !$acc routine + integer, intent(inout) :: x + if (x < 1) then + x = 1 + else + x = x * x - 1 + end if +end subroutine subr1 + +subroutine subr2 (x) + !$acc routine (subr1) ! { dg-error "invalid function name" } + integer, intent(inout) :: x + if (x < 1) then + x = 1 + else + x = x * x - 1 + end if +end subroutine subr2 + +subroutine subr3 (x) + !$acc routine (subr3) + integer, intent(inout) :: x + if (x < 1) then + x = 1 + else + call subr4 (x) + end if +end subroutine subr3 + +subroutine subr4 (x) + !$acc routine (subr4) + integer, intent(inout) :: x + if (x < 1) then + x = 1 + else + x = x * x - 1 + end if +end subroutine subr4 Index: gcc/fortran/openmp.c =================================================================== --- gcc/fortran/openmp.c (revision 228245) +++ gcc/fortran/openmp.c (working copy) @@ -1745,11 +1745,35 @@ gfc_match_oacc_routine (void) if (m == MATCH_YES) { - /* Scan for a function name/string. */ - m = gfc_match_symbol (&sym, 0); + char buffer[GFC_MAX_SYMBOL_LEN + 1]; + gfc_symtree *st; - if (m == MATCH_NO) + m = gfc_match_name (buffer); + if (m == MATCH_YES) { + st = gfc_find_symtree (gfc_current_ns->sym_root, buffer); + if (st) + { + sym = st->n.sym; + if (strcmp (sym->name, gfc_current_ns->proc_name->name) == 0) + sym = NULL; + } + + if (st == NULL + || (sym + && !sym->attr.external + && !sym->attr.function + && !sym->attr.subroutine)) + { + gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, " + "invalid function name %s", + (sym) ? sym->name : buffer); + gfc_current_locus = old_loc; + return MATCH_ERROR; + } + } + else + { gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C"); gfc_current_locus = old_loc; return MATCH_ERROR; @@ -1761,7 +1785,7 @@ gfc_match_oacc_routine (void) " ')' after NAME"); gfc_current_locus = old_loc; return MATCH_ERROR; - } + } } if (gfc_match_omp_eos () != MATCH_YES Index: gcc/fortran/ChangeLog.gomp =================================================================== --- gcc/fortran/ChangeLog.gomp (revision 228245) +++ gcc/fortran/ChangeLog.gomp (working copy) @@ -1,3 +1,8 @@ +2015-09-29 James Norris <jnor...@codesourcery.com> + + * openmp.c (gfc_match_oacc_routine): Add additional attribute testing + and name option checking. + 2015-09-28 James Norris <jnor...@codesourcery.com> * openmp.c (gfc_match_oacc_routine): Remove erroneous attribute test