This affects the generic 'parse.c' i.e. someone else might want
to have a look - and comments in general are welcome, however,
the change should only affect OpenMP/OpenACC as the new
match_word booleans default to the current behavior.
* * *
The MOTIVATION for this patch was in particular 'omp declare reduction'
that has both a rather complex syntax and often just shows the error
3 | !$omp declare reduction(+:t)
| 1
Error: Unclassifiable OpenMP directive at (1)
pointing to the directive name instead to the location where actually
something went wrong. Additionally, unknown directive and parsing
error are two separate things - and should have different error
messages!
The new code produces:
3 | !$omp declare reduction(+:t)
| 1
Error: Syntax error in statement at (1)
which shows that the directive is known and points to the column
where the error occurred.
(Still, 'declare reduction' could be made much more user friendly.)
* * *
Note:
As the parsing is rather complex and fragile, the 'follows space'
check is handled as after eating the directive name + peeking at
the next character instead of matching keyword + " " as that will
fail with the current assumptions in openmp.cc. While it only
works with free form text, it permits to state for 'cancellation'
that that's unknown - while for fixed form it complains
after 'cancel' that 'lation' is a syntax error, which is not as
nice but also works.
Likewise, for not resetting the parsing after MATCH_ERROR: This
will cause a few errors with the current testsuite, depending how
exactly one implements it. Thus, it is not used.
If there are no comments, I will apply this patch later today.
(Later comments are welcome as well.)
Tobias
PS: Looks as if 'declare reduction' could do with some more
explicit error diagnostic.
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.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/declare-reduction-2.f90: New test.
gcc/fortran/parse.cc | 170 +++++++++++++--------
gcc/testsuite/gfortran.dg/goacc/asyncwait-4.f95 | 2 +-
gcc/testsuite/gfortran.dg/goacc/routine-6.f90 | 2 +-
.../gfortran.dg/gomp/declare-reduction-2.f90 | 10 ++
gcc/testsuite/gfortran.dg/gomp/udr1.f90 | 2 +-
gcc/testsuite/gfortran.dg/gomp/udr2.f90 | 6 +-
gcc/testsuite/gfortran.dg/gomp/udr4.f90 | 8 +-
7 files changed, 123 insertions(+), 77 deletions(-)
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 7fec02c1259..7b6cf525a80 100644
--- a/gcc/fortran/parse.cc
+++ b/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)
{
diff --git a/gcc/testsuite/gfortran.dg/goacc/asyncwait-4.f95 b/gcc/testsuite/gfortran.dg/goacc/asyncwait-4.f95
index 057d06bbe78..f5abe41f692 100644
--- a/gcc/testsuite/gfortran.dg/goacc/asyncwait-4.f95
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
index 2b22b1c0fbe..d9a246978be 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
+++ b/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)
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-reduction-2.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-reduction-2.f90
new file mode 100644
index 00000000000..c62e0a0c639
--- /dev/null
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/gomp/udr1.f90 b/gcc/testsuite/gfortran.dg/gomp/udr1.f90
index 84601310c45..d1eec72f4fb 100644
--- a/gcc/testsuite/gfortran.dg/gomp/udr1.f90
+++ b/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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/udr2.f90 b/gcc/testsuite/gfortran.dg/gomp/udr2.f90
index 7038d1869d9..83ea83e0cad 100644
--- a/gcc/testsuite/gfortran.dg/gomp/udr2.f90
+++ b/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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/udr4.f90 b/gcc/testsuite/gfortran.dg/gomp/udr4.f90
index b48c1090f27..9dfa32525bb 100644
--- a/gcc/testsuite/gfortran.dg/gomp/udr4.f90
+++ b/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
