Thomas found a bug in the fortran routine parser where errors involving
invalid combinations of gang, worker, vector and seq clauses were
getting suppressed. This patch does two things:
1) It moves the error handling into gfc_match_oacc_routine. So now
gfc_oacc_routine_dims returns OACC_FUNCTION_NONE when it detects
an error. That's fine because it's ok for routines to default to
OACC_FUNCTION_SEQ.
2) It makes gfc_match_oacc_routine return a MATCH_ERROR when an error
has been detected in gfc_oacc_routine_dims.
This bug is also present in trunk, but I'd like to see my other fortran
module patch go in first. In the meantime, I'll commit this patch to
gomp-4_0-branch.
Cesar
2016-07-28 Cesar Philippidis <ce...@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.
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index c20a0a3..3c39836 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1877,7 +1877,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)
@@ -1908,7 +1909,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;
@@ -1923,6 +1924,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;
@@ -1991,6 +1993,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. */
;
@@ -2011,8 +2021,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;
gfc_current_ns->proc_name->attr.oacc_function_nohost
= c ? c->nohost : false;
}
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr72741.f90 b/gcc/testsuite/gfortran.dg/goacc/pr72741.f90
new file mode 100644
index 0000000..cf89727
--- /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
