diff options
Diffstat (limited to 'gcc')
| -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 |