https://gcc.gnu.org/g:f6c648de40d145725df4085bdbbd2352bb3e6ea1
commit f6c648de40d145725df4085bdbbd2352bb3e6ea1 Author: Tobias Burnus <[email protected]> Date: Fri Jun 12 19:12:58 2026 +0200 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. (cherry picked from commit 6e7832610eb944046492d82ccd508a2484b03fce) Diff: --- 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 82cd85851c8d..664a70206a78 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 @@ -1328,17 +1356,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) @@ -1465,6 +1496,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 057d06bbe78f..f5abe41f6923 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 2b22b1c0fbee..d9a246978be8 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 000000000000..c62e0a0c6393 --- /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 84601310c45c..d1eec72f4fba 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 7038d1869d9b..83ea83e0cada 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 b48c1090f270..9dfa32525bb8 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
