From 12df77ab6df4b91d4770240bcc4ab443e4bb18b9 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 16 Jun 2020 20:18:31 +0200 Subject: [PATCH] OpenACC/Fortran: permit 'routine' inside PURE gcc/fortran/ChangeLog * parse.c (decode_oacc_directive): Permit 'acc routine' also inside pure procedures. * openmp.c (gfc_match_oacc_routine): Inside pure procedures do not permit gang, worker or vector clauses. libgomp/ChangeLog: * testsuite/libgomp.oacc-fortran/routine-10.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/goacc/pure-elemental-procedures-2.f90: New test. Reviewed-by: Thomas Schwinge --- gcc/fortran/openmp.c | 8 +++ gcc/fortran/parse.c | 28 +++++----- .../goacc/pure-elemental-procedures-2.f90 | 27 ++++++++++ .../libgomp.oacc-fortran/routine-10.f90 | 52 +++++++++++++++++++ 4 files changed, 102 insertions(+), 13 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures-2.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/routine-10.f90 diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index b24630827c9..94522d16e6d 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 46e1e1b2698..36715134a2c 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 @@ -661,6 +651,21 @@ decode_oacc_directive (void) c = gfc_peek_ascii_char (); + 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': @@ -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 00000000000..97d92c3becc --- /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 00000000000..90cca7c1024 --- /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 -- 2.30.2