Fortran: Improve OpenMP/OpenACC syntax diagnostic

The way the OpenMP and OpenACC parser is written is such that
when the directive name has been successfully matched, any error returned
by the match function should be real.

However, 'match_word' resets he locus to the before-match locus such
that all information is lost, except that error vs. no match data is
still available. Thus, for OpenMP and OpenACC, the error often was

  Unclassifiable OpenMP directive at (1)

which is odd when knowing that one used a supported directive; that
the caret pointed to the directive name did not really help, either.

With this commit, the match errors for OpenMP and OpenACC yield the
following error if no buffered message exists:

  Syntax error in statement at (1)

pointing the the current locus. (Still, a more explicit error
would be better, e.g. for many errors in 'omp declare reduction',
but still better than previously.)

gcc/fortran/ChangeLog:

	* parse.cc (match_word): Add no_substring and
	reject_stmt_on_error arguments, defaulting to false and true,
	respectively.
	(match_word_omp_simd): Do not reject_statement on error and
	enable no-substring matching.
	(matcha, matcho, matchdo): Call match_word with no_substring
	set to true and reject_stmt_on_error set to false.
	(decode_omp_directive): Distinguish unknown directive name from
	errors found during matching.
	(decode_oacc_directive): Likewise; use matcha not match.
	(matcha, matcho, matchdo, matchs, matchds): #undef after use.

gcc/testsuite/ChangeLog:

	* gfortran.dg/goacc/asyncwait-4.f95: Update dg-error.
	* gfortran.dg/goacc/routine-6.f90: Likewise.
	* gfortran.dg/gomp/udr1.f90: Likewise.
	* gfortran.dg/gomp/udr2.f90: Likewise.
	* gfortran.dg/gomp/udr4.f90: Likewise.
	* gfortran.dg/gomp/declare-reduction-2.f90: New test.

Author: tob2

gcc/fortran/parse.cc

@@ -72,23 +72,39 @@ static void reject_statement (void);
    input with the passed string.  If this succeeds, we call the
    keyword-dependent matching function that will match the rest of the
    statement.  For single keywords, the matching subroutine is
-   gfc_match_eos().  */
+   gfc_match_eos().
+
+   If NO_SUBSTRING, the keyword must be followed by a character not
+   permitted in a name (for free form); EOF is not handled here. Due
+   to fixed-form Fortran, longer keywords still need to be matched
+   before shorter substrings.
+
+   If REJECT_STMT_ON_ERROR is false, it is assumed that no error
+   recovery handling is needed.  */
 
 static match
