diff options
| -rw-r--r-- | gcc/fortran/openmp.c | 8 | ||||
| -rw-r--r-- | gcc/fortran/parse.c | 28 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures-2.f90 | 27 | ||||
| -rw-r--r-- | libgomp/testsuite/libgomp.oacc-fortran/routine-10.f90 | 52 |
4 files changed, 102 insertions, 13 deletions
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index b246308..94522d1 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2525,6 +2525,14 @@ gfc_match_oacc_routine (void) /* Something has gone wrong, possibly a syntax error. */ goto cleanup; + if (gfc_pure (NULL) && c && (c->gang || c->worker || c->vector)) + { + gfc_error ("!$ACC ROUTINE with GANG, WORKER, or VECTOR clause is not " + "permitted in PURE procedure at %C"); + goto cleanup; + } + + if (n) n->clauses = c; else if (gfc_current_ns->oacc_routine) diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 46e1e1b..3671513 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -639,20 +639,10 @@ decode_oacc_directive (void) gfc_matching_function = false; - if (gfc_pure (NULL)) - { - gfc_error_now ("OpenACC directives at %C may not appear in PURE " - "procedures"); - gfc_error_recovery (); - return ST_NONE; - } - if (gfc_current_state () == COMP_FUNCTION && gfc_current_block ()->result->ts.kind == -1) spec_only = true; - gfc_unset_implicit_pure (NULL); - old_locus = gfc_current_locus; /* General OpenACC directive matching: Instead of testing every possible @@ -663,6 +653,21 @@ decode_oacc_directive (void) switch (c) { + case 'r': + matcha ("routine", gfc_match_oacc_routine, ST_OACC_ROUTINE); + break; + } + + gfc_unset_implicit_pure (NULL); + if (gfc_pure (NULL)) + { + gfc_error_now ("OpenACC directives other than ROUTINE may not appear in PURE " + "procedures at %C"); + goto error_handling; + } + + switch (c) + { case 'a': matcha ("atomic", gfc_match_oacc_atomic, ST_OACC_ATOMIC); break; @@ -705,9 +710,6 @@ decode_oacc_directive (void) case 'l': matcha ("loop", gfc_match_oacc_loop, ST_OACC_LOOP); break; - case 'r': - match ("routine", gfc_match_oacc_routine, ST_OACC_ROUTINE); - break; case 's': matcha ("serial loop", gfc_match_oacc_serial_loop, ST_OACC_SERIAL_LOOP); matcha ("serial", gfc_match_oacc_serial, ST_OACC_SERIAL); diff --git a/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures-2.f90 b/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures-2.f90 new file mode 100644 index 0000000..97d92c3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures-2.f90 @@ -0,0 +1,27 @@ +pure elemental subroutine foo() +!$acc routine vector ! { dg-error "ROUTINE with GANG, WORKER, or VECTOR clause is not permitted in PURE procedure" } +end + +elemental subroutine foo2() +!$acc routine (myfoo2) gang ! { dg-error "Invalid NAME 'myfoo2' in" } +end + +elemental subroutine foo2a() +!$acc routine gang ! { dg-error "ROUTINE with GANG, WORKER, or VECTOR clause is not permitted in PURE procedure" } +end + +pure subroutine foo3() +!$acc routine vector ! { dg-error "ROUTINE with GANG, WORKER, or VECTOR clause is not permitted in PURE procedure" } +end + +elemental impure subroutine foo4() +!$acc routine vector ! OK: impure +end + +pure subroutine foo5() +!$acc routine seq ! OK: seq +end + +pure subroutine foo6() +!$acc routine ! OK (implied 'seq') +end diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-10.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-10.f90 new file mode 100644 index 0000000..90cca7c --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-10.f90 @@ -0,0 +1,52 @@ +! { dg-do run } +! +module m + implicit none +contains + pure subroutine add_ps_routine(a, b, c) + implicit none + !$acc routine seq + integer, intent(in) :: a, b + integer, intent(out) :: c + integer, parameter :: n = 10 + integer :: i + + do i = 1, n + if (i .eq. 5) then + c = a + b + end if + end do + end subroutine add_ps_routine + + elemental impure function add_ef(a, b) result(c) + implicit none + !$acc routine + integer, intent(in) :: a, b + integer :: c + + call add_ps_routine(a, b, c) + end function add_ef +end module m + +program main + use m + implicit none + integer, parameter :: n = 10 + integer, dimension(n) :: a_a + integer, dimension(n) :: b_a + integer, dimension(n) :: c_a + integer :: i + + a_a = [(3 * i, i = 1, n)] + b_a = [(-2 * i, i = 1, n)] + !$acc parallel copyin(a_a, b_a) copyout(c_a) + !$acc loop gang + do i = 1, n + if (i .eq. 4) then + c_a = add_ef(a_a, b_a) + end if + end do + !$acc end parallel + if (any (c_a /= [(i, i=1, 10)])) stop 1 + !print *, a +end program main |