Another a bit boring parser change - again mostly to avoid changing some (external) testcases that already use that new syntax (which is not very useful, but okay ...).
Committed as r17-4678-ga39d268ced9857 Tobias
commit a39d268ced985763ac84ba87c243d44f79dd304a Author: Tobias Burnus <[email protected]> Date: Sat Sep 26 12:55:12 2026 +0200 OpenMP/Fortran: accept optional const bool expr for inarguable clauses OpenMP 6 added an optional constant logical expression to all those clauses that otherwise do not take an argument, usable to enable or disable the feature; for some clauses, .false. implies not present for others it implies present but not active, which makes a difference for the diagnostic (and mostly matters for clauses groups). Note that some logical clauses are mandatatory like for nocontext or novariants; those also accept variables as argument. The 'nowait' clause meanwhile also accepts an argument; as also supports non-constant values are supported, the implemention has not been done in this commit. gcc/fortran/ChangeLog: * gfortran.h (enum gfc_omp_requires_kind): Add OMP_REQ_NONE. * openmp.cc (gfc_match_boolean_clause): New. (gfc_match_dupl_branch_clause): New. (gfc_match_dupl_check): Remove dupl_msg arg. (gfc_match_dupl_atomic, gfc_match_dupl_memorder, gfc_match_omp_clauses, gfc_match_omp_flush, gfc_match_omp_requires): Accept optional constant logical expression for inarguable clauses. libgomp/ChangeLog: * libgomp.texi (Impl. Status): Mark optional const bool expr for inarguable clauses as implemented for Fortran. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/atomic-18.f90: Update dg-error. * gfortran.dg/gomp/declare-simd-1.f90: Likewise. * gfortran.dg/gomp/declare-target-indirect-1.f90: Likewise. * gfortran.dg/gomp/flush-2.f90: Likewise. * gfortran.dg/gomp/requires-2.f90: Likewise. * gfortran.dg/gomp/clause-logical-arg-1.f90: New test. * gfortran.dg/gomp/clause-logical-arg-2.f90: New test. --- gcc/fortran/gfortran.h | 1 + gcc/fortran/openmp.cc | 564 ++++++++++++++------- gcc/testsuite/gfortran.dg/gomp/atomic-18.f90 | 4 +- .../gfortran.dg/gomp/clause-logical-arg-1.f90 | 109 ++++ .../gfortran.dg/gomp/clause-logical-arg-2.f90 | 73 +++ gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90 | 2 +- .../gfortran.dg/gomp/declare-target-indirect-1.f90 | 8 +- gcc/testsuite/gfortran.dg/gomp/flush-2.f90 | 8 +- gcc/testsuite/gfortran.dg/gomp/requires-2.f90 | 12 +- libgomp/libgomp.texi | 3 +- 10 files changed, 585 insertions(+), 199 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 300ecc4907a..2411869c150 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1644,6 +1644,7 @@ enum gfc_omp_atomic_op enum gfc_omp_requires_kind { /* Keep gfc_namespace's omp_requires bitfield size in sync. */ + OMP_REQ_NONE = 0, /* unset */ OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST = 1, /* 001 */ OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL = 2, /* 010 */ OMP_REQ_ATOMIC_MEM_ORDER_RELAXED = 3, /* 011 */ diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index a1e89e386fd..a2c825401e3 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -2475,16 +2475,112 @@ gfc_match_omp_init (gfc_omp_namelist **list) return MATCH_YES; } +/* Match boolean-type clause with duplicate check. Matches 'name' then matches + an optional '(const-logical-expr)'; already_set is used for the duplicate + check. If the clause is not matched NO is returned, if an error occurs ERROR + and otherwise YES. In the no-error case RES contains the value of the + expression or true if no expression exists. + If FALSE_OK, 'false' implies an absent clause, which can be repeated without + printing an error; that is the case for clause groups. + If DUPL_MSG is nonnull, the string is used as error message and must contain + %qs and %L in that order. */ + +static match +gfc_match_boolean_clause (bool *res, const char *name, bool already_set, + bool false_ok = false, const char *dupl_msg = NULL) +{ + gfc_expr *expr = NULL; + match m; + char c; + locus old_loc = gfc_current_locus; + locus old_loc2; + if ((m = gfc_match (name)) != MATCH_YES) + return m; + /* Ensure that no partial string is matched. */ + if (gfc_current_form == FORM_FREE + && gfc_match_eos () != MATCH_YES + && ((c = gfc_peek_ascii_char ()) == '_' || ISALNUM (c))) + { + gfc_current_locus = old_loc; + return MATCH_NO; + } + if (already_set && !false_ok) + goto dupl; + if (gfc_match (" (") == MATCH_NO) + { + if (already_set) + goto dupl; + *res = true; /* Implicit boolean true. */ + return MATCH_YES; + } + old_loc2 = gfc_current_locus; + m = gfc_match_expr (&expr); + if (m != MATCH_YES + || gfc_match (" )") != MATCH_YES + || !gfc_resolve_expr (expr) + || expr->rank != 0 + || expr->expr_type != EXPR_CONSTANT + || expr->ts.type != BT_LOGICAL) + { + gfc_free_expr (expr); + gfc_error ("Expected %<( const-logical-expr )%> at %L", &old_loc2); + return MATCH_ERROR; + } + if (already_set && expr->value.logical) + goto dupl; + *res = expr->value.logical; + gfc_free_expr (expr); + return MATCH_YES; + +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; +} + + +/* Match a clause from the atomic clauses set. */ + +static match +gfc_match_dupl_atomic (bool *res, const char *name, bool already_set) +{ + const char *msg = G_("Duplicated atomic clause: unexpected %qs clause at %L"); + return gfc_match_boolean_clause (res, name, already_set, true, msg); +} + + +/* Match a clause from the memory-order clauses set. */ + +static match +gfc_match_dupl_memorder (bool *res, const char *name, bool already_set) +{ + const char *msg = G_("Duplicated memory-order clause: unexpected %qs clause " + "at %L"); + return gfc_match_boolean_clause (res, name, already_set, true, msg); +} + + +/* Match a clause from the branch clauses set; interestingly, here + inbranch(false) branch(false/true) is not permitted! */ + +static match +gfc_match_dupl_branch_clause (bool *res, const char *name, bool already_set) +{ + const char *msg = G_("Duplicated branch clause: unexpected %qs clause " + "at %L"); + return gfc_match_boolean_clause (res, name, already_set, false, msg); +} + /* 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. */ + it matches a ' ( ' after 'name'. */ 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) + gfc_expr **expr = NULL) { match m; char c; @@ -2501,10 +2597,7 @@ gfc_match_dupl_check (bool not_dupl, const char *name, bool open_parens = false, } if (!not_dupl) { - if (dupl_msg) - gfc_error (dupl_msg, name, &old_loc); - else - gfc_error ("Duplicated %qs clause at %L", name, &old_loc); + gfc_error ("Duplicated %qs clause at %L", name, &old_loc); return MATCH_ERROR; } if (open_parens || expr) @@ -2526,23 +2619,6 @@ gfc_match_dupl_check (bool not_dupl, const char *name, bool open_parens = false, 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"); -} - - /* Search upwards though namespace NS and its parents to find an !$omp declare mapper named MAPPER_ID, for typespec TS. The default mapper has mapper_id == "". */ @@ -2591,7 +2667,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, gfc_omp_map_op default_map_op = OMP_MAP_TOFROM) { bool error = false; + bool bval; gfc_omp_clauses *c = gfc_get_omp_clauses (); + gfc_omp_clauses *cfalse = openacc ? NULL : gfc_get_omp_clauses (); locus old_loc; /* Determine whether we're dealing with an OpenACC directive that permits derived type member accesses. This in particular disallows @@ -2658,23 +2736,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_MEMORDER) - && (m = gfc_match_dupl_memorder ((c->memorder - == OMP_MEMORDER_UNSET), - "acq_rel")) != MATCH_NO) + && (m = gfc_match_dupl_memorder (&bval, "acq_rel", + c->memorder != OMP_MEMORDER_UNSET)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; - c->memorder = OMP_MEMORDER_ACQ_REL; + if (bval) + c->memorder = OMP_MEMORDER_ACQ_REL; continue; } if ((mask & OMP_CLAUSE_MEMORDER) - && (m = gfc_match_dupl_memorder ((c->memorder - == OMP_MEMORDER_UNSET), - "acquire")) != MATCH_NO) + && (m = gfc_match_dupl_memorder (&bval, "acquire", + c->memorder != OMP_MEMORDER_UNSET)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; - c->memorder = OMP_MEMORDER_ACQUIRE; + if (bval) + c->memorder = OMP_MEMORDER_ACQUIRE; continue; } if ((mask & OMP_CLAUSE_AFFINITY) @@ -2838,12 +2916,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; case 'c': if ((mask & OMP_CLAUSE_CAPTURE) - && (m = gfc_match_dupl_check (!c->capture, "capture")) - != MATCH_NO) + && (m = gfc_match_boolean_clause (&bval, "capture", + c->capture || cfalse->capture)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; - c->capture = true; + if (bval) + c->capture = true; + else + cfalse->capture = true; continue; } if (mask & OMP_CLAUSE_COLLAPSE) @@ -2869,12 +2950,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } } if ((mask & OMP_CLAUSE_COMPARE) - && (m = gfc_match_dupl_check (!c->compare, "compare")) - != MATCH_NO) + && (m = gfc_match_boolean_clause (&bval, "compare", + c->compare || cfalse->compare)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; - c->compare = true; + if (bval) + c->compare = true; + else + cfalse->compare = true; continue; } if ((mask & OMP_CLAUSE_ASSUMPTIONS) @@ -3442,11 +3526,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, &head) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_FULL) - && (m = gfc_match_dupl_check (!c->full, "full")) != MATCH_NO) + && (m = gfc_match_boolean_clause (&bval, "full", + c->full || cfalse->full)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; - c->full = true; + if (bval) + c->full = true; + else + cfalse->full = true; continue; } break; @@ -3573,12 +3661,16 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, openmp_target) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_INBRANCH) - && (m = gfc_match_dupl_check (!c->inbranch && !c->notinbranch, - "inbranch")) != MATCH_NO) + && (m = gfc_match_dupl_branch_clause (&bval, "inbranch", + c->notinbranch || cfalse->notinbranch + || c->inbranch || cfalse->inbranch)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; - c->inbranch = true; + if (bval) + c->inbranch = true; + else + cfalse->inbranch = true; continue; } if ((mask & OMP_CLAUSE_INDEPENDENT) @@ -3591,29 +3683,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_INDIRECT) - && (m = gfc_match_dupl_check (!c->indirect, "indirect")) - != MATCH_NO) + && (m = gfc_match_boolean_clause (&bval, "indirect", + c->indirect || cfalse->indirect)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; - gfc_expr *indirect_expr = NULL; - m = gfc_match (" ( %e )", &indirect_expr); - if (m == MATCH_YES) - { - if (!gfc_resolve_expr (indirect_expr) - || indirect_expr->ts.type != BT_LOGICAL - || indirect_expr->expr_type != EXPR_CONSTANT) - { - gfc_error ("INDIRECT clause at %C requires a constant " - "logical expression"); - gfc_free_expr (indirect_expr); - goto error; - } - c->indirect = indirect_expr->value.logical; - gfc_free_expr (indirect_expr); - } + if (bval) + c->indirect = true; else - c->indirect = 1; + cfalse->indirect = true; continue; } if ((mask & OMP_CLAUSE_INIT) @@ -4059,12 +4137,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; } if ((mask & OMP_CLAUSE_MERGEABLE) - && (m = gfc_match_dupl_check (!c->mergeable, "mergeable")) - != MATCH_NO) + && (m = gfc_match_boolean_clause (&bval, "mergeable", + c->mergeable || cfalse->mergeable)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; - c->mergeable = true; + if (bval) + c->mergeable = true; + else + cfalse->mergeable = true; continue; } if ((mask & OMP_CLAUSE_MESSAGE) @@ -4084,50 +4165,91 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, allow_derived)) continue; if ((mask & OMP_CLAUSE_ASSUMPTIONS) - && (m = gfc_match_dupl_check (!c->assume - || !c->assume->no_openmp_constructs, - "no_openmp_constructs")) != MATCH_NO) + && ((m = gfc_match_boolean_clause (&bval, "no_openmp_constructs", + (c->assume && c->assume->no_openmp_constructs) + || (cfalse->assume && cfalse->assume->no_openmp_constructs))) + != MATCH_NO)) { if (m == MATCH_ERROR) goto error; - if (c->assume == NULL) - c->assume = gfc_get_omp_assumptions (); - c->assume->no_openmp_constructs = true; + if (bval) + { + if (c->assume == NULL) + c->assume = gfc_get_omp_assumptions (); + c->assume->no_openmp_constructs = true; + } + else + { + if (cfalse->assume == NULL) + cfalse->assume = gfc_get_omp_assumptions (); + cfalse->assume->no_openmp_constructs = true; + } continue; } if ((mask & OMP_CLAUSE_ASSUMPTIONS) - && (m = gfc_match_dupl_check (!c->assume - || !c->assume->no_openmp_routines, - "no_openmp_routines")) != MATCH_NO) + && ((m = gfc_match_boolean_clause (&bval, "no_openmp_routines", + (c->assume && c->assume->no_openmp_routines) + || (cfalse->assume && cfalse->assume->no_openmp_routines))) + != MATCH_NO)) { if (m == MATCH_ERROR) goto error; - if (c->assume == NULL) - c->assume = gfc_get_omp_assumptions (); - c->assume->no_openmp_routines = true; + if (bval) + { + if (c->assume == NULL) + c->assume = gfc_get_omp_assumptions (); + c->assume->no_openmp_routines = true; + } + else + { + if (cfalse->assume == NULL) + cfalse->assume = gfc_get_omp_assumptions (); + cfalse->assume->no_openmp_routines = true; + } continue; } if ((mask & OMP_CLAUSE_ASSUMPTIONS) - && (m = gfc_match_dupl_check (!c->assume || !c->assume->no_openmp, - "no_openmp")) != MATCH_NO) + && ((m = gfc_match_boolean_clause (&bval, "no_openmp", + (c->assume && c->assume->no_openmp) + || (cfalse->assume && cfalse->assume->no_openmp))) + != MATCH_NO)) { if (m == MATCH_ERROR) goto error; - if (c->assume == NULL) - c->assume = gfc_get_omp_assumptions (); - c->assume->no_openmp = true; + if (bval) + { + if (c->assume == NULL) + c->assume = gfc_get_omp_assumptions (); + c->assume->no_openmp = true; + } + else + { + if (cfalse->assume == NULL) + cfalse->assume = gfc_get_omp_assumptions (); + cfalse->assume->no_openmp = true; + } continue; } if ((mask & OMP_CLAUSE_ASSUMPTIONS) - && (m = gfc_match_dupl_check (!c->assume - || !c->assume->no_parallelism, - "no_parallelism")) != MATCH_NO) + && ((m = gfc_match_boolean_clause (&bval, "no_parallelism", + (c->assume && c->assume->no_parallelism) + || (cfalse->assume && cfalse->assume->no_parallelism))) + != MATCH_NO)) { if (m == MATCH_ERROR) goto error; - if (c->assume == NULL) - c->assume = gfc_get_omp_assumptions (); - c->assume->no_parallelism = true; + if (bval) + { + if (c->assume == NULL) + c->assume = gfc_get_omp_assumptions (); + c->assume->no_parallelism = true; + } + else + { + if (cfalse->assume == NULL) + cfalse->assume = gfc_get_omp_assumptions (); + cfalse->assume->no_parallelism = true; + } continue; } @@ -4150,12 +4272,16 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_NOGROUP) - && (m = gfc_match_dupl_check (!c->nogroup, "nogroup")) - != MATCH_NO) + && ((m = gfc_match_boolean_clause (&bval, "nogroup", + c->nogroup || cfalse->nogroup)) + != MATCH_NO)) { if (m == MATCH_ERROR) goto error; - c->nogroup = true; + if (bval) + c->nogroup = true; + else + cfalse->nogroup = true; continue; } if ((mask & OMP_CLAUSE_NOHOST) @@ -4172,12 +4298,16 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_NOTINBRANCH) - && (m = gfc_match_dupl_check (!c->notinbranch && !c->inbranch, - "notinbranch")) != MATCH_NO) + && (m = gfc_match_dupl_branch_clause (&bval, "notinbranch", + c->notinbranch || cfalse->notinbranch + || c->inbranch || cfalse->inbranch)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; - c->notinbranch = true; + if (bval) + c->notinbranch = true; + else + cfalse->notinbranch = true; continue; } if ((mask & OMP_CLAUSE_NOWAIT) @@ -4544,13 +4674,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; case 'r': if ((mask & OMP_CLAUSE_ATOMIC) - && (m = gfc_match_dupl_atomic ((c->atomic_op - == GFC_OMP_ATOMIC_UNSET), - "read")) != MATCH_NO) + && (m = gfc_match_dupl_atomic (&bval, "read", + c->atomic_op != GFC_OMP_ATOMIC_UNSET)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; - c->atomic_op = GFC_OMP_ATOMIC_READ; + if (bval) + c->atomic_op = GFC_OMP_ATOMIC_READ; continue; } if ((mask & OMP_CLAUSE_REDUCTION) @@ -4558,23 +4688,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, allow_derived) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_MEMORDER) - && (m = gfc_match_dupl_memorder ((c->memorder - == OMP_MEMORDER_UNSET), - "relaxed")) != MATCH_NO) + && (m = gfc_match_dupl_memorder (&bval, "relaxed", + c->memorder != OMP_MEMORDER_UNSET)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; - c->memorder = OMP_MEMORDER_RELAXED; + if (bval) + c->memorder = OMP_MEMORDER_RELAXED; continue; } if ((mask & OMP_CLAUSE_MEMORDER) - && (m = gfc_match_dupl_memorder ((c->memorder - == OMP_MEMORDER_UNSET), - "release")) != MATCH_NO) + && (m = gfc_match_dupl_memorder (&bval, "release", + c->memorder != OMP_MEMORDER_UNSET)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; - c->memorder = OMP_MEMORDER_RELEASE; + if (bval) + c->memorder = OMP_MEMORDER_RELEASE; continue; } break; @@ -4688,13 +4818,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_MEMORDER) - && (m = gfc_match_dupl_memorder ((c->memorder - == OMP_MEMORDER_UNSET), - "seq_cst")) != MATCH_NO) + && (m = gfc_match_dupl_memorder (&bval, "seq_cst", + c->memorder != OMP_MEMORDER_UNSET)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; - c->memorder = OMP_MEMORDER_SEQ_CST; + if (bval) + c->memorder = OMP_MEMORDER_SEQ_CST; continue; } if ((mask & OMP_CLAUSE_SHARED) @@ -4711,11 +4841,16 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_SIMD) - && (m = gfc_match_dupl_check (!c->simd, "simd")) != MATCH_NO) + && ((m = gfc_match_boolean_clause (&bval, "simd", + c->simd || cfalse->simd)) + != MATCH_NO)) { if (m == MATCH_ERROR) goto error; - c->simd = true; + if (bval) + c->simd = true; + else + cfalse->simd = false; continue; } if ((mask & OMP_CLAUSE_SEVERITY) @@ -4864,12 +4999,16 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_THREADS) - && (m = gfc_match_dupl_check (!c->threads, "threads")) - != MATCH_NO) + && ((m = gfc_match_boolean_clause (&bval, "threads", + c->threads || cfalse->threads)) + != MATCH_NO)) { if (m == MATCH_ERROR) goto error; - c->threads = true; + if (bval) + c->threads = true; + else + cfalse->threads = false; continue; } if ((mask & OMP_CLAUSE_TILE) @@ -4905,21 +5044,26 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, false) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_UNTIED) - && (m = gfc_match_dupl_check (!c->untied, "untied")) != MATCH_NO) + && ((m = gfc_match_boolean_clause (&bval, "untied", + c->untied || cfalse->untied)) + != MATCH_NO)) { if (m == MATCH_ERROR) goto error; - c->untied = true; + if (bval) + c->untied = true; + else + cfalse->untied = true; continue; } if ((mask & OMP_CLAUSE_ATOMIC) - && (m = gfc_match_dupl_atomic ((c->atomic_op - == GFC_OMP_ATOMIC_UNSET), - "update")) != MATCH_NO) + && (m = gfc_match_dupl_atomic (&bval, "update", + c->atomic_op != GFC_OMP_ATOMIC_UNSET)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; - c->atomic_op = GFC_OMP_ATOMIC_UPDATE; + if (bval) + c->atomic_op = GFC_OMP_ATOMIC_UPDATE; continue; } if ((mask & OMP_CLAUSE_USE) @@ -4999,12 +5143,16 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_WEAK) - && (m = gfc_match_dupl_check (!c->weak, "weak")) - != MATCH_NO) + && ((m = gfc_match_boolean_clause (&bval, "weak", + c->weak || cfalse->weak)) + != MATCH_NO)) { if (m == MATCH_ERROR) goto error; - c->weak = true; + if (bval) + c->weak = true; + else + cfalse->weak = true; continue; } if ((mask & OMP_CLAUSE_WORKER) @@ -5019,13 +5167,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_ATOMIC) - && (m = gfc_match_dupl_atomic ((c->atomic_op - == GFC_OMP_ATOMIC_UNSET), - "write")) != MATCH_NO) + && (m = gfc_match_dupl_atomic (&bval, "write", + c->atomic_op != GFC_OMP_ATOMIC_UNSET)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; - c->atomic_op = GFC_OMP_ATOMIC_WRITE; + if (bval) + c->atomic_op = GFC_OMP_ATOMIC_WRITE; continue; } break; @@ -5034,6 +5182,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } end: + if (cfalse) + gfc_free_omp_clauses (cfalse); if (error || gfc_match_omp_eos () != MATCH_YES) { if (!gfc_error_flag_test ()) @@ -6245,41 +6395,74 @@ gfc_match_omp_flush (void) gfc_omp_clauses *c = NULL; gfc_gobble_whitespace (); enum gfc_omp_memorder mo = OMP_MEMORDER_UNSET; - if (gfc_match_omp_eos () == MATCH_NO && gfc_peek_ascii_char () != '(') + if (gfc_match_omp_variable_list (" (", &list, true) == MATCH_ERROR) + return MATCH_ERROR; + match m = MATCH_YES; + while (gfc_match_omp_eos () != MATCH_YES) { + gfc_gobble_whitespace (); gfc_match (", "); /* optionally */ - if (gfc_match ("seq_cst") == MATCH_YES) - mo = OMP_MEMORDER_SEQ_CST; - else if (gfc_match ("acq_rel") == MATCH_YES) - mo = OMP_MEMORDER_ACQ_REL; - else if (gfc_match ("release") == MATCH_YES) - mo = OMP_MEMORDER_RELEASE; - else if (gfc_match ("acquire") == MATCH_YES) - mo = OMP_MEMORDER_ACQUIRE; - else - { - gfc_error ("Expected SEQ_CST, AQC_REL, RELEASE, or ACQUIRE at %C"); - return MATCH_ERROR; + enum gfc_omp_memorder mo2 = OMP_MEMORDER_UNSET; + bool bval = false; + locus loc = gfc_current_locus; + if ((m = gfc_match_dupl_memorder (&bval, "seq_cst", + mo != OMP_MEMORDER_UNSET)) != MATCH_NO) + mo2 = OMP_MEMORDER_SEQ_CST; + else if ((m = gfc_match_dupl_memorder (&bval, "acq_rel", + mo != OMP_MEMORDER_UNSET)) + != MATCH_NO) + mo2 = OMP_MEMORDER_ACQ_REL; + else if ((m = gfc_match_dupl_memorder (&bval, "release", + mo != OMP_MEMORDER_UNSET)) + != MATCH_NO) + mo2 = OMP_MEMORDER_RELEASE; + else if ((m = gfc_match_dupl_memorder (&bval, "acquire", + mo != OMP_MEMORDER_UNSET)) + != MATCH_NO) + mo2 = OMP_MEMORDER_ACQUIRE; + else if ((m = gfc_match_dupl_memorder (&bval, "relaxed", + mo != OMP_MEMORDER_UNSET)) + != MATCH_NO) + { + if (m == MATCH_YES && bval) + { + /* relaxed only permitted with 'false'. */ + gfc_current_locus = loc; + m = MATCH_NO; + break; + } } - c = gfc_get_omp_clauses (); - c->memorder = mo; + else + break; + if (m == MATCH_ERROR) + return MATCH_ERROR; + if (bval) + mo = mo2; + } + if (m == MATCH_NO) + { + gfc_error ("Expected SEQ_CST, AQC_REL, RELEASE, or ACQUIRE at %C"); + gfc_free_omp_namelist (list, OMP_LIST_NONE); + return MATCH_ERROR; } - gfc_match_omp_variable_list (" (", &list, true); if (list && mo != OMP_MEMORDER_UNSET) { gfc_error ("List specified together with memory order clause in FLUSH " "directive at %C"); gfc_free_omp_namelist (list, OMP_LIST_NONE); - gfc_free_omp_clauses (c); return MATCH_ERROR; } if (gfc_match_omp_eos () != MATCH_YES) { gfc_error ("Unexpected junk after $OMP FLUSH statement at %C"); gfc_free_omp_namelist (list, OMP_LIST_NONE); - gfc_free_omp_clauses (c); return MATCH_ERROR; } + if (mo != OMP_MEMORDER_UNSET) + { + c = gfc_get_omp_clauses (); + c->memorder = mo; + } new_st.op = EXEC_OMP_FLUSH; new_st.ext.omp_namelist = list; new_st.ext.omp_clauses = c; @@ -8436,9 +8619,10 @@ gfc_match_omp_requires (void) "unified_shared_memory", "self_maps", "dynamic_allocators", - "atomic_default"}; + "atomic_default_mem_order"}; const char *clause = NULL; int requires_clauses = 0; + int seen_clauses = 0; bool first = true; locus old_loc; @@ -8457,10 +8641,15 @@ gfc_match_omp_requires (void) return MATCH_ERROR; } + /* Specifying '<clause>(.false.)' in this directive does not affect requirements + set in another 'requires' directive in the same compilation unit; however, + specifying it multiple times in the same directive is disallowed. */ while (true) { + bool bval; + match m; old_loc = gfc_current_locus; - gfc_omp_requires_kind requires_clause; + gfc_omp_requires_kind requires_clause = OMP_REQ_NONE; if (gfc_match_char (',') != MATCH_YES && (first && gfc_match_space () != MATCH_YES)) goto error; @@ -8470,46 +8659,64 @@ gfc_match_omp_requires (void) if (gfc_match_omp_eos () != MATCH_NO) break; - if (gfc_match (clauses[0]) == MATCH_YES) + if ((m = gfc_match_boolean_clause (&bval, clauses[0], + seen_clauses & OMP_REQ_REVERSE_OFFLOAD)) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; clause = clauses[0]; - requires_clause = OMP_REQ_REVERSE_OFFLOAD; - if (requires_clauses & OMP_REQ_REVERSE_OFFLOAD) - goto duplicate_clause; + seen_clauses |= OMP_REQ_REVERSE_OFFLOAD; + if (bval) + requires_clause = OMP_REQ_REVERSE_OFFLOAD; } - else if (gfc_match (clauses[1]) == MATCH_YES) + else if ((m = gfc_match_boolean_clause (&bval, clauses[1], + seen_clauses & OMP_REQ_UNIFIED_ADDRESS)) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; clause = clauses[1]; - requires_clause = OMP_REQ_UNIFIED_ADDRESS; - if (requires_clauses & OMP_REQ_UNIFIED_ADDRESS) - goto duplicate_clause; + seen_clauses |= OMP_REQ_UNIFIED_ADDRESS; + if (bval) + requires_clause = OMP_REQ_UNIFIED_ADDRESS; } - else if (gfc_match (clauses[2]) == MATCH_YES) + else if ((m = gfc_match_boolean_clause (&bval, clauses[2], + seen_clauses & OMP_REQ_UNIFIED_SHARED_MEMORY)) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; clause = clauses[2]; - requires_clause = OMP_REQ_UNIFIED_SHARED_MEMORY; - if (requires_clauses & OMP_REQ_UNIFIED_SHARED_MEMORY) - goto duplicate_clause; + seen_clauses |= OMP_REQ_UNIFIED_SHARED_MEMORY; + if (bval) + requires_clause = OMP_REQ_UNIFIED_SHARED_MEMORY; } - else if (gfc_match (clauses[3]) == MATCH_YES) + else if ((m = gfc_match_boolean_clause (&bval, clauses[3], + seen_clauses & OMP_REQ_SELF_MAPS)) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; clause = clauses[3]; - requires_clause = OMP_REQ_SELF_MAPS; - if (requires_clauses & OMP_REQ_SELF_MAPS) - goto duplicate_clause; + seen_clauses |= OMP_REQ_SELF_MAPS; + if (bval) + requires_clause = OMP_REQ_SELF_MAPS; } - else if (gfc_match (clauses[4]) == MATCH_YES) + else if ((m = gfc_match_boolean_clause (&bval, clauses[4], + seen_clauses & OMP_REQ_DYNAMIC_ALLOCATORS)) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; clause = clauses[4]; - requires_clause = OMP_REQ_DYNAMIC_ALLOCATORS; - if (requires_clauses & OMP_REQ_DYNAMIC_ALLOCATORS) - goto duplicate_clause; + seen_clauses |= OMP_REQ_DYNAMIC_ALLOCATORS; + if (bval) + requires_clause = OMP_REQ_DYNAMIC_ALLOCATORS; } - else if (gfc_match ("atomic_default_mem_order (") == MATCH_YES) + else if ((m = gfc_match_dupl_check ( + !(seen_clauses & OMP_REQ_ATOMIC_MEM_ORDER_MASK), + clauses[5], true)) != MATCH_NO) { - clause = clauses[5]; - if (requires_clauses & OMP_REQ_ATOMIC_MEM_ORDER_MASK) - goto duplicate_clause; + if (m == MATCH_ERROR) + goto error; + seen_clauses |= OMP_REQ_ATOMIC_MEM_ORDER_MASK; if (gfc_match (" seq_cst )") == MATCH_YES) { clause = "seq_cst"; @@ -8545,21 +8752,16 @@ gfc_match_omp_requires (void) else goto error; - if (!gfc_omp_requires_add_clause (requires_clause, clause, &old_loc, NULL)) + if (requires_clause != OMP_REQ_NONE + && !gfc_omp_requires_add_clause (requires_clause, clause, &old_loc, NULL)) goto error; requires_clauses |= requires_clause; } if (requires_clauses == 0) - { - if (!gfc_error_flag_test ()) - gfc_error ("Clause expected at %C"); - goto error; - } + goto error; return MATCH_YES; -duplicate_clause: - gfc_error ("%qs clause at %L specified more than once", clause, &old_loc); error: if (!gfc_error_flag_test ()) gfc_error ("Expected UNIFIED_ADDRESS, UNIFIED_SHARED_MEMORY, SELF_MAPS, " diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-18.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-18.f90 index 9bc6f637aca..6c8f44a1e9e 100644 --- a/gcc/testsuite/gfortran.dg/gomp/atomic-18.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/atomic-18.f90 @@ -5,9 +5,9 @@ real f contains subroutine foo (j) integer, value :: j - !$omp atomic update,update ! { dg-error "Duplicated atomic clause: unexpected update clause" } + !$omp atomic update,update ! { dg-error "Duplicated atomic clause: unexpected 'update' clause" } i = i + 1 - !$omp atomic seq_cst release ! { dg-error "Duplicated memory-order clause: unexpected release clause" } + !$omp atomic seq_cst release ! { dg-error "Duplicated memory-order clause: unexpected 'release' clause" } i = i + 1 !$omp atomic read,release ! { dg-error "ATOMIC READ at .1. incompatible with RELEASE clause" } v = i diff --git a/gcc/testsuite/gfortran.dg/gomp/clause-logical-arg-1.f90 b/gcc/testsuite/gfortran.dg/gomp/clause-logical-arg-1.f90 new file mode 100644 index 00000000000..2ef4d0f3427 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/clause-logical-arg-1.f90 @@ -0,0 +1,109 @@ +! { dg-do compile } + +module m + implicit none + !$omp requires dynamic_allocators(.true.), reverse_offload(.false.), self_maps(.false.), unified_address(.false.), unified_shared_memory(.false.) + !$omp requires dynamic_allocators(.false.), reverse_offload(.true.), self_maps(.true.), unified_address(.true.), unified_shared_memory(.true.) + !$omp assumes no_openmp(.false.), no_openmp_constructs(.false.) no_openmp_routines(.false.) no_parallelism(.false.) + !$omp assumes no_openmp(.true.), no_openmp_constructs(.true.) no_openmp_routines(.true.) no_parallelism(.true.) + integer :: x +contains +subroutine branch1 + !$omp declare simd notinbranch(.false.) +end +subroutine branch2 + !$omp declare simd notinbranch(.true.) +end +subroutine branch3 + !$omp declare simd notinbranch(.false.) +end +subroutine branch4 + !$omp declare simd notinbranch(.true.) +end +subroutine foo + integer :: y, r + !$omp atomic read(.false.) update(.false.) write(.false.) acq_rel(.false.), acquire(.false.), relaxed ( .true. ), release (.false.), seq_cst(.false.) weak(.false.) capture(.false.) compare(.false.) + x = x + 1 + !$omp atomic read(.false.) update(.true.) write(.false.) acq_rel(.false.), acquire(.false.), relaxed ( .false. ), release (.false.), seq_cst(.true.) weak(.false.) capture( .false. ), compare( .false. ) + x = x + 1 + !$omp atomic read(.true.) update(.false.) write(.false.) acq_rel(.false.), acquire(.true.), relaxed ( .false. ), release (.false.), seq_cst(.false.) + y = x + !$omp atomic read(.false.) update(.false.) write(.true.) acq_rel(.true.), acquire(.false.), relaxed ( .false. ), release (.false.), seq_cst(.false.) + x = y + 1 + !$omp atomic read(.false.) update(.false.) write(.true.) acq_rel(.false.), acquire(.false.), relaxed ( .false. ), release (.false.), seq_cst(.false.) + x = y + 1 + + !$omp atomic read(.false.) update write(.false.) acq_rel(.false.), acquire(.false.), relaxed ( .false. ), release (.false.), seq_cst(.true.) weak(.false.) capture( .false. ), compare( .false. ) + x = x + 1 + !$omp atomic read,update(.false.) write(.false.) acq_rel(.false.), acquire(.true.), relaxed ( .false. ), release (.false.), seq_cst(.false.) + y = x + !$omp atomic read(.false.) update(.false.) write acq_rel(.true.), acquire(.false.), relaxed ( .false. ), release (.false.), seq_cst(.false.) + x = y + 1 + + !$omp atomic compare(.true.) weak(.true.) + if (x == y) x = 5 + + ! Flush: relaxed(.true.) not permitted + !$omp flush acq_rel(.true.) , acquire(.false.), relaxed ( .false. ), release (.false.), seq_cst(.false.) + !$omp flush acq_rel, acquire(.false.), relaxed ( .false. ), release (.false.), seq_cst(.false.) + !$omp flush acq_rel(.false.), acquire(.true.), relaxed ( .false. ), release (.false.), seq_cst(.false.) + !$omp flush acq_rel(.false.), acquire , relaxed ( .false. ), release (.false.), seq_cst(.false.) + !$omp flush acq_rel(.false.), acquire(.false.), relaxed ( .false. ), release (.true.), seq_cst(.false.) + !$omp flush acq_rel(.false.), acquire(.false.), relaxed ( .false. ), release , seq_cst(.false.) + !$omp flush acq_rel(.false.), acquire(.false.), relaxed ( .false. ), release (.false.), seq_cst(.true.) + !$omp flush acq_rel(.false.), acquire(.false.), relaxed ( .false. ), release (.false.), seq_cst + + !$omp unroll full(.false.) + do y = 1, x + end do + + !$omp unroll full(.true.) + do y = 1, 5 + end do +end +subroutine sub + !$omp ordered threads(.false.),simd(.false.) + !$omp end ordered + !$omp ordered threads(.true.),simd(.false.) + !$omp end ordered + !$omp ordered threads(.false.),simd(.true.) + !$omp end ordered + !$omp ordered threads(.true.),simd(.true.) + !$omp end ordered +end subroutine sub + +subroutine other + !$omp task untied(.true.) + !$omp end task + !$omp task untied(.false.) + !$omp end task +end +end module + + +!Memorder: acq_rel, acquire, relaxed, release, seq_cst +! atomic flush +! +!atomic: +! read, update, write +! +!Extended atomic: capture, compare, weak (+fail) +! atomic +! +!requirement: [device_safesync,] dynamic_allocators, reverse_offload, self_maps, unified_address, unified_shared_memory (+ atomic_default_mem_order) +! requires +! +!branch: inbranch, notinbranch +! declare_simd +! +!assumptions: no_openmp, no_openmp_constructs, no_openmp_routines, no_parallelism +! assume(s) +! +!parallelization-level: threads, simd +! ordered +! +!full +! unroll +! +!untied +! task, taskloop diff --git a/gcc/testsuite/gfortran.dg/gomp/clause-logical-arg-2.f90 b/gcc/testsuite/gfortran.dg/gomp/clause-logical-arg-2.f90 new file mode 100644 index 00000000000..c582a334d5c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/clause-logical-arg-2.f90 @@ -0,0 +1,73 @@ +! { dg-do compile } + +module m + implicit none + !$omp requires dynamic_allocators(.false.), reverse_offload(.false.), self_maps(.false.), unified_address(.false.), unified_shared_memory(.false.) ! { dg-error "Expected UNIFIED_ADDRESS, UNIFIED_SHARED_MEMORY, SELF_MAPS, DYNAMIC_ALLOCATORS, REVERSE_OFFLOAD, or ATOMIC_DEFAULT_MEM_ORDER clause" } + !$omp requires self_maps(.true.), self_maps(.true.) ! { dg-error "Duplicated 'self_maps' clause" } + !$omp requires unified_address(.false.), unified_address(.false.) ! { dg-error "Duplicated 'unified_address' clause" } + !$omp requires reverse_offload(.false.), reverse_offload(.true.) ! { dg-error "Duplicated 'reverse_offload' clause" } + !$omp requires self_maps, self_maps(.true.) ! { dg-error "Duplicated 'self_maps' clause" } + !$omp requires self_maps(.true.), self_maps ! { dg-error "Duplicated 'self_maps' clause" } + !$omp requires self_maps, self_maps ! { dg-error "Duplicated 'self_maps' clause" } + integer :: x +contains +subroutine branch1 + !$omp declare simd inbranch(.false.) notinbranch(.false.) ! { dg-error "Duplicated branch clause: unexpected 'notinbranch' clause" } +end +subroutine branch2 + !$omp declare simd inbranch(.false.) notinbranch(.true.) ! { dg-error "Duplicated branch clause: unexpected 'notinbranch' clause" } +end +subroutine branch3 + !$omp declare simd notinbranch(.false.) inbranch(.true.) ! { dg-error "Duplicated branch clause: unexpected 'inbranch' clause" } +end +subroutine branch4 + !$omp declare simd notinbranch(.true.) inbranch(.true.) ! { dg-error "Duplicated branch clause: unexpected 'inbranch' clause" } +end +subroutine foo + integer :: y, r + !$omp atomic read(.false.) update write(.true.) ! { dg-error "Duplicated atomic clause: unexpected 'write' clause" } + x = x + 1 + !$omp atomic read(.false.) update(.true.) write(.true.) ! { dg-error "Duplicated atomic clause: unexpected 'write' clause" } + x = x + 1 + !$omp atomic write(.false.) write(.true.) + y = x + !$omp atomic write write(.false.) + y = x + !$omp atomic write write(.true.) ! { dg-error "Duplicated atomic clause: unexpected 'write' clause" } + y = x + + !$omp atomic acq_rel(.false.), acquire(.false.), relaxed ( .true. ), release ! { dg-error "Duplicated memory-order clause: unexpected 'release' clause" } + x = x + 1 + + ! Flush: relaxed(.true.) not permitted + !$omp flush(y), acq_rel(.true.) ! { dg-error "List specified together with memory order clause in FLUSH directive" } + !$omp flush relaxed ! { dg-error "Expected SEQ_CST, AQC_REL, RELEASE, or ACQUIRE" } + !$omp flush + !$omp flush other ! { dg-error "Expected SEQ_CST, AQC_REL, RELEASE, or ACQUIRE" } + + !$omp flush acq_rel(.true.), acquire(.true.) ! { dg-error "Duplicated memory-order clause: unexpected 'acquire' clause" } + + !$omp unroll full(.true.) full(.false.) ! { dg-error "Duplicated 'full' clause" } + do y = 1, x + end do + + !$omp unroll full(.true.) full(.true.) ! { dg-error "Duplicated 'full' clause" } + do y = 1, 5 + end do + + !$omp unroll full( ! { dg-error "Expected '\\( const-logical-expr \\)'" } + do y = 1, 5; end do + + !$omp unroll full(1 ! { dg-error "Expected '\\( const-logical-expr \\)'" } + do y = 1, 5; end do + + !$omp unroll full(x > 0) ! { dg-error "Expected '\\( const-logical-expr \\)'" } + do y = 1, 5; end do + + !$omp unroll full(5) ! { dg-error "Expected '\\( const-logical-expr \\)'" } + do y = 1, 5; end do + + !$omp unroll full([.true.]) ! { dg-error "Expected '\\( const-logical-expr \\)'" } + do y = 1, 5; end do +end +end module diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90 index 04abd5128f5..9658409f33d 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 "Duplicated 'notinbranch' clause" } +!$omp declare simd (fn1) inbranch notinbranch uniform (x) ! { dg-error "Duplicated branch clause: unexpected '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/declare-target-indirect-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 index b50fb37027f..3d77e2c62f8 100644 --- a/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 @@ -23,12 +23,12 @@ contains end subroutine subroutine sub4 - !$omp declare target to (sub4) indirect (1) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + !$omp declare target to (sub4) indirect (1) ! { dg-error "Expected '\\( const-logical-expr \\)'" } end subroutine ! Compile-time non-constant expressions are not allowed. subroutine sub5 - !$omp declare target indirect (a > 0) to (sub5) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + !$omp declare target indirect (a > 0) to (sub5) ! { dg-error "Expected '\\( const-logical-expr \\)'" } end subroutine ! Compile-time constant expressions are permissible. @@ -45,11 +45,11 @@ contains end subroutine subroutine sub9 - !$omp declare target to (sub9) indirect ("abs") ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + !$omp declare target to (sub9) indirect ("abs") ! { dg-error "Expected '\\( const-logical-expr \\)'" } end subroutine subroutine sub10 - !$omp declare target to (sub10) indirect (5.5) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + !$omp declare target to (sub10) indirect (5.5) ! { dg-error "Expected '\\( const-logical-expr \\)'" } end subroutine subroutine sub11 diff --git a/gcc/testsuite/gfortran.dg/gomp/flush-2.f90 b/gcc/testsuite/gfortran.dg/gomp/flush-2.f90 index ba234448a60..6a5c0ac67bb 100644 --- a/gcc/testsuite/gfortran.dg/gomp/flush-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/flush-2.f90 @@ -12,8 +12,8 @@ subroutine foo (void) !$omp flush seq_cst !$omp flush relaxed ! { dg-error "Expected SEQ_CST, AQC_REL, RELEASE, or ACQUIRE" } !$omp flush foobar ! { dg-error "Expected SEQ_CST, AQC_REL, RELEASE, or ACQUIRE" } - !$omp flush acquire (a, b) ! { dg-error "List specified together with memory order clause in FLUSH directive" } - !$omp flush release (a, b) ! { dg-error "List specified together with memory order clause in FLUSH directive" } - !$omp flush acq_rel (a, b) ! { dg-error "List specified together with memory order clause in FLUSH directive" } - !$omp flush seq_cst (a, b) ! { dg-error "List specified together with memory order clause in FLUSH directive" } + !$omp flush acquire (a, b) ! { dg-error "Expected '\\( const-logical-expr \\)'" } + !$omp flush release (a, b) ! { dg-error "Expected '\\( const-logical-expr \\)'" } + !$omp flush acq_rel (a, b) ! { dg-error "Expected '\\( const-logical-expr \\)'" } + !$omp flush seq_cst (a, b) ! { dg-error "Expected '\\( const-logical-expr \\)'" } end diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-2.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-2.f90 index ed9f8ea352a..cdd0eadf6a7 100644 --- a/gcc/testsuite/gfortran.dg/gomp/requires-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/requires-2.f90 @@ -1,10 +1,10 @@ -!$omp requires ! { dg-error "Clause expected" } -!$omp requires unified_shared_memory,unified_shared_memory ! { dg-error "specified more than once" } -!$omp requires unified_address unified_address ! { dg-error "specified more than once" } -!$omp requires reverse_offload reverse_offload ! { dg-error "specified more than once" } +!$omp requires ! { dg-error "Expected UNIFIED_ADDRESS, UNIFIED_SHARED_MEMORY, SELF_MAPS, DYNAMIC_ALLOCATORS, REVERSE_OFFLOAD, or ATOMIC_DEFAULT_MEM_ORDER clause" } +!$omp requires unified_shared_memory,unified_shared_memory ! { dg-error "Duplicated 'unified_shared_memory' clause" } +!$omp requires unified_address unified_address ! { dg-error "Duplicated 'unified_address' clause" } +!$omp requires reverse_offload reverse_offload ! { dg-error "Duplicated 'reverse_offload' clause" } !$omp requires foobarbaz ! { dg-error "Expected UNIFIED_ADDRESS, UNIFIED_SHARED_MEMORY, SELF_MAPS, DYNAMIC_ALLOCATORS, REVERSE_OFFLOAD, or ATOMIC_DEFAULT_MEM_ORDER clause" } -!$omp requires dynamic_allocators , dynamic_allocators ! { dg-error "specified more than once" } -!$omp requires atomic_default_mem_order(seq_cst) atomic_default_mem_order(seq_cst) ! { dg-error "specified more than once" } +!$omp requires dynamic_allocators , dynamic_allocators ! { dg-error "Duplicated 'dynamic_allocators' clause" } +!$omp requires atomic_default_mem_order(seq_cst) atomic_default_mem_order(seq_cst) ! { dg-error "Duplicated 'atomic_default_mem_order' clause" } !$omp requires atomic_default_mem_order (seq_cst) !$omp requires atomic_default_mem_order (seq_cst) !$omp requires atomic_default_mem_order (acq_rel) ! { dg-error "overrides a previous 'atomic_default_mem_order\\(seq_cst\\)'" } diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi index 7f34a36e38b..2d6cc737840 100644 --- a/libgomp/libgomp.texi +++ b/libgomp/libgomp.texi @@ -483,7 +483,8 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab @item The OpenMP directive syntax was extended to include C23 attribute specifiers @tab Y @tab @item Support for pure directives in Fortran's @code{do concurrent} @tab N @tab -@item All inarguable clauses take now an optional Boolean argument @tab N @tab +@item All inarguable clauses take now an optional Boolean argument @tab P @tab + Only Fortran @item The @code{adjust_args} clause was extended to specify the argument by position and supports variadic arguments @tab N @tab @item For Fortran, @emph{locator list} can be also function reference with