-match_word (const char *str, match (*subr) (void), locus *old_locus)
+match_word (const char *str, match (*subr) (void), locus *old_locus,
+	    bool no_substring = false, bool reject_stmt_on_error = true)
 {
   match m;
+  char c;
 
   if (str != NULL)
     {
       m = gfc_match (str);
       if (m != MATCH_YES)
 	return m;
+      if (no_substring && gfc_current_form == FORM_FREE
+	  && ((c = gfc_peek_ascii_char ()) == '_' || c == '$' || ISALNUM (c)))
+	{
+	  gfc_current_locus = *old_locus;
+	  return MATCH_NO;
+	}
     }
 
   m = (*subr) ();
 
-  if (m != MATCH_YES)
+  if (m == MATCH_NO || (reject_stmt_on_error && m == MATCH_ERROR))
     {
       gfc_current_locus = *old_locus;
       reject_statement ();
@@ -99,24 +115,33 @@ match_word (const char *str, match (*subr) (void), locus *old_locus)
 
 
 /* Like match_word, but if str is matched, set a flag that it
-   was matched.  */
+   was matched. Note that reject_statement() is not called if
+   SUBR returned a match error - and no substring matching is
+   assumed.  */
 static match
 match_word_omp_simd (const char *str, match (*subr) (void), locus *old_locus,
 		     bool *simd_matched)
 {
   match m;
+  char c;
 
   if (str != NULL)
     {
       m = gfc_match (str);
       if (m != MATCH_YES)
 	return m;
+      if (gfc_current_form == FORM_FREE
+	  && ((c = gfc_peek_ascii_char ()) == '_' || c == '$' || ISALNUM (c)))
+	{
+	  gfc_current_locus = *old_locus;
+	  return MATCH_NO;
+	}
       *simd_matched = true;
     }
 
   m = (*subr) ();
 
-  if (m != MATCH_YES)
+  if (m == MATCH_NO)
     {
       gfc_current_locus = *old_locus;
       reject_statement ();
@@ -677,21 +702,20 @@ decode_statement (void)
 }
 
 /* Like match and if spec_only, goto do_spec_only without actually
-   matching.  */
-/* If the directive matched but the clauses failed, do not start
-   matching the next directive in the same switch statement. */
-#define matcha(keyword, subr, st)				\
-    do {							\
-      match m2;							\
-      if (spec_only && gfc_match (keyword) == MATCH_YES)	\
-	goto do_spec_only;					\
-      else if ((m2 = match_word (keyword, subr, &old_locus))	\
-	       == MATCH_YES)					\
-	return st;						\
-      else if (m2 == MATCH_ERROR)				\
-	goto error_handling;					\
-      else							\
-	undo_new_statement ();				  	\
+   matching.  If the directive matched but the parsing then failed,
+   do not start matching the next directive in the same switch statement.  */
+#define matcha(keyword, subr, st)					\
+    do {								\
+      match m2;								\
+      if (spec_only && gfc_match (keyword) == MATCH_YES)		\
+	goto do_spec_only;						\
+      else if ((m2 = match_word (keyword, subr, &old_locus, true,	\
+				 false)) == MATCH_YES)			\
+	return st;							\
+      else if (m2 == MATCH_ERROR)					\
+	goto error_handling;						\
+      else								\
+	undo_new_statement ();				  		\
     } while (0)
 
 static gfc_statement
@@ -745,7 +769,7 @@ decode_oacc_directive (void)
       break;
     case 'd':
       matcha ("data", gfc_match_oacc_data, ST_OACC_DATA);
-      match ("declare", gfc_match_oacc_declare, ST_OACC_DECLARE);
+      matcha ("declare", gfc_match_oacc_declare, ST_OACC_DECLARE);
       break;
     case 'e':
       matcha ("end atomic", gfc_match_omp_eos_error, ST_OACC_END_ATOMIC);
@@ -791,17 +815,19 @@ decode_oacc_directive (void)
       break;
     }
 
-  /* Directive not found or stored an error message.
-     Check and give up.  */
+  /* Directive not found. */
+  gfc_error_now ("Unclassifiable OpenACC directive at %C");
+  goto recover;
 
+  /* Directive found but failed with an error, possibly with
+     a stored an error message.  */
  error_handling:
   if (gfc_error_check () == 0)
-    gfc_error_now ("Unclassifiable OpenACC directive at %C");
+    gfc_error_now ("Syntax error in statement at %C");
 
+ recover:
   reject_statement ();
-
   gfc_error_recovery ();
-
   return ST_NONE;
 
  do_spec_only:
@@ -812,6 +838,8 @@ decode_oacc_directive (void)
   return ST_GET_FCN_CHARACTERISTICS;
 }
 
+#undef matcha
+
 /* Checks for the ST_OMP_ALLOCATE. First, check whether all list items
    are allocatables/pointers - and if so, assume it is associated with a Fortran
    ALLOCATE stmt.  If not, do some initial parsing-related checks and append
@@ -911,23 +939,23 @@ check_omp_allocate_stmt (locus *loc)
    and if spec_only, goto do_spec_only without actually matching.  */
 /* If the directive matched but the clauses failed, do not start
    matching the next directive in the same switch statement. */
-#define matcho(keyword, subr, st)				\
-    do {							\
-      match m2;							\
-      if (!flag_openmp)						\
-	;							\
-      else if (spec_only && gfc_match (keyword) == MATCH_YES)	\
-	goto do_spec_only;					\
-      else if ((m2 = match_word (keyword, subr, &old_locus))	\
-	       == MATCH_YES)					\
-	{							\
-	  ret = st;						\
-	  goto finish;						\
-	}							\
-      else if (m2 == MATCH_ERROR)				\
-	goto error_handling;					\
-      else							\
-	undo_new_statement ();				  	\
+#define matcho(keyword, subr, st)					\
+    do {								\
+      match m2;								\
+      if (!flag_openmp)							\
+	;								\
+      else if (spec_only && gfc_match (keyword) == MATCH_YES)		\
+	goto do_spec_only;						\
+      else if ((m2 = match_word (keyword, subr, &old_locus, true,	\
+				 false)) == MATCH_YES)			\
+	{								\
+	  ret = st;							\
+	  goto finish;							\
+	}								\
+      else if (m2 == MATCH_ERROR)					\
+	goto error_handling;						\
+      else								\
+	undo_new_statement ();				  		\
     } while (0)
 
 /* Like match, but set a flag simd_matched if keyword matched.  */
@@ -947,21 +975,21 @@ check_omp_allocate_stmt (locus *loc)
     } while (0)
 
 /* Like match, but don't match anything if not -fopenmp.  */
-#define matchdo(keyword, subr, st)				\
-    do {							\
-      match m2;							\
-      if (!flag_openmp)						\
-	;							\
-      else if ((m2 = match_word (keyword, subr, &old_locus))	\
-	       == MATCH_YES)					\
-	{							\
-	  ret = st;						\
-	  goto finish;						\
-	}							\
-      else if (m2 == MATCH_ERROR)				\
-	goto error_handling;					\
-      else							\
-	undo_new_statement ();				  	\
+#define matchdo(keyword, subr, st)					\
+    do {								\
+      match m2;								\
+      if (!flag_openmp)							\
+	;								\
+      else if ((m2 = match_word (keyword, subr, &old_locus, true,	\
+				 false)) == MATCH_YES)			\
+	{								\
+	  ret = st;							\
+	  goto finish;							\
+	}								\
+      else if (m2 == MATCH_ERROR)					\
+	goto error_handling;						\
+      else								\
+	undo_new_statement ();				  		\
     } while (0)
 
 static gfc_statement
@@ -1330,17 +1358,20 @@ decode_omp_directive (void)
       break;
     }
 
-  /* All else has failed, so give up.  See if any of the matchers has
-     stored an error message of some sort.  Don't error out if
-     not -fopenmp and simd_matched is false, i.e. if a directive other
-     than one marked with match has been seen.  */
+  /* Directive not found.  Don't error out if not -fopenmp and
+     simd_matched is false, i.e. if a directive other than one marked
+     with match has been seen.  */
+  if (flag_openmp || simd_matched)
+    gfc_error_now ("Unclassifiable OpenMP directive at %C");
+  goto recover;
 
  error_handling:
-  if (flag_openmp || simd_matched)
-    {
-      if (!gfc_error_check ())
-	gfc_error_now ("Unclassifiable OpenMP directive at %C");
-    }
+  /* Directive found but failed with an error, possibly with
+     a stored an error message.  */
+  if ((flag_openmp || simd_matched) && gfc_error_check () == 0)
+    gfc_error_now ("Syntax error in statement at %C");
+
+ recover:
 
   /* If parsing a metadirective, let the caller deal with the cleanup.  */
   if (gfc_matching_omp_context_selector)
@@ -1467,6 +1498,11 @@ decode_omp_directive (void)
   return ST_GET_FCN_CHARACTERISTICS;
 }
 
+#undef matchs
+#undef matcho
+#undef matchds
+#undef matchdo
+
 gfc_statement
 match_omp_directive (void)
 {

gcc/testsuite/gfortran.dg/goacc/asyncwait-4.f95

@@ -35,7 +35,7 @@ program asyncwait
 
   !$acc wait async 1 ! { dg-error "Failed to match clause" }
 
-  !$acc waitasync ! { dg-error "Failed to match clause" }
+  !$acc waitasync ! { dg-error "Unclassifiable OpenACC directive" }
 
   !$acc wait,async ! { dg-error "Failed to match clause" }
 end program asyncwait

gcc/testsuite/gfortran.dg/goacc/routine-6.f90

@@ -63,7 +63,7 @@ end program main
 ! Ensure that we recover from incomplete function definitions.
 
 integer function f1 ! { dg-error "Expected formal argument list in function definition" }
-  !$acc routine ! { dg-error "Unclassifiable OpenACC directive" }
+  !$acc routine ! { dg-error "16: Syntax error in statement" }
 end function f1 ! { dg-error "Expecting END PROGRAM statement" }
 
 subroutine subr1 (x) 

gcc/testsuite/gfortran.dg/gomp/declare-reduction-2.f90

@@ -0,0 +1,10 @@
+! Ensure that a someone sensible error message is printed
+
+type t
+end type t
+!$omp declare reduction(+:t)
+! { dg-error "28: Syntax error in statement at .1." "" { target *-*-* } .-1 }
+! { dg-bogus "Unclassifiable OpenMP directive" "" { target *-*-* } .-2 }
+
+
+end

gcc/testsuite/gfortran.dg/gomp/udr1.f90

@@ -22,7 +22,7 @@ subroutine f2
   end do
 end subroutine f2
 subroutine f3
-!$omp declare reduction (foo:blah:omp_out=omp_out + omp_in) ! { dg-error "Unclassifiable OpenMP directive" }
+!$omp declare reduction (foo:blah:omp_out=omp_out + omp_in) ! { dg-error "30: Syntax error in statement at .1." }
 end subroutine f3
 subroutine f4
 !$omp declare reduction (foo:integer:a => null()) ! { dg-error "Invalid character in name" }

gcc/testsuite/gfortran.dg/gomp/udr2.f90

@@ -1,13 +1,13 @@
 ! { dg-do compile }
 
 subroutine f6
-!$omp declare reduction (foo:real:omp_out (omp_in)) ! { dg-error "Unclassifiable OpenMP directive" }
-!$omp declare reduction (bar:real:omp_out = omp_in * omp_out) & ! { dg-error "Unclassifiable OpenMP directive" }
+!$omp declare reduction (foo:real:omp_out (omp_in)) ! { dg-error "35: Syntax error in statement at .1." }
+!$omp declare reduction (bar:real:omp_out = omp_in * omp_out) & ! { dg-error "35: Syntax error in statement at .1." }
 !$omp & initializer (omp_priv (omp_orig))
 end subroutine f6
 subroutine f7
   integer :: a
-!$omp declare reduction (foo:integer:a (omp_out, omp_in)) ! { dg-error "Unclassifiable OpenMP directive" }
+!$omp declare reduction (foo:integer:a (omp_out, omp_in)) ! { dg-error "38: Syntax error in statement at .1." }
 !$omp declare reduction (bar:real:omp_out = omp_out.or.omp_in) ! { dg-error "Operands of logical operator" }
 !$omp declare reduction (baz:real:omp_out = omp_out + omp_in)
 !$omp & initializer (a (omp_priv, omp_orig)) ! { dg-error "Unclassifiable OpenMP directive" }

gcc/testsuite/gfortran.dg/gomp/udr4.f90

@@ -1,10 +1,10 @@
 ! { dg-do compile }
 
 subroutine f3
-!$omp declare reduction ! { dg-error "Unclassifiable OpenMP directive" }
-!$omp declare reduction foo ! { dg-error "Unclassifiable OpenMP directive" }
-!$omp declare reduction (foo) ! { dg-error "Unclassifiable OpenMP directive" }
-!$omp declare reduction (foo:integer) ! { dg-error "Unclassifiable OpenMP directive" }
+!$omp declare reduction ! { dg-error "24: Syntax error in statement at .1." }
+!$omp declare reduction foo ! { dg-error "24: Syntax error in statement at .1." }
+!$omp declare reduction (foo) ! { dg-error "26: Syntax error in statement at .1." }
+!$omp declare reduction (foo:integer) ! { dg-error "37: Syntax error in statement at .1." }
 !$omp declare reduction (foo:integer:omp_out=omp_out+omp_in) &
 !$omp & initializer(omp_priv=0) initializer(omp_priv=0) ! { dg-error "Unexpected junk after" }
 end subroutine f3