diff options
| author | cesar <cesar@138bc75d-0d04-0410-961f-82ee72b054a4> | 2016-07-29 04:20:00 +0000 |
|---|---|---|
| committer | Thomas Schwinge <thomas@codesourcery.com> | 2016-08-10 17:21:43 +0200 |
| commit | 1d112d38f9dd88c6060e98052ab118ef41649b38 (patch) | |
| tree | 82b52baac7e13fc5e99b8882e3629f83525a9e04 | |
| parent | b1c3318290a77117cc87cad136fd9618d94ffa52 (diff) | |
| download | gcc-1d112d38f9dd88c6060e98052ab118ef41649b38.tar.gz | |
Cesar's [gomp4] Fix PR72741
id:"579AD9C9.3030804@codesourcery.com"
PR fortran/72741
gcc/fortran/
* openmp.c (gfc_oacc_routine_dims): Move gfc_error to
gfc_match_oacc_routine. Return OACC_FUNCTION_NONE on error.
(gfc_match_oacc_routine): Call gfc_oacc_routine_dims for all
routines directives. Propagate error as appropriate.
gcc/testsuite/
* gfortran.dg/goacc/pr72741.f90: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gomp-4_0-branch@238847 138bc75d-0d04-0410-961f-82ee72b054a4
(cherry picked from commit d659e05a114160c31ad3e2bef2a11c959a444694)
| -rw-r--r-- | gcc/fortran/openmp.c | 17 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/goacc/pr72741.f90 | 28 |
2 files changed, 41 insertions, 4 deletions
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 5a8dc47799c..05e46613c6f 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1714,7 +1714,8 @@ gfc_match_oacc_cache (void) return MATCH_YES; } -/* Determine the loop level for a routine. */ +/* Determine the loop level for a routine. Returns OACC_FUNCTION_NONE if + any error is detected. */ static oacc_function gfc_oacc_routine_dims (gfc_omp_clauses *clauses) @@ -1745,7 +1746,7 @@ gfc_oacc_routine_dims (gfc_omp_clauses *clauses) level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level); if (mask != (mask & -mask)) - gfc_error ("Multiple loop axes specified for routine"); + ret = OACC_FUNCTION_NONE; } return ret; @@ -1760,6 +1761,7 @@ gfc_match_oacc_routine (void) gfc_omp_clauses *c = NULL; gfc_oacc_routine_name *n = NULL; gfc_intrinsic_sym *isym = NULL; + oacc_function dims = OACC_FUNCTION_NONE; old_loc = gfc_current_locus; @@ -1826,6 +1828,14 @@ gfc_match_oacc_routine (void) != MATCH_YES)) return MATCH_ERROR; + dims = gfc_oacc_routine_dims (c); + if (dims == OACC_FUNCTION_NONE) + { + gfc_error ("Multiple loop axes specified for routine %C"); + gfc_current_locus = old_loc; + return MATCH_ERROR; + } + if (isym != NULL) /* There is nothing to do for intrinsic procedures. */ ; @@ -1846,8 +1856,7 @@ gfc_match_oacc_routine (void) gfc_current_ns->proc_name->name, &old_loc)) goto cleanup; - gfc_current_ns->proc_name->attr.oacc_function - = gfc_oacc_routine_dims (c); + gfc_current_ns->proc_name->attr.oacc_function = dims; } if (n) diff --git a/gcc/testsuite/gfortran.dg/goacc/pr72741.f90 b/gcc/testsuite/gfortran.dg/goacc/pr72741.f90 new file mode 100644 index 00000000000..cf897276769 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/pr72741.f90 @@ -0,0 +1,28 @@ +SUBROUTINE v_1 + !$ACC ROUTINE VECTOR WORKER ! { dg-error "Multiple loop axes" } +END SUBROUTINE v_1 + +SUBROUTINE sub_1 + IMPLICIT NONE + EXTERNAL :: g_1 + !$ACC ROUTINE (g_1) GANG WORKER ! { dg-error "Multiple loop axes" } + !$ACC ROUTINE (ABORT) SEQ VECTOR ! { dg-error "Multiple loop axes" } + + CALL v_1 + CALL g_1 + CALL ABORT +END SUBROUTINE sub_1 + +MODULE m_w_1 + IMPLICIT NONE + EXTERNAL :: w_1 + !$ACC ROUTINE (w_1) WORKER SEQ ! { dg-error "Multiple loop axes" } + !$ACC ROUTINE (ABORT) VECTOR GANG ! { dg-error "Multiple loop axes" } + +CONTAINS + SUBROUTINE sub_2 + CALL v_1 + CALL w_1 + CALL ABORT + END SUBROUTINE sub_2 +END MODULE m_w_1 |