[gcc/devel/omp/gcc-16] OpenMP/Fortran: Improve 'declare reduction' diagnostic
Sandra Loosemore via Gcc-cvs <[email protected]>
| Newsgroups | gmane.comp.gcc.cvs |
|---|---|
| Message-ID | <[email protected]> |
https://gcc.gnu.org/g:f29a933464353cdab5b7d402071a33745fee3148 commit f29a933464353cdab5b7d402071a33745fee3148 Author: Tobias Burnus <[email protected]> Date: Wed Jun 17 08:48:58 2026 +0200 OpenMP/Fortran: Improve 'declare reduction' diagnostic gcc/fortran/ChangeLog: * openmp.cc (match_udr_expr, gfc_match_omp_declare_reduction, gfc_resolve_omp_udr): Improve diagnostic. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/declare-reduction-2.f90: Update dg-error. * gfortran.dg/gomp/udr1.f90: Likewise. * gfortran.dg/gomp/udr2.f90: Likewise. * gfortran.dg/gomp/udr3.f90: Likewise. * gfortran.dg/gomp/udr4.f90: Likewise. * gfortran.dg/gomp/declare-reduction-5.f90: New test. (cherry picked from commit 791058d9a95fc71ad95e5fa0115315058df2babb) Diff: --- gcc/fortran/openmp.cc | 93 ++++++++++++++-------- .../gfortran.dg/gomp/declare-reduction-2.f90 | 3 +- .../gfortran.dg/gomp/declare-reduction-5.f90 | 90 +++++++++++++++++++++ gcc/testsuite/gfortran.dg/gomp/udr1.f90 | 6 +- gcc/testsuite/gfortran.dg/gomp/udr2.f90 | 12 +-- gcc/testsuite/gfortran.dg/gomp/udr3.f90 | 18 ++--- gcc/testsuite/gfortran.dg/gomp/udr4.f90 | 10 +-- 7 files changed, 174 insertions(+), 58 deletions(-) diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 1b54a00345f0..ccc65dda7b79 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -6112,6 +6112,9 @@ failure: return MATCH_ERROR; } +/* For 'declare reduction', matches either the combiner or initializer + expression, either can be an assignment of 'omp_sym1 = ...' + or a subroutine call, i.e. 'subroutine-name(argument-list)'. */ static bool match_udr_expr (gfc_symtree *omp_sym1, gfc_symtree *omp_sym2) @@ -6146,20 +6149,20 @@ match_udr_expr (gfc_symtree *omp_sym1, gfc_symtree *omp_sym2) m = gfc_match (" %n", sname); if (m != MATCH_YES) - return false; + goto syntax; if (strcmp (sname, omp_sym1->name) == 0 || strcmp (sname, omp_sym2->name) == 0) - return false; + goto syntax; gfc_current_ns = ns->parent; if (gfc_get_ha_sym_tree (sname, &st)) - return false; + goto syntax; sym = st->n.sym; if (sym->attr.flavor != FL_PROCEDURE && sym->attr.flavor != FL_UNKNOWN) - return false; + goto syntax; if (!sym->attr.generic && !sym->attr.subroutine @@ -6170,7 +6173,7 @@ match_udr_expr (gfc_symtree *omp_sym1, gfc_symtree *omp_sym2) /* ...create a symbol in this scope... */ if (sym->ns != gfc_current_ns && gfc_get_sym_tree (sname, NULL, &st, false) == 1) - return false; + goto syntax; if (sym != st->n.sym) sym = st->n.sym; @@ -6178,27 +6181,33 @@ match_udr_expr (gfc_symtree *omp_sym1, gfc_symtree *omp_sym2) /* ...and then to try to make the symbol into a subroutine. */ if (!gfc_add_subroutine (&sym->attr, sym->name, NULL)) - return false; + goto syntax; } gfc_set_sym_referenced (sym); gfc_gobble_whitespace (); if (gfc_peek_ascii_char () != '(') - return false; + goto syntax; gfc_current_ns = ns; m = gfc_match_actual_arglist (1, &arglist); if (m != MATCH_YES) - return false; + goto syntax; if (gfc_match_char (')') != MATCH_YES) - return false; + goto syntax; + gfc_clear_error (); ns->code = gfc_get_code (EXEC_CALL); ns->code->symtree = st; ns->code->ext.actual = arglist; ns->code->loc = old_loc; return true; +syntax: + gfc_clear_error (); + gfc_error ("Expected either %<%s = expr%> or %<subroutine-name(argument-list)" + "%> followed by %<)%> at %L", omp_sym1->name, &old_loc); + return false; } static bool @@ -6327,7 +6336,10 @@ gfc_match_omp_declare_reduction (void) gfc_omp_reduction_op rop = OMP_REDUCTION_NONE; if (gfc_match_char ('(') != MATCH_YES) - return MATCH_ERROR; + { + gfc_error ("Expected %<(%> at %C"); + return MATCH_ERROR; + } m = gfc_match (" %o : ", &op); if (m == MATCH_ERROR) @@ -6347,19 +6359,29 @@ gfc_match_omp_declare_reduction (void) name[0] = '.'; strcat (name, "."); if (gfc_match (" : ") != MATCH_YES) - return MATCH_ERROR; + { + gfc_error ("Expected %<:%> at %C"); + return MATCH_ERROR; + } } else { if (gfc_match (" %n : ", name) != MATCH_YES) - return MATCH_ERROR; + { + gfc_error ("Expected an identfifier or operator as reduction " + "identifier followed by a colon at %C"); + return MATCH_ERROR; + } } rop = OMP_REDUCTION_USER; } m = gfc_match_type_spec (&ts); if (m != MATCH_YES) - return MATCH_ERROR; + { + gfc_error ("Expected type spec at %C"); + return MATCH_ERROR; + } /* Treat len=: the same as len=*. */ if (ts.type == BT_CHARACTER) ts.deferred = false; @@ -6369,11 +6391,17 @@ gfc_match_omp_declare_reduction (void) { m = gfc_match_type_spec (&ts); if (m != MATCH_YES) - return MATCH_ERROR; + { + gfc_error ("Expected type spec at %C"); + return MATCH_ERROR; + } tss.safe_push (ts); } if (gfc_match_char (':') != MATCH_YES) - return MATCH_ERROR; + { + gfc_error ("Expected %<:%> or %<,%> at %C"); + return MATCH_ERROR; + } st = gfc_find_symtree (gfc_current_ns->omp_udr_root, name); for (i = 0; i < tss.length (); i++) @@ -6412,7 +6440,6 @@ gfc_match_omp_declare_reduction (void) if (!match_udr_expr (omp_out, omp_in)) { syntax: - gfc_current_locus = old_loc; gfc_current_ns = combiner_ns->parent; gfc_undo_symbols (); gfc_free_omp_udr (omp_udr); @@ -6461,19 +6488,21 @@ gfc_match_omp_declare_reduction (void) && (rop != OMP_REDUCTION_USER || name[0] == '.')) { if (predef_name) - gfc_error_now ("Redefinition of predefined %s " + gfc_error_now ("Redefinition of predefined %qs in " "!$OMP DECLARE REDUCTION at %L", predef_name, &where); else - gfc_error_now ("Redefinition of predefined " - "!$OMP DECLARE REDUCTION at %L", &where); + gfc_error_now ("Redefinition of predefined %qs in " + "!$OMP DECLARE REDUCTION at %L", name, &where); + goto syntax; } else if (prev_udr) { - gfc_error_now ("Redefinition of !$OMP DECLARE REDUCTION at %L", - &where); - gfc_error_now ("Previous !$OMP DECLARE REDUCTION at %L", - &prev_udr->where); + gfc_error_now ("Redefinition of %qs in !$OMP DECLARE REDUCTION at %L", + name, &where); + inform (gfc_get_location (&prev_udr->where), + "Previous !$OMP DECLARE REDUCTION"); + goto syntax; } else if (st) { @@ -6492,14 +6521,11 @@ gfc_match_omp_declare_reduction (void) gfc_current_locus = end_loc; if (gfc_match_omp_eos () != MATCH_YES) { - gfc_error ("Unexpected junk after !$OMP DECLARE REDUCTION at %C"); - gfc_current_locus = where; + gfc_error ("Unexpected junk at %C"); return MATCH_ERROR; } - return MATCH_YES; } - gfc_clear_error (); return MATCH_ERROR; } @@ -14101,12 +14127,13 @@ gfc_resolve_omp_udr (gfc_omp_udr *omp_udr) &omp_udr->ts, &predef_name)) { if (predef_name) - gfc_error_now ("Redefinition of predefined %s " - "!$OMP DECLARE REDUCTION at %L", - predef_name, &omp_udr->where); + gfc_error ("Redefinition of predefined %qs in " + "!$OMP DECLARE REDUCTION at %L", + predef_name, &omp_udr->where); else - gfc_error_now ("Redefinition of predefined " - "!$OMP DECLARE REDUCTION at %L", &omp_udr->where); + gfc_error ("Redefinition of predefined %qs in " + "!$OMP DECLARE REDUCTION at %L", omp_udr->name, + &omp_udr->where); return; } @@ -14114,7 +14141,7 @@ gfc_resolve_omp_udr (gfc_omp_udr *omp_udr) && omp_udr->ts.u.cl->length && omp_udr->ts.u.cl->length->expr_type != EXPR_CONSTANT) { - gfc_error ("CHARACTER length in !$OMP DECLARE REDUCTION %s not " + gfc_error ("CHARACTER length in !$OMP DECLARE REDUCTION %qs not " "constant at %L", omp_udr->name, &omp_udr->where); return; } diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-reduction-2.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-reduction-2.f90 index c62e0a0c6393..dba462a437a8 100644 --- a/gcc/testsuite/gfortran.dg/gomp/declare-reduction-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/declare-reduction-2.f90 @@ -3,8 +3,7 @@ type t end type t !$omp declare reduction(+:t) -! { dg-error "28: Syntax error in statement at .1." "" { target *-*-* } .-1 } +! { dg-error "28: Expected ':' or ',' at .1." "" { target *-*-* } .-1 } ! { dg-bogus "Unclassifiable OpenMP directive" "" { target *-*-* } .-2 } - end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-reduction-5.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-reduction-5.f90 new file mode 100644 index 000000000000..fb1f348ce53e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-reduction-5.f90 @@ -0,0 +1,90 @@ +module m +implicit none +contains + integer function my_add(x,y) + integer, value, intent(in) :: x, y + my_add = x + y + end +end module + +use m +implicit none + +type t + integer :: x +end type t + +!$omp declare reduction ! { dg-error "Expected '\\('" } + +!$omp declare reduction initializer() ! { dg-error "Expected '\\('" } + + +!$omp declare reduction ( ! { dg-error "Expected an identfifier or operator as reduction identifier followed by a colon" } + +!$omp declare reduction (+ ! { dg-error "Expected an identfifier or operator as reduction identifier followed by a colon" } +!$omp declare reduction (.or. ! { dg-error "The name 'or' cannot be used as a defined operator" } +!$omp declare reduction (myName ! { dg-error "Expected an identfifier or operator as reduction identifier followed by a colon" } + +!$omp declare reduction (+ : ! { dg-error "Expected type spec" } +!$omp declare reduction (.or. : ! { dg-error "Expected type spec" } +!$omp declare reduction (myName : ! { dg-error "Expected type spec" } + +!$omp declare reduction (+ : t ! { dg-error "Expected ':' or ','" } +!$omp declare reduction (.or. : integer ! { dg-error "Expected ':' or ','" } +!$omp declare reduction (myName : integer(kind=4) ! { dg-error "Expected ':' or ','" } + +!$omp declare reduction (foo : integer(1), integer(kind=2), ! { dg-error "Expected type spec at" } +!$omp declare reduction (foo : integer(1), integer(kind=2) ! { dg-error "Expected ':' or ','" } + +!$omp declare reduction (+ : t : ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } + +!$omp declare reduction (.or. : integer : ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } +!$omp declare reduction (myName : integer(kind=4) : ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } + +!$omp declare reduction (+ : t : omp_in ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } +!$omp declare reduction (.or. : integer : omp_priv ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } +!$omp declare reduction (myName : integer(kind=4) : omp_orig ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } + +!$omp declare reduction (+ : t : omp_out ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } +!$omp declare reduction (.or. : integer : omp_out ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } +!$omp declare reduction (myName : integer(kind=4) : omp_out ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } + +!$omp declare reduction (+ : t : omp_out%x = ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } +!$omp declare reduction (.or. : integer : omp_out = ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } +!$omp declare reduction (myName : integer(kind=4) : omp_out = ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } + +!$omp declare reduction (+ : t : omp_out%x = 1 ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } +!$omp declare reduction (.or. : integer : omp_out = 1 ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } +!$omp declare reduction (myName : integer(kind=4) : omp_out = 1 ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } + +! Odd in terms of semantic but valid +!$omp declare reduction (+ : t : omp_out%x = 1 ) ! { dg-error "Missing INITIALIZER clause for !.OMP DECLARE REDUCTION of derived type without default initializer" } +!$omp declare reduction (.or. : integer : omp_out = 1 ) +!$omp declare reduction (myName : integer(kind=4) : omp_out = 1 ) + +!$omp declare reduction (myName5 : t : omp_out%x = omp_in%x + omp_out%x ) ! { dg-error "Missing INITIALIZER clause for !.OMP DECLARE REDUCTION of derived type without default initializer" } +!$omp declare reduction (.and. : integer : omp_out = 0 + omp_out + omp_in ) +!$omp declare reduction (myName2 : integer(kind=4) : omp_out = omp_out + omp_in ) + +!$omp declare reduction (myName4 : t : omp_out%x = my_add(omp_in%x , omp_out%x) + 0 ) ! { dg-error "Missing INITIALIZER clause for !.OMP DECLARE REDUCTION of derived type without default initializer" } +!$omp declare reduction (myName6 : integer : omp_out = 0 + my_add(omp_out,omp_in) ) +!$omp declare reduction (myName3 : integer(kind=4) : omp_out = my_add(omp_out , omp_in ) ) + +!$omp declare reduction (* : integer : omp_out = omp_in * omp_out) ! { dg-error "Redefinition of predefined 'operator \\*' in !.OMP DECLARE REDUCTION" } +!$omp declare reduction (max : integer : omp_out = omp_in * omp_out) ! { dg-error "Redefinition of predefined 'max' in !.OMP DECLARE REDUCTIO" } + +!$omp declare reduction (my : integer : omp_out = omp_in * omp_out) ! { dg-note "Previous !.OMP DECLARE REDUCTION" } +!$omp declare reduction (my : integer : omp_out = omp_in * omp_out) ! { dg-error "Redefinition of 'my' in !.OMP DECLARE REDUCTION" } + +!$omp declare reduction (foo : integer(1), integer(kind=2), real(kind=8) : omp_out = omp_in * omp_out) nowait ! { dg-error "Unexpected junk at .1." } +!$omp declare reduction (bar : integer : omp_out = omp_in * omp_out) initializer ! { dg-error "Unexpected junk at .1." } + +!$omp declare reduction (bar2 : integer : omp_out = omp_in * omp_out) initializer( ! { dg-error "Expected either 'omp_priv = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } + +!$omp declare reduction (bar3 : integer : omp_out = omp_in * omp_out) initializer( omp_priv = ! { dg-error "Expected either 'omp_priv = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } + +!$omp declare reduction (bar3 : integer : omp_out = omp_in * omp_out) initializer( omp_priv = 1! { dg-error "Expected either 'omp_priv = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } + +!$omp declare reduction (bar3 : integer : omp_out = omp_in * omp_out) initializer( omp_priv = 1) nowait ! { dg-error "Unexpected junk at .1." } + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/udr1.f90 b/gcc/testsuite/gfortran.dg/gomp/udr1.f90 index d1eec72f4fba..dc7682e33e1e 100644 --- a/gcc/testsuite/gfortran.dg/gomp/udr1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/udr1.f90 @@ -22,12 +22,12 @@ subroutine f2 end do end subroutine f2 subroutine f3 -!$omp declare reduction (foo:blah:omp_out=omp_out + omp_in) ! { dg-error "30: Syntax error in statement at .1." } +!$omp declare reduction (foo:blah:omp_out=omp_out + omp_in) ! { dg-error "30: Expected type spec at .1." } end subroutine f3 subroutine f4 -!$omp declare reduction (foo:integer:a => null()) ! { dg-error "Invalid character in name" } +!$omp declare reduction (foo:integer:a => null()) ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } !$omp declare reduction (foo:integer:omp_out = omp_in + omp_out) & -!$omp & initializer(a => null()) ! { dg-error "Invalid character in name" } +!$omp & initializer(a => null()) ! { dg-error "Expected either 'omp_priv = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } end subroutine f4 subroutine f5 integer :: a, b diff --git a/gcc/testsuite/gfortran.dg/gomp/udr2.f90 b/gcc/testsuite/gfortran.dg/gomp/udr2.f90 index 83ea83e0cada..ec5b5ce7b64c 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 "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)) +!$omp declare reduction (foo:real:omp_out (omp_in)) ! { dg-error "34: Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } +!$omp declare reduction (bar:real:omp_out = omp_in * omp_out) & +!$omp & initializer (omp_priv (omp_orig)) ! { dg-error "Expected either 'omp_priv = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } end subroutine f6 subroutine f7 integer :: a -!$omp declare reduction (foo:integer:a (omp_out, omp_in)) ! { dg-error "38: Syntax error in statement at .1." } +!$omp declare reduction (foo:integer:a (omp_out, omp_in)) ! { dg-error "37: Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' 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" } @@ -24,9 +24,9 @@ subroutine f8 end interface !$omp declare reduction (baz:integer:omp_out = omp_out + omp_in) & !$omp & initializer (f8a (omp_orig)) ! { dg-error "One of actual subroutine arguments in INITIALIZER clause" } -!$omp declare reduction (foo:integer:f8a) ! { dg-error "is not a variable" } +!$omp declare reduction (foo:integer:f8a) ! { dg-error "Expected either 'omp_out = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } !$omp declare reduction (bar:integer:omp_out = omp_out - omp_in) & -!$omp & initializer (f8a) ! { dg-error "is not a variable" } +!$omp & initializer (f8a) ! { dg-error "Expected either 'omp_priv = expr' or 'subroutine-name\\(argument-list\\)' followed by '\\)' at .1." } end subroutine f8 subroutine f9 type dt ! { dg-error "which is not consistent with the CALL" } diff --git a/gcc/testsuite/gfortran.dg/gomp/udr3.f90 b/gcc/testsuite/gfortran.dg/gomp/udr3.f90 index a4feaddd1a2a..82fd08b14ee7 100644 --- a/gcc/testsuite/gfortran.dg/gomp/udr3.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/udr3.f90 @@ -7,21 +7,21 @@ subroutine f1 type dt2 logical :: l = .false. end type -!$omp declare reduction (foo:integer(kind = 4) & ! { dg-error "Previous !.OMP DECLARE REDUCTION" } +!$omp declare reduction (foo:integer(kind = 4) & ! { dg-note "Previous !.OMP DECLARE REDUCTION" } !$omp & :omp_out = omp_out + omp_in) -!$omp declare reduction (foo:integer(kind = 4) : & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION" } +!$omp declare reduction (foo:integer(kind = 4) : & ! { dg-error "Redefinition of 'foo' in !.OMP DECLARE REDUCTION at .1." } !$omp & omp_out = omp_out + omp_in) !$omp declare reduction (bar:integer, & !$omp & real:omp_out = omp_out + omp_in) -!$omp declare reduction (baz:integer,real,integer & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION|Previous" } +!$omp declare reduction (baz:integer,real,integer & ! { dg-error "Redefinition of 'baz' in !.OMP DECLARE REDUCTION|Previous !.OMP DECLARE REDUCTION" } !$omp & : omp_out = omp_out + omp_in) !$omp declare reduction (id1:dt,dt2:omp_out%l=omp_out%l & !$omp & .or.omp_in%l) -!$omp declare reduction (id2:dt,dt:omp_out%l=omp_out%l & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION|Previous" } +!$omp declare reduction (id2:dt,dt:omp_out%l=omp_out%l & ! { dg-error "Redefinition of 'id2' in !.OMP DECLARE REDUCTION|Previous !.OMP DECLARE REDUCTION" } !$omp & .or.omp_in%l) -!$omp declare reduction (id3:dt2,dt:omp_out%l=omp_out%l & ! { dg-error "Previous !.OMP DECLARE REDUCTION" } +!$omp declare reduction (id3:dt2,dt:omp_out%l=omp_out%l & ! { dg-note "Previous !.OMP DECLARE REDUCTION" } !$omp & .or.omp_in%l) -!$omp declare reduction (id3:dt2:omp_out%l=omp_out%l & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION" } +!$omp declare reduction (id3:dt2:omp_out%l=omp_out%l & ! { dg-error "Redefinition of 'id3' in !.OMP DECLARE REDUCTION" } !$omp & .or.omp_in%l) end subroutine f1 subroutine f2 @@ -56,13 +56,13 @@ subroutine f2 !$omp declare reduction (baz:character(len=6): & !$omp & f2a (omp_out, omp_in, .false.)) & !$omp & initializer (f2a (omp_priv, omp_orig, .true.)) -!$omp declare reduction (id:character(len=*): & ! { dg-error "Previous !.OMP DECLARE REDUCTION" } +!$omp declare reduction (id:character(len=*): & ! { dg-note "Previous !.OMP DECLARE REDUCTION" } !$omp & f2a (omp_out, omp_in, .false.)) & !$omp & initializer (f2a (omp_priv, omp_orig, .true.)) -!$omp declare reduction (id: & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION" } +!$omp declare reduction (id: & ! { dg-error "Redefinition of 'id' in !.OMP DECLARE REDUCTION" } !$omp & character(len=:) : f2a (omp_out, omp_in, .false.)) & !$omp & initializer (f2a (omp_priv, omp_orig, .true.)) -!$omp declare reduction & ! { dg-error "Redefinition of !.OMP DECLARE REDUCTION|Previous" } +!$omp declare reduction & ! { dg-error "Redefinition of 'id2' in !.OMP DECLARE REDUCTION|Previous !.OMP DECLARE REDUCTION" } !$omp (id2:character(len=*), character(len=:): & !$omp f2a (omp_out, omp_in, .false.)) & !$omp & initializer (f2a (omp_priv, omp_orig, .true.)) diff --git a/gcc/testsuite/gfortran.dg/gomp/udr4.f90 b/gcc/testsuite/gfortran.dg/gomp/udr4.f90 index 9dfa32525bb8..00adf2e03690 100644 --- a/gcc/testsuite/gfortran.dg/gomp/udr4.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/udr4.f90 @@ -1,12 +1,12 @@ ! { dg-do compile } subroutine f3 -!$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 ! { dg-error "24: Expected '\\(' at .1." } +!$omp declare reduction foo ! { dg-error "24: Expected '\\(' at .1." } +!$omp declare reduction (foo) ! { dg-error "26: Expected an identfifier or operator as reduction identifier followed by a colon at .1." } +!$omp declare reduction (foo:integer) ! { dg-error "37: Expected ':' or ',' 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" } +!$omp & initializer(omp_priv=0) initializer(omp_priv=0) ! { dg-error "32: Unexpected junk at .1." } end subroutine f3 subroutine f4 implicit integer (o)