From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1534) id 87949385842C; Mon, 23 Aug 2021 13:30:05 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 87949385842C MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Tobias Burnus To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-3079] Fortran/OpenMP: Improve duplicate errors X-Act-Checkin: gcc X-Git-Author: Tobias Burnus X-Git-Refname: refs/heads/master X-Git-Oldrev: d4de7e32eff0a6363defa50b052d7a30548b6552 X-Git-Newrev: 57a9e63c96fca56299d7a52f6712e2d9290c197e Message-Id: <20210823133005.87949385842C@sourceware.org> Date: Mon, 23 Aug 2021 13:30:05 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 23 Aug 2021 13:30:05 -0000 https://gcc.gnu.org/g:57a9e63c96fca56299d7a52f6712e2d9290c197e commit r12-3079-g57a9e63c96fca56299d7a52f6712e2d9290c197e Author: Tobias Burnus Date: Mon Aug 23 15:18:37 2021 +0200 Fortran/OpenMP: Improve duplicate errors gcc/fortran/ChangeLog: * openmp.c (gfc_match_dupl_check, gfc_match_dupl_memorder, gfc_match_dupl_atomic): New. (gfc_match_omp_clauses): Use them; remove duplicate 'release'/'relaxed' clause matching; improve error dignostic for 'default'. gcc/testsuite/ChangeLog: * gfortran.dg/goacc/asyncwait-1.f95: Update dg-error. * gfortran.dg/goacc/default-2.f: Update dg-error. * gfortran.dg/goacc/enter-exit-data.f95: Update dg-error. * gfortran.dg/goacc/if.f95: Update dg-error. * gfortran.dg/goacc/parallel-kernels-clauses.f95: Update dg-error. * gfortran.dg/goacc/routine-6.f90: Update dg-error. * gfortran.dg/goacc/sie.f95: Update dg-error. * gfortran.dg/goacc/update-if_present-2.f90: Update dg-error. * gfortran.dg/gomp/cancel-2.f90: Update dg-error. * gfortran.dg/gomp/declare-simd-1.f90: Update dg-error. * gfortran.dg/gomp/error-3.f90: Update dg-error. * gfortran.dg/gomp/loop-2.f90: Update dg-error. * gfortran.dg/gomp/masked-2.f90: Update dg-error. Diff: --- gcc/fortran/openmp.c | 627 +++++++++++++-------- gcc/testsuite/gfortran.dg/goacc/asyncwait-1.f95 | 2 +- gcc/testsuite/gfortran.dg/goacc/default-2.f | 32 +- .../gfortran.dg/goacc/enter-exit-data.f95 | 4 +- gcc/testsuite/gfortran.dg/goacc/if.f95 | 12 +- .../gfortran.dg/goacc/parallel-kernels-clauses.f95 | 16 +- gcc/testsuite/gfortran.dg/goacc/routine-6.f90 | 2 +- gcc/testsuite/gfortran.dg/goacc/sie.f95 | 20 +- .../gfortran.dg/goacc/update-if_present-2.f90 | 10 +- gcc/testsuite/gfortran.dg/gomp/cancel-2.f90 | 4 +- gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90 | 2 +- gcc/testsuite/gfortran.dg/gomp/error-3.f90 | 18 +- gcc/testsuite/gfortran.dg/gomp/loop-2.f90 | 2 +- gcc/testsuite/gfortran.dg/gomp/masked-2.f90 | 2 +- 14 files changed, 466 insertions(+), 287 deletions(-) diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 1aae35a6bc0..715fd321512 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1289,6 +1289,64 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc, return MATCH_YES; } + +/* Match with duplicate check. Matches 'name'. If expr != NULL, it + then matches '(expr)', otherwise, if open_parens is true, + it matches a ' ( ' after 'name'. + dupl_message requires '%qs %L' - and is used by + gfc_match_dupl_memorder and gfc_match_dupl_atomic. */ + +static match +gfc_match_dupl_check (bool not_dupl, const char *name, bool open_parens = false, + gfc_expr **expr = NULL, const char *dupl_msg = NULL) +{ + match m; + locus old_loc = gfc_current_locus; + if ((m = gfc_match (name)) != MATCH_YES) + return m; + if (!not_dupl) + { + if (dupl_msg) + gfc_error (dupl_msg, name, &old_loc); + else + gfc_error ("Duplicated %qs clause at %L", name, &old_loc); + return MATCH_ERROR; + } + if (open_parens || expr) + { + if (gfc_match (" ( ") != MATCH_YES) + { + gfc_error ("Expected %<(%> after %qs at %C", name); + return MATCH_ERROR; + } + if (expr) + { + if (gfc_match ("%e )", expr) != MATCH_YES) + { + gfc_error ("Invalid expression after %<%s(%> at %C", name); + return MATCH_ERROR; + } + } + } + return MATCH_YES; +} + +static match +gfc_match_dupl_memorder (bool not_dupl, const char *name) +{ + return gfc_match_dupl_check (not_dupl, name, false, NULL, + "Duplicated memory-order clause: unexpected %s " + "clause at %L"); +} + +static match +gfc_match_dupl_atomic (bool not_dupl, const char *name) +{ + return gfc_match_dupl_check (not_dupl, name, false, NULL, + "Duplicated atomic clause: unexpected %s " + "clause at %L"); +} + /* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of clauses that are allowed for a particular directive. */ @@ -1323,6 +1381,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, gfc_omp_namelist **head; old_loc = gfc_current_locus; char pc = gfc_peek_ascii_char (); + match m; switch (pc) { case 'a': @@ -1352,17 +1411,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_MEMORDER) - && c->memorder == OMP_MEMORDER_UNSET - && gfc_match ("acq_rel") == MATCH_YES) + && (m = gfc_match_dupl_memorder ((c->memorder + == OMP_MEMORDER_UNSET), + "acq_rel")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->memorder = OMP_MEMORDER_ACQ_REL; needs_space = true; continue; } if ((mask & OMP_CLAUSE_MEMORDER) - && c->memorder == OMP_MEMORDER_UNSET - && gfc_match ("acquire") == MATCH_YES) + && (m = gfc_match_dupl_memorder ((c->memorder + == OMP_MEMORDER_UNSET), + "acquire")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->memorder = OMP_MEMORDER_ACQUIRE; needs_space = true; continue; @@ -1371,7 +1436,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, && gfc_match ("affinity ( ") == MATCH_YES) { gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns; - match m = gfc_match_iterator (&ns_iter, true); + m = gfc_match_iterator (&ns_iter, true); if (m == MATCH_ERROR) break; if (m == MATCH_YES && gfc_match (" : ") != MATCH_YES) @@ -1398,9 +1463,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_AT) - && c->at == OMP_AT_UNSET - && gfc_match ("at ( ") == MATCH_YES) + && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true)) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; if (gfc_match ("compilation )") == MATCH_YES) c->at = OMP_AT_COMPILATION; else if (gfc_match ("execution )") == MATCH_YES) @@ -1414,11 +1481,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_ASYNC) - && !c->async - && gfc_match ("async") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->async, "async")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->async = true; - match m = gfc_match (" ( %e )", &c->async_expr); + m = gfc_match (" ( %e )", &c->async_expr); if (m == MATCH_ERROR) { gfc_current_locus = old_loc; @@ -1436,9 +1504,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_AUTO) - && !c->par_auto - && gfc_match ("auto") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->par_auto, "auto")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->par_auto = true; needs_space = true; continue; @@ -1452,9 +1522,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; case 'b': if ((mask & OMP_CLAUSE_BIND) - && c->bind == OMP_BIND_UNSET - && gfc_match ("bind ( ") == MATCH_YES) + && (m = gfc_match_dupl_check (c->bind == OMP_BIND_UNSET, "bind", + true)) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; if (gfc_match ("teams )") == MATCH_YES) c->bind = OMP_BIND_TEAMS; else if (gfc_match ("parallel )") == MATCH_YES) @@ -1472,34 +1544,36 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; case 'c': if ((mask & OMP_CLAUSE_CAPTURE) - && !c->capture - && gfc_match ("capture") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->capture, "capture")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->capture = true; needs_space = true; continue; } - if ((mask & OMP_CLAUSE_COLLAPSE) - && !c->collapse) + if (mask & OMP_CLAUSE_COLLAPSE) { gfc_expr *cexpr = NULL; - match m = gfc_match ("collapse ( %e )", &cexpr); - - if (m == MATCH_YES) - { - int collapse; - if (gfc_extract_int (cexpr, &collapse, -1)) + if ((m = gfc_match_dupl_check (!c->collapse, "collapse", true, + &cexpr)) != MATCH_NO) + { + int collapse; + if (m == MATCH_ERROR) + goto error; + if (gfc_extract_int (cexpr, &collapse, -1)) + collapse = 1; + else if (collapse <= 0) + { + gfc_error_now ("COLLAPSE clause argument not constant " + "positive integer at %C"); collapse = 1; - else if (collapse <= 0) - { - gfc_error_now ("COLLAPSE clause argument not" - " constant positive integer at %C"); - collapse = 1; - } - c->collapse = collapse; - gfc_free_expr (cexpr); - continue; - } + } + gfc_free_expr (cexpr); + c->collapse = collapse; + continue; + } } if ((mask & OMP_CLAUSE_COPY) && gfc_match ("copy ( ") == MATCH_YES @@ -1539,28 +1613,6 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; break; case 'd': - if ((mask & OMP_CLAUSE_DEFAULT) - && c->default_sharing == OMP_DEFAULT_UNKNOWN) - { - if (gfc_match ("default ( none )") == MATCH_YES) - c->default_sharing = OMP_DEFAULT_NONE; - else if (openacc) - { - if (gfc_match ("default ( present )") == MATCH_YES) - c->default_sharing = OMP_DEFAULT_PRESENT; - } - else - { - if (gfc_match ("default ( firstprivate )") == MATCH_YES) - c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE; - else if (gfc_match ("default ( private )") == MATCH_YES) - c->default_sharing = OMP_DEFAULT_PRIVATE; - else if (gfc_match ("default ( shared )") == MATCH_YES) - c->default_sharing = OMP_DEFAULT_SHARED; - } - if (c->default_sharing != OMP_DEFAULT_UNKNOWN) - continue; - } if ((mask & OMP_CLAUSE_DEFAULTMAP) && gfc_match ("defaultmap ( ") == MATCH_YES) { @@ -1645,6 +1697,43 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; continue; } + if ((mask & OMP_CLAUSE_DEFAULT) + && (m = gfc_match_dupl_check (c->default_sharing + == OMP_DEFAULT_UNKNOWN, "default", + true)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + if (gfc_match ("none") == MATCH_YES) + c->default_sharing = OMP_DEFAULT_NONE; + else if (openacc) + { + if (gfc_match ("present") == MATCH_YES) + c->default_sharing = OMP_DEFAULT_PRESENT; + } + else + { + if (gfc_match ("firstprivate") == MATCH_YES) + c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE; + else if (gfc_match ("private") == MATCH_YES) + c->default_sharing = OMP_DEFAULT_PRIVATE; + else if (gfc_match ("shared") == MATCH_YES) + c->default_sharing = OMP_DEFAULT_SHARED; + } + if (c->default_sharing == OMP_DEFAULT_UNKNOWN) + { + if (openacc) + gfc_error ("Expected NONE or PRESENT in DEFAULT clause " + "at %C"); + else + gfc_error ("Expected NONE, FIRSTPRIVATE, PRIVATE or SHARED " + "in DEFAULT clause at %C"); + goto error; + } + if (gfc_match (" )") != MATCH_YES) + goto error; + continue; + } if ((mask & OMP_CLAUSE_DELETE) && gfc_match ("delete ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], @@ -1660,7 +1749,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; if (m_it == MATCH_YES && gfc_match (" , ") != MATCH_YES) break; - match m = MATCH_YES; + m = MATCH_YES; gfc_omp_depend_op depend_op = OMP_DEPEND_OUT; if (gfc_match ("inout") == MATCH_YES) depend_op = OMP_DEPEND_INOUT; @@ -1736,9 +1825,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; if ((mask & OMP_CLAUSE_DEVICE) && !openacc - && c->device == NULL - && gfc_match ("device ( %e )", &c->device) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->device, "device", true, + &c->device)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_DEVICE) && openacc && gfc_match ("device ( ") == MATCH_YES @@ -1779,7 +1872,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, && c->dist_sched_kind == OMP_SCHED_NONE && gfc_match ("dist_schedule ( static") == MATCH_YES) { - match m = MATCH_NO; + m = MATCH_NO; c->dist_sched_kind = OMP_SCHED_STATIC; m = gfc_match (" , %e )", &c->dist_chunk_size); if (m != MATCH_YES) @@ -1795,17 +1888,27 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; case 'f': if ((mask & OMP_CLAUSE_FILTER) - && c->filter == NULL - && gfc_match ("filter ( %e )", &c->filter) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->filter, "filter", true, + &c->filter)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_FINAL) - && c->final_expr == NULL - && gfc_match ("final ( %e )", &c->final_expr) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->final_expr, "final", true, + &c->final_expr)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_FINALIZE) - && !c->finalize - && gfc_match ("finalize") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->finalize, "finalize")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->finalize = true; needs_space = true; continue; @@ -1823,11 +1926,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; case 'g': if ((mask & OMP_CLAUSE_GANG) - && !c->gang - && gfc_match ("gang") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->gang, "gang")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->gang = true; - match m = match_oacc_clause_gwv (c, GOMP_DIM_GANG); + m = match_oacc_clause_gwv (c, GOMP_DIM_GANG); if (m == MATCH_ERROR) { gfc_current_locus = old_loc; @@ -1838,9 +1942,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_GRAINSIZE) - && c->grainsize == NULL - && gfc_match ("grainsize ( ") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->grainsize, "grainsize", true)) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; if (gfc_match ("strict : ") == MATCH_YES) c->grainsize_strict = true; if (gfc_match (" %e )", &c->grainsize) != MATCH_YES) @@ -1850,9 +1956,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; case 'h': if ((mask & OMP_CLAUSE_HINT) - && c->hint == NULL - && gfc_match ("hint ( %e )", &c->hint) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->hint, "hint", true, &c->hint)) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_HOST_SELF) && gfc_match ("host ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], @@ -1861,24 +1971,36 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; break; case 'i': + if ((mask & OMP_CLAUSE_IF_PRESENT) + && (m = gfc_match_dupl_check (!c->if_present, "if_present")) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + c->if_present = true; + needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_IF) - && c->if_expr == NULL - && gfc_match ("if ( ") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->if_expr, "if", true)) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; if (!openacc) { /* This should match the enum gfc_omp_if_kind order. */ static const char *ifs[OMP_IF_LAST] = { - " cancel : %e )", - " parallel : %e )", - " simd : %e )", - " task : %e )", - " taskloop : %e )", - " target : %e )", - " target data : %e )", - " target update : %e )", - " target enter data : %e )", - " target exit data : %e )" }; + "cancel : %e )", + "parallel : %e )", + "simd : %e )", + "task : %e )", + "taskloop : %e )", + "target : %e )", + "target data : %e )", + "target update : %e )", + "target enter data : %e )", + "target exit data : %e )" }; int i; for (i = 0; i < OMP_IF_LAST; i++) if (c->if_exprs[i] == NULL @@ -1887,34 +2009,29 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if (i < OMP_IF_LAST) continue; } - if (gfc_match ("%e )", &c->if_expr) == MATCH_YES) + if (gfc_match (" %e )", &c->if_expr) == MATCH_YES) continue; - gfc_current_locus = old_loc; - } - if ((mask & OMP_CLAUSE_IF_PRESENT) - && !c->if_present - && gfc_match ("if_present") == MATCH_YES) - { - c->if_present = true; - needs_space = true; - continue; + goto error; } if ((mask & OMP_CLAUSE_IN_REDUCTION) && gfc_match_omp_clause_reduction (pc, c, openacc, allow_derived) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_INBRANCH) - && !c->inbranch - && !c->notinbranch - && gfc_match ("inbranch") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->inbranch && !c->notinbranch, + "inbranch")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->inbranch = needs_space = true; continue; } if ((mask & OMP_CLAUSE_INDEPENDENT) - && !c->independent - && gfc_match ("independent") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->independent, "independent")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->independent = true; needs_space = true; continue; @@ -2095,16 +2212,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, gfc_current_locus = old_loc; break; } - if ((mask & OMP_CLAUSE_MERGEABLE) && !c->mergeable - && gfc_match ("mergeable") == MATCH_YES) + if ((mask & OMP_CLAUSE_MERGEABLE) + && (m = gfc_match_dupl_check (!c->mergeable, "mergeable")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->mergeable = needs_space = true; continue; } if ((mask & OMP_CLAUSE_MESSAGE) - && !c->message - && gfc_match ("message ( %e )", &c->message) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->message, "message", true, + &c->message)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } break; case 'n': if ((mask & OMP_CLAUSE_NO_CREATE) @@ -2114,16 +2238,19 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, allow_derived)) continue; if ((mask & OMP_CLAUSE_NOGROUP) - && !c->nogroup - && gfc_match ("nogroup") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->nogroup, "nogroup")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->nogroup = needs_space = true; continue; } if ((mask & OMP_CLAUSE_NOHOST) - && !c->nohost - && gfc_match ("nohost") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->nohost, "nohost")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->nohost = needs_space = true; continue; } @@ -2133,29 +2260,38 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_NOTINBRANCH) - && !c->notinbranch - && !c->inbranch - && gfc_match ("notinbranch") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->notinbranch && !c->inbranch, + "notinbranch")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->notinbranch = needs_space = true; continue; } if ((mask & OMP_CLAUSE_NOWAIT) - && !c->nowait - && gfc_match ("nowait") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->nowait, "nowait")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->nowait = needs_space = true; continue; } if ((mask & OMP_CLAUSE_NUM_GANGS) - && c->num_gangs_expr == NULL - && gfc_match ("num_gangs ( %e )", - &c->num_gangs_expr) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->num_gangs_expr, "num_gangs", + true)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + if (gfc_match (" %e )", &c->num_gangs_expr) != MATCH_YES) + goto error; + continue; + } if ((mask & OMP_CLAUSE_NUM_TASKS) - && c->num_tasks == NULL - && gfc_match ("num_tasks ( ") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->num_tasks, "num_tasks", true)) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; if (gfc_match ("strict : ") == MATCH_YES) c->num_tasks_strict = true; if (gfc_match (" %e )", &c->num_tasks) != MATCH_YES) @@ -2163,19 +2299,30 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_NUM_TEAMS) - && c->num_teams == NULL - && gfc_match ("num_teams ( %e )", &c->num_teams) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->num_teams, "num_teams", true, + &c->num_teams)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_NUM_THREADS) - && c->num_threads == NULL - && (gfc_match ("num_threads ( %e )", &c->num_threads) - == MATCH_YES)) - continue; + && (m = gfc_match_dupl_check (!c->num_threads, "num_threads", true, + &c->num_threads)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_NUM_WORKERS) - && c->num_workers_expr == NULL - && gfc_match ("num_workers ( %e )", - &c->num_workers_expr) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->num_workers_expr, "num_workers", + true, &c->num_workers_expr)) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } break; case 'o': if ((mask & OMP_CLAUSE_ORDER) @@ -2186,11 +2333,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_ORDERED) - && !c->ordered - && gfc_match ("ordered") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->ordered, "ordered")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; gfc_expr *cexpr = NULL; - match m = gfc_match (" ( %e )", &cexpr); + m = gfc_match (" ( %e )", &cexpr); c->ordered = true; if (m == MATCH_YES) @@ -2262,35 +2411,46 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, OMP_MAP_ALLOC, true, allow_derived)) continue; if ((mask & OMP_CLAUSE_PRIORITY) - && c->priority == NULL - && gfc_match ("priority ( %e )", &c->priority) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->priority, "priority", true, + &c->priority)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_PRIVATE) && gfc_match_omp_variable_list ("private (", &c->lists[OMP_LIST_PRIVATE], true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_PROC_BIND) - && c->proc_bind == OMP_PROC_BIND_UNKNOWN) + && (m = gfc_match_dupl_check ((c->proc_bind + == OMP_PROC_BIND_UNKNOWN), + "proc_bind", true)) != MATCH_NO) { - /* Primary is new and master is deprecated in OpenMP 5.1. */ - if (gfc_match ("proc_bind ( primary )") == MATCH_YES) - c->proc_bind = OMP_PROC_BIND_MASTER; - else if (gfc_match ("proc_bind ( master )") == MATCH_YES) + if (m == MATCH_ERROR) + goto error; + if (gfc_match ("primary )") == MATCH_YES) + c->proc_bind = OMP_PROC_BIND_PRIMARY; + else if (gfc_match ("master )") == MATCH_YES) c->proc_bind = OMP_PROC_BIND_MASTER; - else if (gfc_match ("proc_bind ( spread )") == MATCH_YES) + else if (gfc_match ("spread )") == MATCH_YES) c->proc_bind = OMP_PROC_BIND_SPREAD; - else if (gfc_match ("proc_bind ( close )") == MATCH_YES) + else if (gfc_match ("close )") == MATCH_YES) c->proc_bind = OMP_PROC_BIND_CLOSE; - if (c->proc_bind != OMP_PROC_BIND_UNKNOWN) - continue; + else + goto error; + continue; } break; case 'r': if ((mask & OMP_CLAUSE_ATOMIC) - && c->atomic_op == GFC_OMP_ATOMIC_UNSET - && gfc_match ("read") == MATCH_YES) + && (m = gfc_match_dupl_atomic ((c->atomic_op + == GFC_OMP_ATOMIC_UNSET), + "read")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->atomic_op = GFC_OMP_ATOMIC_READ; needs_space = true; continue; @@ -2300,33 +2460,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, allow_derived) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_MEMORDER) - && c->memorder == OMP_MEMORDER_UNSET - && gfc_match ("relaxed") == MATCH_YES) - { - c->memorder = OMP_MEMORDER_RELAXED; - needs_space = true; - continue; - } - if ((mask & OMP_CLAUSE_MEMORDER) - && c->memorder == OMP_MEMORDER_UNSET - && gfc_match ("release") == MATCH_YES) - { - c->memorder = OMP_MEMORDER_RELEASE; - needs_space = true; - continue; - } - if ((mask & OMP_CLAUSE_MEMORDER) - && c->memorder == OMP_MEMORDER_UNSET - && gfc_match ("relaxed") == MATCH_YES) + && (m = gfc_match_dupl_memorder ((c->memorder + == OMP_MEMORDER_UNSET), + "relaxed")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->memorder = OMP_MEMORDER_RELAXED; needs_space = true; continue; } if ((mask & OMP_CLAUSE_MEMORDER) - && c->memorder == OMP_MEMORDER_UNSET - && gfc_match ("release") == MATCH_YES) + && (m = gfc_match_dupl_memorder ((c->memorder + == OMP_MEMORDER_UNSET), + "release")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->memorder = OMP_MEMORDER_RELEASE; needs_space = true; continue; @@ -2334,13 +2484,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; case 's': if ((mask & OMP_CLAUSE_SAFELEN) - && c->safelen_expr == NULL - && gfc_match ("safelen ( %e )", &c->safelen_expr) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->safelen_expr, "safelen", + true, &c->safelen_expr)) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_SCHEDULE) - && c->sched_kind == OMP_SCHED_NONE - && gfc_match ("schedule ( ") == MATCH_YES) + && (m = gfc_match_dupl_check (c->sched_kind == OMP_SCHED_NONE, + "schedule", true)) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; int nmodifiers = 0; locus old_loc2 = gfc_current_locus; do @@ -2387,7 +2544,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, c->sched_kind = OMP_SCHED_AUTO; if (c->sched_kind != OMP_SCHED_NONE) { - match m = MATCH_NO; + m = MATCH_NO; if (c->sched_kind != OMP_SCHED_RUNTIME && c->sched_kind != OMP_SCHED_AUTO) m = gfc_match (" , %e )", &c->chunk_size); @@ -2408,17 +2565,21 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, allow_derived)) continue; if ((mask & OMP_CLAUSE_SEQ) - && !c->seq - && gfc_match ("seq") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->seq, "seq")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->seq = true; needs_space = true; continue; } if ((mask & OMP_CLAUSE_MEMORDER) - && c->memorder == OMP_MEMORDER_UNSET - && gfc_match ("seq_cst") == MATCH_YES) + && (m = gfc_match_dupl_memorder ((c->memorder + == OMP_MEMORDER_UNSET), + "seq_cst")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->memorder = OMP_MEMORDER_SEQ_CST; needs_space = true; continue; @@ -2429,20 +2590,27 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_SIMDLEN) - && c->simdlen_expr == NULL - && gfc_match ("simdlen ( %e )", &c->simdlen_expr) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->simdlen_expr, "simdlen", true, + &c->simdlen_expr)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_SIMD) - && !c->simd - && gfc_match ("simd") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->simd, "simd")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->simd = needs_space = true; continue; } if ((mask & OMP_CLAUSE_SEVERITY) - && c->severity == OMP_SEVERITY_UNSET - && gfc_match ("severity ( ") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->severity, "severity", true)) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; if (gfc_match ("fatal )") == MATCH_YES) c->severity = OMP_SEVERITY_FATAL; else if (gfc_match ("warning )") == MATCH_YES) @@ -2462,14 +2630,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, allow_derived) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_THREAD_LIMIT) - && c->thread_limit == NULL - && gfc_match ("thread_limit ( %e )", - &c->thread_limit) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->thread_limit, "thread_limit", + true, &c->thread_limit)) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_THREADS) - && !c->threads - && gfc_match ("threads") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->threads, "threads")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->threads = needs_space = true; continue; } @@ -2497,16 +2671,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, false) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_UNTIED) - && !c->untied - && gfc_match ("untied") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->untied, "untied")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->untied = needs_space = true; continue; } if ((mask & OMP_CLAUSE_ATOMIC) - && c->atomic_op == GFC_OMP_ATOMIC_UNSET - && gfc_match ("update") == MATCH_YES) + && (m = gfc_match_dupl_atomic ((c->atomic_op + == GFC_OMP_ATOMIC_UNSET), + "update")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->atomic_op = GFC_OMP_ATOMIC_UPDATE; needs_space = true; continue; @@ -2531,21 +2709,24 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, /* VECTOR_LENGTH must be matched before VECTOR, because the latter doesn't unconditionally match '('. */ if ((mask & OMP_CLAUSE_VECTOR_LENGTH) - && c->vector_length_expr == NULL - && (gfc_match ("vector_length ( %e )", &c->vector_length_expr) - == MATCH_YES)) - continue; + && (m = gfc_match_dupl_check (!c->vector_length_expr, + "vector_length", true, + &c->vector_length_expr)) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_VECTOR) - && !c->vector - && gfc_match ("vector") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->vector, "vector")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->vector = true; - match m = match_oacc_clause_gwv (c, GOMP_DIM_VECTOR); + m = match_oacc_clause_gwv (c, GOMP_DIM_VECTOR); if (m == MATCH_ERROR) - { - gfc_current_locus = old_loc; - break; - } + goto error; if (m == MATCH_NO) needs_space = true; continue; @@ -2555,12 +2736,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if ((mask & OMP_CLAUSE_WAIT) && gfc_match ("wait") == MATCH_YES) { - match m = match_oacc_expr_list (" (", &c->wait_list, false); + m = match_oacc_expr_list (" (", &c->wait_list, false); if (m == MATCH_ERROR) - { - gfc_current_locus = old_loc; - break; - } + goto error; else if (m == MATCH_NO) { gfc_expr *expr @@ -2578,24 +2756,25 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_WORKER) - && !c->worker - && gfc_match ("worker") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->worker, "worker")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->worker = true; - match m = match_oacc_clause_gwv (c, GOMP_DIM_WORKER); + m = match_oacc_clause_gwv (c, GOMP_DIM_WORKER); if (m == MATCH_ERROR) - { - gfc_current_locus = old_loc; - break; - } + goto error; else if (m == MATCH_NO) needs_space = true; continue; } if ((mask & OMP_CLAUSE_ATOMIC) - && c->atomic_op == GFC_OMP_ATOMIC_UNSET - && gfc_match ("write") == MATCH_YES) + && (m = gfc_match_dupl_atomic ((c->atomic_op + == GFC_OMP_ATOMIC_UNSET), + "write")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->atomic_op = GFC_OMP_ATOMIC_WRITE; needs_space = true; continue; diff --git a/gcc/testsuite/gfortran.dg/goacc/asyncwait-1.f95 b/gcc/testsuite/gfortran.dg/goacc/asyncwait-1.f95 index c8a72fabadd..f67dd9cb4e3 100644 --- a/gcc/testsuite/gfortran.dg/goacc/asyncwait-1.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/asyncwait-1.f95 @@ -53,7 +53,7 @@ program asyncwait end do !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } - !$acc parallel copyin (a(1:N)) copy (b(1:N)) async (*) ! { dg-error "Invalid character in name at" } + !$acc parallel copyin (a(1:N)) copy (b(1:N)) async (*) ! { dg-error "Invalid character in name" } do i = 1, N b(i) = a(i) end do diff --git a/gcc/testsuite/gfortran.dg/goacc/default-2.f b/gcc/testsuite/gfortran.dg/goacc/default-2.f index ea82388eae9..963d9780c65 100644 --- a/gcc/testsuite/gfortran.dg/goacc/default-2.f +++ b/gcc/testsuite/gfortran.dg/goacc/default-2.f @@ -3,44 +3,44 @@ SUBROUTINE F1 IMPLICIT NONE -!$ACC KERNELS DEFAULT ! { dg-error "Failed to match clause" } +!$ACC KERNELS DEFAULT ! { dg-error "Expected '\\(' after 'default" } !$ACC END KERNELS ! { dg-error "Unexpected" } -!$ACC PARALLEL DEFAULT ! { dg-error "Failed to match clause" } +!$ACC PARALLEL DEFAULT ! { dg-error "Expected '\\(' after 'default" } !$ACC END PARALLEL ! { dg-error "Unexpected" } -!$ACC KERNELS DEFAULT ( ! { dg-error "Failed to match clause" } +!$ACC KERNELS DEFAULT ( ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" } !$ACC END KERNELS ! { dg-error "Unexpected" } -!$ACC PARALLEL DEFAULT ( ! { dg-error "Failed to match clause" } +!$ACC PARALLEL DEFAULT ( ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" } !$ACC END PARALLEL ! { dg-error "Unexpected" } -!$ACC KERNELS DEFAULT (, ! { dg-error "Failed to match clause" } +!$ACC KERNELS DEFAULT (, ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" } !$ACC END KERNELS ! { dg-error "Unexpected" } -!$ACC PARALLEL DEFAULT (, ! { dg-error "Failed to match clause" } +!$ACC PARALLEL DEFAULT (, ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" } !$ACC END PARALLEL ! { dg-error "Unexpected" } -!$ACC KERNELS DEFAULT () ! { dg-error "Failed to match clause" } +!$ACC KERNELS DEFAULT () ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" } !$ACC END KERNELS ! { dg-error "Unexpected" } -!$ACC PARALLEL DEFAULT () ! { dg-error "Failed to match clause" } +!$ACC PARALLEL DEFAULT () ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" } !$ACC END PARALLEL ! { dg-error "Unexpected" } -!$ACC KERNELS DEFAULT (,) ! { dg-error "Failed to match clause" } +!$ACC KERNELS DEFAULT (,) ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" } !$ACC END KERNELS ! { dg-error "Unexpected" } -!$ACC PARALLEL DEFAULT (,) ! { dg-error "Failed to match clause" } +!$ACC PARALLEL DEFAULT (,) ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" } !$ACC END PARALLEL ! { dg-error "Unexpected" } -!$ACC KERNELS DEFAULT (FIRSTPRIVATE) ! { dg-error "Failed to match clause" } +!$ACC KERNELS DEFAULT (FIRSTPRIVATE) ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" } !$ACC END KERNELS ! { dg-error "Unexpected" } -!$ACC PARALLEL DEFAULT (FIRSTPRIVATE) ! { dg-error "Failed to match clause" } +!$ACC PARALLEL DEFAULT (FIRSTPRIVATE) ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" } !$ACC END PARALLEL ! { dg-error "Unexpected" } -!$ACC KERNELS DEFAULT (PRIVATE) ! { dg-error "Failed to match clause" } +!$ACC KERNELS DEFAULT (PRIVATE) ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" } !$ACC END KERNELS ! { dg-error "Unexpected" } -!$ACC PARALLEL DEFAULT (PRIVATE) ! { dg-error "Failed to match clause" } +!$ACC PARALLEL DEFAULT (PRIVATE) ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" } !$ACC END PARALLEL ! { dg-error "Unexpected" } -!$ACC KERNELS DEFAULT (SHARED) ! { dg-error "Failed to match clause" } +!$ACC KERNELS DEFAULT (SHARED) ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" } !$ACC END KERNELS ! { dg-error "Unexpected" } -!$ACC PARALLEL DEFAULT (SHARED) ! { dg-error "Failed to match clause" } +!$ACC PARALLEL DEFAULT (SHARED) ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" } !$ACC END PARALLEL ! { dg-error "Unexpected" } !$ACC KERNELS DEFAULT (NONE ! { dg-error "Failed to match clause" } diff --git a/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95 b/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95 index c2a49796318..e71077aec01 100644 --- a/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95 @@ -28,7 +28,7 @@ contains !$acc enter data !$acc enter data if (.false.) !$acc enter data if (l) - !$acc enter data if (.false.) if (l) ! { dg-error "Failed to match clause" } + !$acc enter data if (.false.) if (l) ! { dg-error "Duplicated 'if' clause" } !$acc enter data if (i) ! { dg-error "LOGICAL" } !$acc enter data if (1) ! { dg-error "LOGICAL" } !$acc enter data if (a) ! { dg-error "LOGICAL" } @@ -63,7 +63,7 @@ contains !$acc exit data !$acc exit data if (.false.) !$acc exit data if (l) - !$acc exit data if (.false.) if (l) ! { dg-error "Failed to match clause" } + !$acc exit data if (.false.) if (l) ! { dg-error "Duplicated 'if' clause" } !$acc exit data if (i) ! { dg-error "LOGICAL" } !$acc exit data if (1) ! { dg-error "LOGICAL" } !$acc exit data if (a) ! { dg-error "LOGICAL" } diff --git a/gcc/testsuite/gfortran.dg/goacc/if.f95 b/gcc/testsuite/gfortran.dg/goacc/if.f95 index 35e9cfee134..56f3711f320 100644 --- a/gcc/testsuite/gfortran.dg/goacc/if.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/if.f95 @@ -6,7 +6,7 @@ program test logical :: x integer :: i - !$acc parallel if ! { dg-error "Failed to match clause" } + !$acc parallel if ! { dg-error "Expected '\\(' after 'if'" } !$acc parallel if () ! { dg-error "Invalid character" } !$acc parallel if (i) ! { dg-error "scalar LOGICAL expression" } !$acc end parallel @@ -14,11 +14,11 @@ program test !$acc end parallel !$acc kernels if (i) ! { dg-error "scalar LOGICAL expression" } !$acc end kernels - !$acc kernels if ! { dg-error "Failed to match clause" } + !$acc kernels if ! { dg-error "Expected '\\(' after 'if'" } !$acc kernels if () ! { dg-error "Invalid character" } !$acc kernels if (1) ! { dg-error "scalar LOGICAL expression" } !$acc end kernels - !$acc data if ! { dg-error "Failed to match clause" } + !$acc data if ! { dg-error "Expected '\\(' after 'if'" } !$acc data if () ! { dg-error "Invalid character" } !$acc data if (i) ! { dg-error "scalar LOGICAL expression" } !$acc end data @@ -26,9 +26,9 @@ program test !$acc end data ! at most one if clause may appear - !$acc parallel if (.false.) if (.false.) { dg-error "Failed to match clause" } - !$acc kernels if (.false.) if (.false.) { dg-error "Failed to match clause" } - !$acc data if (.false.) if (.false.) { dg-error "Failed to match clause" } + !$acc parallel if (.false.) if (.false.) { dg-error "Duplicated 'if' clause" } + !$acc kernels if (.false.) if (.false.) { dg-error "Duplicated 'if' clause" } + !$acc data if (.false.) if (.false.) { dg-error "Duplicated 'if' clause" } !$acc parallel if (x) !$acc end parallel diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95 index 72ba147565b..70b84f11549 100644 --- a/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95 @@ -59,17 +59,17 @@ program test !$acc parallel default ( none ) !$acc end parallel - !$acc kernels default { dg-error "Failed to match clause" } - !$acc parallel default { dg-error "Failed to match clause" } + !$acc kernels default { dg-error "Expected '\\(' after 'default'" } + !$acc parallel default { dg-error "Expected '\\(' after 'default'" } - !$acc kernels default() { dg-error "Failed to match clause" } - !$acc parallel default() { dg-error "Failed to match clause" } + !$acc kernels default() { dg-error "Expected NONE or PRESENT in DEFAULT clause" } + !$acc parallel default() { dg-error "Expected NONE or PRESENT in DEFAULT clause" } - !$acc kernels default(i) { dg-error "Failed to match clause" } - !$acc parallel default(i) { dg-error "Failed to match clause" } + !$acc kernels default(i) { dg-error "Expected NONE or PRESENT in DEFAULT clause" } + !$acc parallel default(i) { dg-error "Expected NONE or PRESENT in DEFAULT clause" } - !$acc kernels default(1) { dg-error "Failed to match clause" } - !$acc parallel default(1) { dg-error "Failed to match clause" } + !$acc kernels default(1) { dg-error "Expected NONE or PRESENT in DEFAULT clause" } + !$acc parallel default(1) { dg-error "Expected NONE or PRESENT in DEFAULT clause" } ! Wait !$acc kernels wait (l) ! { dg-error "INTEGER" } diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 index 3cd543e5aad..2b22b1c0fbe 100644 --- a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 @@ -118,7 +118,7 @@ subroutine subr10 (x) end subroutine subr10 subroutine subr20 (x) - !$acc routine (subr20) nohost nohost ! { dg-error "Failed to match clause" } + !$acc routine (subr20) nohost nohost ! { dg-error "Duplicated 'nohost' clause" } integer, intent(inout) :: x if (x < 1) then x = 1 diff --git a/gcc/testsuite/gfortran.dg/goacc/sie.f95 b/gcc/testsuite/gfortran.dg/goacc/sie.f95 index 194a1daae5f..5982d5d229f 100644 --- a/gcc/testsuite/gfortran.dg/goacc/sie.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/sie.f95 @@ -67,7 +67,7 @@ program test !$acc end kernels - !$acc parallel num_gangs ! { dg-error "Failed to match clause" } + !$acc parallel num_gangs ! { dg-error "Expected '\\(' after 'num_gangs'" } !$acc parallel num_gangs(3) !$acc end parallel @@ -95,7 +95,7 @@ program test !$acc parallel num_gangs("1") ! { dg-error "scalar INTEGER expression" } !$acc end parallel - !$acc kernels num_gangs ! { dg-error "Failed to match clause" } + !$acc kernels num_gangs ! { dg-error "Expected '\\(' after 'num_gangs'" } !$acc kernels num_gangs(3) !$acc end kernels @@ -124,7 +124,7 @@ program test !$acc end kernels - !$acc parallel num_workers ! { dg-error "Failed to match clause" } + !$acc parallel num_workers ! { dg-error "Expected '\\(' after 'num_workers'" } !$acc parallel num_workers(3) !$acc end parallel @@ -141,7 +141,7 @@ program test !$acc parallel num_workers(0) ! { dg-warning "must be positive" } !$acc end parallel - !$acc parallel num_workers() ! { dg-error "Invalid character in name" } + !$acc parallel num_workers() ! { dg-error "Invalid expression after 'num_workers\\('" } !$acc parallel num_workers(1.5) ! { dg-error "scalar INTEGER expression" } !$acc end parallel @@ -152,7 +152,7 @@ program test !$acc parallel num_workers("1") ! { dg-error "scalar INTEGER expression" } !$acc end parallel - !$acc kernels num_workers ! { dg-error "Failed to match clause" } + !$acc kernels num_workers ! { dg-error "Expected '\\(' after 'num_workers'" } !$acc kernels num_workers(3) !$acc end kernels @@ -169,7 +169,7 @@ program test !$acc kernels num_workers(0) ! { dg-warning "must be positive" } !$acc end kernels - !$acc kernels num_workers() ! { dg-error "Invalid character in name" } + !$acc kernels num_workers() ! { dg-error "Invalid expression after 'num_workers\\('" } !$acc kernels num_workers(1.5) ! { dg-error "scalar INTEGER expression" } !$acc end kernels @@ -181,7 +181,7 @@ program test !$acc end kernels - !$acc parallel vector_length ! { dg-error "Failed to match clause" } + !$acc parallel vector_length ! { dg-error "Expected '\\(' after 'vector_length'" } !$acc parallel vector_length(3) !$acc end parallel @@ -198,7 +198,7 @@ program test !$acc parallel vector_length(0) ! { dg-warning "must be positive" } !$acc end parallel - !$acc parallel vector_length() ! { dg-error "Invalid character in name" } + !$acc parallel vector_length() ! { dg-error "Invalid expression after 'vector_length\\('" } !$acc parallel vector_length(1.5) ! { dg-error "scalar INTEGER expression" } !$acc end parallel @@ -209,7 +209,7 @@ program test !$acc parallel vector_length("1") ! { dg-error "scalar INTEGER expression" } !$acc end parallel - !$acc kernels vector_length ! { dg-error "Failed to match clause" } + !$acc kernels vector_length ! { dg-error "Expected '\\(' after 'vector_length'" } !$acc kernels vector_length(3) !$acc end kernels @@ -226,7 +226,7 @@ program test !$acc kernels vector_length(0) ! { dg-warning "must be positive" } !$acc end kernels - !$acc kernels vector_length() ! { dg-error "Invalid character in name" } + !$acc kernels vector_length() ! { dg-error "Invalid expression after 'vector_length\\('" } !$acc kernels vector_length(1.5) ! { dg-error "scalar INTEGER expression" } !$acc end kernels diff --git a/gcc/testsuite/gfortran.dg/goacc/update-if_present-2.f90 b/gcc/testsuite/gfortran.dg/goacc/update-if_present-2.f90 index bf8b319a78e..368e9370c60 100644 --- a/gcc/testsuite/gfortran.dg/goacc/update-if_present-2.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/update-if_present-2.f90 @@ -12,10 +12,10 @@ subroutine t1 allocate (x, y, z(100)) - !$acc enter data copyin(a) if_present ! { dg-error "Failed to match clause" } - !$acc exit data copyout(a) if_present ! { dg-error "Failed to match clause" } + !$acc enter data copyin(a) if_present ! { dg-error "Expected '\\(' after 'if'" } + !$acc exit data copyout(a) if_present ! { dg-error "Expected '\\(' after 'if'" } - !$acc data copy(a) if_present ! { dg-error "Failed to match clause" } + !$acc data copy(a) if_present ! { dg-error "Expected '\\(' after 'if'" } !$acc end data ! { dg-error "Unexpected ..ACC END DATA statement" } !$acc declare link(a) if_present ! { dg-error "Unexpected junk after" } @@ -40,12 +40,12 @@ subroutine t2 end do !$acc end parallel - !$acc kernels loop if_present ! { dg-error "Failed to match clause" } + !$acc kernels loop if_present ! { dg-error "Expected '\\(' after 'if'" } do b = 1, 10 end do !$acc end kernels loop ! { dg-error "Unexpected ..ACC END KERNELS LOOP statement" } - !$acc parallel loop if_present ! { dg-error "Failed to match clause" } + !$acc parallel loop if_present ! { dg-error "Expected '\\(' after 'if'" } do b = 1, 10 end do !$acc end parallel loop ! { dg-error "Unexpected ..ACC END PARALLEL LOOP statement" } diff --git a/gcc/testsuite/gfortran.dg/gomp/cancel-2.f90 b/gcc/testsuite/gfortran.dg/gomp/cancel-2.f90 index 481b1aa5d2f..4ffbb2f209c 100644 --- a/gcc/testsuite/gfortran.dg/gomp/cancel-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/cancel-2.f90 @@ -5,11 +5,11 @@ subroutine foo () !$omp cancel parallel if (.true.) !$omp cancel parallel if (cancel: .true.) - !$omp cancel parallel if (.true.) if (.true.) ! { dg-error "Failed to match clause" } + !$omp cancel parallel if (.true.) if (.true.) ! { dg-error "Duplicated 'if' clause" } !$omp cancel parallel if (cancel: .true.) if (cancel: .true.) ! { dg-error "Failed to match clause" } !$omp cancel parallel if (cancel: .true.) if (.true.) ! { dg-error "IF clause without modifier at .1. used together with IF clauses with modifiers" } !$omp cancel parallel if (cancel: .true.) if (parallel: .true.) ! { dg-error "IF clause modifier PARALLEL at .1. not appropriate for the current OpenMP construct" } - !$omp cancel parallel if (.true.) if (cancel: .true.) ! { dg-error "Failed to match clause at" } + !$omp cancel parallel if (.true.) if (cancel: .true.) ! { dg-error "Duplicated 'if' clause" } !$omp cancel parallel if (parallel: .true.) if (cancel: .true.) ! { dg-error "IF clause modifier PARALLEL at .1. not appropriate for the current OpenMP construct" } !$omp end parallel end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90 index 40169d38da4..04abd5128f5 100644 --- a/gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90 @@ -2,7 +2,7 @@ subroutine fn1 (x) integer :: x -!$omp declare simd (fn1) inbranch notinbranch uniform (x) ! { dg-error "Failed to match clause" } +!$omp declare simd (fn1) inbranch notinbranch uniform (x) ! { dg-error "Duplicated 'notinbranch' clause" } end subroutine fn1 subroutine fn2 (x) !$omp declare simd (fn100) ! { dg-error "should refer to containing procedure" } diff --git a/gcc/testsuite/gfortran.dg/gomp/error-3.f90 b/gcc/testsuite/gfortran.dg/gomp/error-3.f90 index 67948cdc52a..b4d8b77a7fd 100644 --- a/gcc/testsuite/gfortran.dg/gomp/error-3.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/error-3.f90 @@ -1,23 +1,23 @@ module m !$omp error asdf ! { dg-error "Failed to match clause" } -!$omp error at ! { dg-error "Failed to match clause" } +!$omp error at ! { dg-error "Expected '\\(' after 'at'" } !$omp error at( ! { dg-error "Expected COMPILATION or EXECUTION in AT clause at" } !$omp error at(runtime) ! { dg-error "Expected COMPILATION or EXECUTION in AT clause at" } !$omp error at(+ ! { dg-error "Expected COMPILATION or EXECUTION in AT clause at" } !$omp error at(compilation ! { dg-error "Expected COMPILATION or EXECUTION in AT clause at" } -!$omp error severity ! { dg-error "Failed to match clause" } +!$omp error severity ! { dg-error "Expected '\\(' after 'severity'" } !$omp error severity( ! { dg-error "Expected FATAL or WARNING in SEVERITY clause at" } !$omp error severity(error) ! { dg-error "Expected FATAL or WARNING in SEVERITY clause at" } !$omp error severity(- ! { dg-error "Expected FATAL or WARNING in SEVERITY clause at" } !$omp error severity(fatal ! { dg-error "Expected FATAL or WARNING in SEVERITY clause at" } -!$omp error message ! { dg-error "Failed to match clause" } -!$omp error message( ! { dg-error "Invalid character in name" } -!$omp error message(0 ! { dg-error "Failed to match clause" } -!$omp error message("foo" ! { dg-error "Failed to match clause" } +!$omp error message ! { dg-error "Expected '\\(' after 'message'" } +!$omp error message( ! { dg-error "Invalid expression after 'message\\('" } +!$omp error message(0 ! { dg-error "Invalid expression after 'message\\('" } +!$omp error message("foo" ! { dg-error "Invalid expression after 'message\\('" } -!$omp error at(compilation) at(compilation) ! { dg-error "Failed to match clause at" } -!$omp error severity(fatal) severity(warning) ! { dg-error "Failed to match clause at" } -!$omp error message("foo") message("foo") ! { dg-error "Failed to match clause at" } +!$omp error at(compilation) at(compilation) ! { dg-error "Duplicated 'at' clause at" } +!$omp error severity(fatal) severity(warning) ! { dg-error "Duplicated 'severity' clause at" } +!$omp error message("foo") message("foo") ! { dg-error "Duplicated 'message' clause at" } !$omp error message("foo"),at(compilation),severity(fatal),asdf ! { dg-error "Failed to match clause" } !$omp error at(execution) ! { dg-error "Unexpected !.OMP ERROR statement in MODULE" } diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-2.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-2.f90 index 0cb86612566..4962683f2b0 100644 --- a/gcc/testsuite/gfortran.dg/gomp/loop-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/loop-2.f90 @@ -37,7 +37,7 @@ end do do i = 1, 64 end do -!$omp loop bind(teams) bind(teams) ! { dg-error "24: Failed to match clause" } +!$omp loop bind(teams) bind(teams) ! { dg-error "Duplicated 'bind' clause" } do i = 1, 64 end do diff --git a/gcc/testsuite/gfortran.dg/gomp/masked-2.f90 b/gcc/testsuite/gfortran.dg/gomp/masked-2.f90 index 95ef78c0664..b6eb8619a81 100644 --- a/gcc/testsuite/gfortran.dg/gomp/masked-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/masked-2.f90 @@ -41,6 +41,6 @@ end end module subroutine bar - !$omp masked filter (0) filter (0) ! { dg-error "27: Failed to match clause" } + !$omp masked filter (0) filter (0) ! { dg-error "Duplicated 'filter' clause" } call foobar end