[gomp4] Fix PR72741

[Cesar Philippidis <cesar at codesourcery dot com>]

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  <cesar@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