[gcc r17-2538] Fortran/OpenMP: Add parsing support for spatial dimensions
Tobias Burnus via Gcc-cvs <[email protected]>
| Newsgroups | gmane.comp.gcc.cvs |
|---|---|
| Message-ID | <[email protected]> |
https://gcc.gnu.org/g:61f2dff87339b642e132b30845b928117b514896 commit r17-2538-g61f2dff87339b642e132b30845b928117b514896 Author: Tobias Burnus <[email protected]> Date: Mon Jul 20 09:19:04 2026 +0200 Fortran/OpenMP: Add parsing support for spatial dimensions Adds 'dim(...)' modifier parsing for spatial dimensions to the num_teams, thread_limit, and num_threads clauses. Add strict + relaxed modifier support to the thread_limit and num_threads clauses. [For teams, the effect of strict/relaxed is provided by the lower_bound feature.] For num_threads, support specifying multiple values - to be applicable for nested parallel constructs. NOTE: All added features (but 'relaxed') will fail after parsing with a 'sorry, unimplemented' as only the parsing support has been added and not the actual feature. gcc/fortran/ChangeLog: * dump-parse-tree.cc (show_omp_clauses): Handle spatial dimension in num_teams and it and strict/relaxed in thread_limits and num_threads. * trans-openmp.cc (gfc_trans_omp_clauses, gfc_split_omp_clauses, gfc_trans_omp_target): Likewise. * openmp.cc (gfc_free_omp_clauses, gfc_match_omp_clauses, resolve_omp_clauses): Likewise. (match_omp_oacc_expr_list): Return current locus for a parse fail instead of resetting the locus. * gfortran.h (gfc_omp_clauses): Changed gfc_expr num_threads, num_teams_lower, num_teams_upper, and thread_limit to gfc_expr_list num_threads_list, num_teams_list, and thread_limit_list. Add thread_limit_strict, num_threads_strict, num_teams_dims, thread_limit_dims, and num_threads_dims. * frontend-passes.cc (gfc_code_walker): Update for this change. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/spatial-dimensions-1.f90: New test. * gfortran.dg/gomp/spatial-dimensions-2.f90: New test. * gfortran.dg/gomp/spatial-dimensions-3.f90: New test. Diff: --- gcc/fortran/dump-parse-tree.cc | 60 +++- gcc/fortran/frontend-passes.cc | 13 +- gcc/fortran/gfortran.h | 9 +- gcc/fortran/openmp.cc | 301 ++++++++++++++++++--- gcc/fortran/trans-openmp.cc | 106 +++++--- .../gfortran.dg/gomp/spatial-dimensions-1.f90 | 116 ++++++++ .../gfortran.dg/gomp/spatial-dimensions-2.f90 | 22 ++ .../gfortran.dg/gomp/spatial-dimensions-3.f90 | 252 +++++++++++++++++ 8 files changed, 794 insertions(+), 85 deletions(-) diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 5f058cdc8300..3f1b35b715a5 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -1898,10 +1898,24 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) show_expr (omp_clauses->final_expr); fputc (')', dumpfile); } - if (omp_clauses->num_threads) + if (omp_clauses->num_threads_list) { fputs (" NUM_THREADS(", dumpfile); - show_expr (omp_clauses->num_threads); + if (omp_clauses->num_threads_strict) + fputs ("STRICT", dumpfile); + if (omp_clauses->num_threads_strict && omp_clauses->num_threads_dims) + fputc (',', dumpfile); + if (omp_clauses->num_threads_dims) + fputs ("DIMS()", dumpfile); + if (omp_clauses->num_threads_strict || omp_clauses->num_threads_dims) + fputc (':', dumpfile); + gfc_expr_list *nt; + for (nt = omp_clauses->num_threads_list; nt; nt = nt->next) + { + show_expr (nt->expr); + if (nt->next) + fputs (", ", dumpfile); + } fputc (')', dumpfile); } if (omp_clauses->async) @@ -2199,15 +2213,29 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) } fprintf (dumpfile, " BIND(%s)", type); } - if (omp_clauses->num_teams_upper) + if (omp_clauses->num_teams_list) { fputs (" NUM_TEAMS(", dumpfile); - if (omp_clauses->num_teams_lower) + if (omp_clauses->num_teams_dims) { - show_expr (omp_clauses->num_teams_lower); - fputc (':', dumpfile); + fputs ("DIMS():", dumpfile); + gfc_expr_list *nt; + for (nt = omp_clauses->num_teams_list; nt; nt = nt->next) + { + show_expr (nt->expr); + if (nt->next) + fputs (", ", dumpfile); + } + } + else + { + show_expr (omp_clauses->num_teams_list->expr); + if (omp_clauses->num_teams_list->next) + { + fputc (':', dumpfile); + show_expr (omp_clauses->num_teams_list->next->expr); + } } - show_expr (omp_clauses->num_teams_upper); fputc (')', dumpfile); } if (omp_clauses->device) @@ -2218,10 +2246,24 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) show_expr (omp_clauses->device); fputc (')', dumpfile); } - if (omp_clauses->thread_limit) + if (omp_clauses->thread_limit_list) { fputs (" THREAD_LIMIT(", dumpfile); - show_expr (omp_clauses->thread_limit); + if (omp_clauses->thread_limit_strict) + fputs ("STRICT", dumpfile); + if (omp_clauses->thread_limit_strict && omp_clauses->thread_limit_dims) + fputc (',', dumpfile); + if (omp_clauses->thread_limit_dims) + fputs ("DIMS()", dumpfile); + if (omp_clauses->thread_limit_strict || omp_clauses->thread_limit_dims) + fputc (':', dumpfile); + gfc_expr_list *nt; + for (nt = omp_clauses->thread_limit_list; nt; nt = nt->next) + { + show_expr (nt->expr); + if (nt->next) + fputs (", ", dumpfile); + } fputc (')', dumpfile); } if (omp_clauses->dist_sched_kind != OMP_SCHED_NONE) diff --git a/gcc/fortran/frontend-passes.cc b/gcc/fortran/frontend-passes.cc index 92678310ffd3..fd34f0c19121 100644 --- a/gcc/fortran/frontend-passes.cc +++ b/gcc/fortran/frontend-passes.cc @@ -5709,14 +5709,10 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, for (idx = 0; idx < OMP_IF_LAST; idx++) WALK_SUBEXPR (co->ext.omp_clauses->if_exprs[idx]); WALK_SUBEXPR (co->ext.omp_clauses->final_expr); - WALK_SUBEXPR (co->ext.omp_clauses->num_threads); WALK_SUBEXPR (co->ext.omp_clauses->chunk_size); WALK_SUBEXPR (co->ext.omp_clauses->safelen_expr); WALK_SUBEXPR (co->ext.omp_clauses->simdlen_expr); - WALK_SUBEXPR (co->ext.omp_clauses->num_teams_lower); - WALK_SUBEXPR (co->ext.omp_clauses->num_teams_upper); WALK_SUBEXPR (co->ext.omp_clauses->device); - WALK_SUBEXPR (co->ext.omp_clauses->thread_limit); WALK_SUBEXPR (co->ext.omp_clauses->dist_chunk_size); WALK_SUBEXPR (co->ext.omp_clauses->grainsize); WALK_SUBEXPR (co->ext.omp_clauses->hint); @@ -5726,6 +5722,15 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, WALK_SUBEXPR (co->ext.omp_clauses->dyn_groupprivate); WALK_SUBEXPR (co->ext.omp_clauses->novariants); WALK_SUBEXPR (co->ext.omp_clauses->nocontext); + gfc_expr_list *el = co->ext.omp_clauses->num_teams_list; + for ( ; el; el = el->next) + WALK_SUBEXPR (el->expr); + el = co->ext.omp_clauses->thread_limit_list; + for ( ; el; el = el->next) + WALK_SUBEXPR (el->expr); + el = co->ext.omp_clauses->num_threads_list; + for ( ; el; el = el->next) + WALK_SUBEXPR (el->expr); for (idx = 0; idx < ARRAY_SIZE (list_types); idx++) for (n = co->ext.omp_clauses->lists[list_types[idx]]; n; n = n->next) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index df987576fffb..48ddd9a72d5e 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1709,14 +1709,13 @@ typedef struct gfc_omp_clauses struct gfc_expr *if_exprs[OMP_IF_LAST]; struct gfc_expr *self_expr; struct gfc_expr *final_expr; - struct gfc_expr *num_threads; + struct gfc_expr_list *num_threads_list; struct gfc_expr *chunk_size; struct gfc_expr *safelen_expr; struct gfc_expr *simdlen_expr; - struct gfc_expr *num_teams_lower; - struct gfc_expr *num_teams_upper; + struct gfc_expr_list *num_teams_list; struct gfc_expr *device; - struct gfc_expr *thread_limit; + struct gfc_expr_list *thread_limit_list; struct gfc_expr *grainsize; struct gfc_expr *filter; struct gfc_expr *hint; @@ -1747,6 +1746,8 @@ typedef struct gfc_omp_clauses unsigned contains_teams_construct:1, target_first_st_is_teams_or_meta:1; unsigned contained_in_target_construct:1, indirect:1; unsigned full:1, erroneous:1; + unsigned thread_limit_strict:1, num_threads_strict:1; + unsigned num_teams_dims:1, thread_limit_dims:1, num_threads_dims:1; ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3; ENUM_BITFIELD (gfc_omp_device_type) device_type:2; ENUM_BITFIELD (gfc_omp_memorder) memorder:3; diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 64355971d9e1..d151aff8a452 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -188,15 +188,11 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr (c->if_exprs[i]); gfc_free_expr (c->self_expr); gfc_free_expr (c->final_expr); - gfc_free_expr (c->num_threads); gfc_free_expr (c->chunk_size); gfc_free_expr (c->safelen_expr); gfc_free_expr (c->simdlen_expr); - gfc_free_expr (c->num_teams_lower); - gfc_free_expr (c->num_teams_upper); gfc_free_expr (c->device); gfc_free_expr (c->dyn_groupprivate); - gfc_free_expr (c->thread_limit); gfc_free_expr (c->dist_chunk_size); gfc_free_expr (c->grainsize); gfc_free_expr (c->hint); @@ -216,6 +212,9 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) for (enum gfc_omp_list_type t = OMP_LIST_FIRST; t < OMP_LIST_NUM; t = gfc_omp_list_type (t + 1)) gfc_free_omp_namelist (c->lists[t], t); + gfc_free_expr_list (c->num_teams_list); + gfc_free_expr_list (c->thread_limit_list); + gfc_free_expr_list (c->num_threads_list); gfc_free_expr_list (c->wait_list); gfc_free_expr_list (c->tile_list); gfc_free_expr_list (c->sizes_list); @@ -846,8 +845,7 @@ match_omp_oacc_expr_list (const char *str, gfc_expr_list **list, old_loc = gfc_current_locus; - m = gfc_match (str); - if (m != MATCH_YES) + if (str && (m = gfc_match (str)) != MATCH_YES) return m; for (;;) @@ -4105,30 +4103,161 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_NUM_TEAMS) - && (m = gfc_match_dupl_check (!c->num_teams_upper, "num_teams", - true)) != MATCH_NO) + && (m = gfc_match_dupl_check (!c->num_teams_list, + "num_teams", true)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; - if (gfc_match ("%e ", &c->num_teams_upper) != MATCH_YES) - goto error; - if (gfc_peek_ascii_char () == ':') + gfc_expr *expr; + if (gfc_match ("dims ( %e ) : ", &expr) == MATCH_YES + && match_omp_oacc_expr_list (NULL, &c->num_teams_list, + false, true) == MATCH_YES) + { + int num = 0; + gfc_expr_list *el; + for (el = c->num_teams_list; el; el = el->next) + ++num; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER + || expr->rank != 0 + || expr->expr_type != EXPR_CONSTANT + || mpz_sgn (expr->value.integer) <= 0) + { + gfc_error ("DIMS must be a constant positive integer " + "at %L", &expr->where); + goto error; + } + if (mpz_cmp_si (expr->value.integer, num) != 0) + { + gfc_error ("The number of arguments (%d) must be the same" + " as specified for DIMS at %L", num, + &expr->where); + goto error; + } + c->num_teams_dims = true; + } + else if (gfc_match ("%e ", &expr) == MATCH_YES) { - c->num_teams_lower = c->num_teams_upper; - c->num_teams_upper = NULL; - if (gfc_match (": %e ", &c->num_teams_upper) != MATCH_YES) + c->num_teams_list = gfc_get_expr_list(); + c->num_teams_list->expr = expr; + if (gfc_peek_ascii_char () == ':') + { + expr = NULL; + if (gfc_match (": %e ", &expr) != MATCH_YES) + goto error; + c->num_teams_list->next = gfc_get_expr_list(); + c->num_teams_list->next->expr = expr; + } + if (gfc_match (") ") != MATCH_YES) goto error; } - if (gfc_match (") ") != MATCH_YES) - goto error; + else + { + gfc_error ("Expected either %<[lower-expr : ] upper-expr%> or " + "%<dims(N): expr-list%> at %C"); + goto error; + } continue; } if ((mask & OMP_CLAUSE_NUM_THREADS) - && (m = gfc_match_dupl_check (!c->num_threads, "num_threads", true, - &c->num_threads)) != MATCH_NO) + && (m = gfc_match_dupl_check (!c->num_threads_list, + "num_threads", true, NULL)) + != MATCH_NO) { + int nstrict = 0, nrelaxed = 0, ndims = 0; + bool fail = false; + gfc_expr *dims = NULL; + locus old_loc = gfc_current_locus; + if (m == MATCH_ERROR) goto error; + while (true) + { + if (gfc_match ("strict ") == MATCH_YES) + nstrict++; + else if (gfc_match ("relaxed ") == MATCH_YES) + nrelaxed++; + else if (gfc_match ("dims ") == MATCH_YES) + { + ndims++; + if (dims) + gfc_free_expr (dims); + if (gfc_match ("( %e ) ", &dims) != MATCH_YES) + break; + } + else + { + fail = true; + break; + } + if (gfc_match (", ") == MATCH_YES) + continue; + break; + } + if (gfc_match (" : ") == MATCH_YES) + { + if (nstrict + nrelaxed + ndims == 0 || fail) + { + gfc_error ("Expected STRICT, RELAXED or DIMS modifier at " + "%C"); + goto error; + } + else if (nstrict + nrelaxed > 1) + { + gfc_error ("Only one STRICT or RELAXED modifier permitted" + " at %L", &old_loc); + goto error; + } + if (ndims > 1) + { + gfc_error ("Duplicated DIMS expression at %L", + &dims->where); + goto error; + } + if (nstrict || (dims && !nrelaxed)) + c->num_threads_strict = true; + } + else + { + gfc_free_expr (dims); + dims = NULL; + gfc_current_locus = old_loc; + } + + m = match_omp_oacc_expr_list (NULL, &c->num_threads_list, false, + true); + if (m != MATCH_YES) + { + gfc_error ("Expected a list of integer expressions followed " + "by a %<)%> and optionally preceded by the STRICT," + " RELAXED, or DIMS as modifiers and a colon at %C"); + goto error; + } + if (dims) + { + int num = 0; + gfc_expr_list *el; + for (el = c->num_threads_list; el; el = el->next) + ++num; + if (!gfc_resolve_expr (dims) + || dims->ts.type != BT_INTEGER + || dims->rank != 0 + || dims->expr_type != EXPR_CONSTANT + || mpz_sgn (dims->value.integer) <= 0) + { + gfc_error ("DIMS must be a constant positive integer " + "at %L", &dims->where); + goto error; + } + if (mpz_cmp_si (dims->value.integer, num) != 0) + { + gfc_error ("The number of arguments (%d) must be the same" + " as specified for DIMS at %L", num, + &dims->where); + goto error; + } + c->num_threads_dims = true; + } continue; } if ((mask & OMP_CLAUSE_NUM_WORKERS) @@ -4520,12 +4649,110 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, allow_derived) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_THREAD_LIMIT) - && (m = gfc_match_dupl_check (!c->thread_limit, "thread_limit", - true, &c->thread_limit)) - != MATCH_NO) + && (m = gfc_match_dupl_check (!c->thread_limit_list, "thread_limit", + true, NULL)) != MATCH_NO) { + int nstrict = 0, nrelaxed = 0, ndims = 0; + bool fail = false; + gfc_expr *dims = NULL; + locus old_loc = gfc_current_locus; + if (m == MATCH_ERROR) goto error; + while (true) + { + if (gfc_match ("strict ") == MATCH_YES) + nstrict++; + else if (gfc_match ("relaxed ") == MATCH_YES) + nrelaxed++; + else if (gfc_match ("dims ") == MATCH_YES) + { + ndims++; + if (dims) + gfc_free_expr (dims); + if (gfc_match ("( %e ) ", &dims) != MATCH_YES) + break; + } + else + { + fail = true; + break; + } + if (gfc_match (", ") == MATCH_YES) + continue; + break; + } + if (gfc_match (" : ") == MATCH_YES) + { + if (nstrict + nrelaxed + ndims == 0 || fail) + { + gfc_error ("Expected STRICT, RELAXED or DIMS modifier at " + "%C"); + goto error; + } + else if (nstrict + nrelaxed > 1) + { + gfc_error ("Only one STRICT or RELAXED modifier permitted" + " at %L", &old_loc); + goto error; + } + if (ndims > 1) + { + gfc_error ("Duplicated DIMS expression at %L", + &dims->where); + goto error; + } + } + else + { + gfc_free_expr (dims); + dims = NULL; + gfc_current_locus = old_loc; + } + + m = match_omp_oacc_expr_list (NULL, &c->thread_limit_list, + false, true); + if (m != MATCH_YES) + { + gfc_error ("Expected a list of integer expressions followed " + "by a %<)%> and optionally preceded by the STRICT," + " RELAXED, or DIMS as modifiers and a colon at %C"); + goto error; + } + c->thread_limit_strict = (nstrict != 0) || (dims && !nrelaxed); + + if (!dims && c->thread_limit_list->next) + { + gfc_error ("Without the DIM modifier, only a single integer " + "expression may be specified at %L", + &c->thread_limit_list->next->expr->where); + goto error; + } + else if (dims) + { + int num = 0; + gfc_expr_list *el; + for (el = c->thread_limit_list; el; el = el->next) + ++num; + if (!gfc_resolve_expr (dims) + || dims->ts.type != BT_INTEGER + || dims->rank != 0 + || dims->expr_type != EXPR_CONSTANT + || mpz_sgn (dims->value.integer) <= 0) + { + gfc_error ("DIMS must be a constant positive integer " + "at %L", &dims->where); + goto error; + } + if (mpz_cmp_si (dims->value.integer, num) != 0) + { + gfc_error ("The number of arguments (%d) must be the same" + " as specified for DIMS at %L", num, + &dims->where); + goto error; + } + c->thread_limit_dims = true; + } continue; } if ((mask & OMP_CLAUSE_THREADS) @@ -10296,8 +10523,10 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, &expr->where); if_without_mod = true; } - if (omp_clauses->num_threads) - resolve_positive_int_expr (omp_clauses->num_threads, "NUM_THREADS"); + + for (el = omp_clauses->num_threads_list; el; el = el->next) + resolve_positive_int_expr (el->expr, "NUM_THREADS"); + if (omp_clauses->dyn_groupprivate) resolve_nonnegative_int_expr (omp_clauses->dyn_groupprivate, "DYN_GROUPPRIVATE"); @@ -11100,18 +11329,18 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, resolve_positive_int_expr (omp_clauses->safelen_expr, "SAFELEN"); if (omp_clauses->simdlen_expr) resolve_positive_int_expr (omp_clauses->simdlen_expr, "SIMDLEN"); - if (omp_clauses->num_teams_lower) - resolve_positive_int_expr (omp_clauses->num_teams_lower, "NUM_TEAMS"); - if (omp_clauses->num_teams_upper) - resolve_positive_int_expr (omp_clauses->num_teams_upper, "NUM_TEAMS"); - if (omp_clauses->num_teams_lower - && omp_clauses->num_teams_lower->expr_type == EXPR_CONSTANT - && omp_clauses->num_teams_upper->expr_type == EXPR_CONSTANT - && mpz_cmp (omp_clauses->num_teams_lower->value.integer, - omp_clauses->num_teams_upper->value.integer) > 0) + for (el = omp_clauses->num_teams_list; el; el = el->next) + resolve_positive_int_expr (el->expr, "NUM_TEAMS"); + if (omp_clauses->num_teams_list + && omp_clauses->num_teams_list->next + && !omp_clauses->num_teams_dims + && omp_clauses->num_teams_list->expr->expr_type == EXPR_CONSTANT + && omp_clauses->num_teams_list->next->expr->expr_type == EXPR_CONSTANT + && mpz_cmp (omp_clauses->num_teams_list->expr->value.integer, + omp_clauses->num_teams_list->next->expr->value.integer) > 0) gfc_warning (OPT_Wopenmp, "NUM_TEAMS lower bound at %L larger than upper " - "bound at %L", &omp_clauses->num_teams_lower->where, - &omp_clauses->num_teams_upper->where); + "bound at %L", &omp_clauses->num_teams_list->expr->where, + &omp_clauses->num_teams_list->next->expr->where); if (omp_clauses->device) resolve_scalar_int_expr (omp_clauses->device, "DEVICE"); if (omp_clauses->filter) @@ -11135,8 +11364,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_error ("DIST_SCHEDULE clause's chunk_size at %L requires " "a scalar INTEGER expression", &expr->where); } - if (omp_clauses->thread_limit) - resolve_positive_int_expr (omp_clauses->thread_limit, "THREAD_LIMIT"); + for (el = omp_clauses->thread_limit_list; el; el = el->next) + resolve_positive_int_expr (el->expr, "THREAD_LIMIT"); if (omp_clauses->grainsize) resolve_positive_int_expr (omp_clauses->grainsize, "GRAINSIZE"); if (omp_clauses->num_tasks) diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index aa4e8ebfa239..381fb48d008c 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -5660,12 +5660,25 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, omp_clauses = gfc_trans_add_clause (c, omp_clauses); } - if (clauses->num_threads) + if (clauses->num_threads_list) { tree num_threads; + if (clauses->num_threads_dims) + sorry_at (gfc_get_location (&clauses->num_threads_list->expr->where), + "%<num_threads%> with %<dims%> modifier"); + else if (clauses->num_threads_strict) + sorry_at (gfc_get_location (&clauses->num_threads_list->expr->where), + "%<num_threads%> with %<strict%> modifier"); + else if (clauses->num_threads_list->next) + { + gfc_expr *expr = clauses->num_threads_list->next->expr; + sorry_at (gfc_get_location (&expr->where), + "%<num_threads%> with more than one argument"); + } + gfc_init_se (&se, NULL); - gfc_conv_expr (&se, clauses->num_threads); + gfc_conv_expr (&se, clauses->num_threads_list->expr); gfc_add_block_to_block (block, &se.pre); num_threads = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); @@ -5970,24 +5983,31 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } } - if (clauses->num_teams_upper) + if (clauses->num_teams_list) { tree num_teams_lower = NULL_TREE, num_teams_upper; - gfc_init_se (&se, NULL); - gfc_conv_expr (&se, clauses->num_teams_upper); - gfc_add_block_to_block (block, &se.pre); - num_teams_upper = gfc_evaluate_now (se.expr, block); - gfc_add_block_to_block (block, &se.post); + if (clauses->num_teams_dims) + sorry_at (gfc_get_location (&clauses->num_teams_list->expr->where), + "%<num_teams%> with %<dims%> modifier"); - if (clauses->num_teams_lower) + gfc_expr_list *el = clauses->num_teams_list; + if (el->next) { gfc_init_se (&se, NULL); - gfc_conv_expr (&se, clauses->num_teams_lower); + gfc_conv_expr (&se, el->expr); gfc_add_block_to_block (block, &se.pre); num_teams_lower = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); + el = el->next; } + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, el->expr); + gfc_add_block_to_block (block, &se.pre); + num_teams_upper = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TEAMS); OMP_CLAUSE_NUM_TEAMS_LOWER_EXPR (c) = num_teams_lower; OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (c) = num_teams_upper; @@ -6013,12 +6033,18 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, omp_clauses = gfc_trans_add_clause (c, omp_clauses); } - if (clauses->thread_limit) + if (clauses->thread_limit_list) { tree thread_limit; + if (clauses->thread_limit_dims) + sorry_at (gfc_get_location (&clauses->thread_limit_list->expr->where), + "%<thread_limit%> with %<dims%> modifier"); + else if (clauses->thread_limit_strict) + sorry_at (gfc_get_location (&clauses->thread_limit_list->expr->where), + "%<thread_limit%> with %<strict%> modifier"); gfc_init_se (&se, NULL); - gfc_conv_expr (&se, clauses->thread_limit); + gfc_conv_expr (&se, clauses->thread_limit_list->expr); gfc_add_block_to_block (block, &se.pre); thread_limit = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); @@ -8471,8 +8497,12 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->lists[OMP_LIST_HAS_DEVICE_ADDR]; clausesa[GFC_OMP_SPLIT_TARGET].device = code->ext.omp_clauses->device; - clausesa[GFC_OMP_SPLIT_TARGET].thread_limit - = code->ext.omp_clauses->thread_limit; + clausesa[GFC_OMP_SPLIT_TARGET].thread_limit_list + = code->ext.omp_clauses->thread_limit_list; + clausesa[GFC_OMP_SPLIT_TARGET].thread_limit_strict + = code->ext.omp_clauses->thread_limit_strict; + clausesa[GFC_OMP_SPLIT_TARGET].thread_limit_dims + = code->ext.omp_clauses->thread_limit_dims; clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_USES_ALLOCATORS] = code->ext.omp_clauses->lists[OMP_LIST_USES_ALLOCATORS]; for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++) @@ -8491,12 +8521,16 @@ gfc_split_omp_clauses (gfc_code *code, if (mask & GFC_OMP_MASK_TEAMS) { /* First the clauses that are unique to some constructs. */ - clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower - = code->ext.omp_clauses->num_teams_lower; - clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper - = code->ext.omp_clauses->num_teams_upper; - clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit - = code->ext.omp_clauses->thread_limit; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_list + = code->ext.omp_clauses->num_teams_list; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_dims + = code->ext.omp_clauses->num_teams_dims; + clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit_list + = code->ext.omp_clauses->thread_limit_list; + clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit_strict + = code->ext.omp_clauses->thread_limit_strict; + clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit_dims + = code->ext.omp_clauses->thread_limit_dims; /* Shared and default clauses are allowed on parallel, teams and taskloop. */ clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_SHARED] @@ -8526,8 +8560,12 @@ gfc_split_omp_clauses (gfc_code *code, /* First the clauses that are unique to some constructs. */ clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_COPYIN] = code->ext.omp_clauses->lists[OMP_LIST_COPYIN]; - clausesa[GFC_OMP_SPLIT_PARALLEL].num_threads - = code->ext.omp_clauses->num_threads; + clausesa[GFC_OMP_SPLIT_PARALLEL].num_threads_list + = code->ext.omp_clauses->num_threads_list; + clausesa[GFC_OMP_SPLIT_PARALLEL].num_threads_strict + = code->ext.omp_clauses->num_threads_strict; + clausesa[GFC_OMP_SPLIT_PARALLEL].num_threads_dims + = code->ext.omp_clauses->num_threads_dims; clausesa[GFC_OMP_SPLIT_PARALLEL].proc_bind = code->ext.omp_clauses->proc_bind; /* Shared and default clauses are allowed on parallel, teams @@ -9344,8 +9382,8 @@ gfc_trans_omp_target (gfc_code *code) break; default: if (flag_openmp - && (clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper - || clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit)) + && (clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_list + || clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit_list)) { gfc_omp_clauses clausesb; tree teams_clauses; @@ -9353,14 +9391,18 @@ gfc_trans_omp_target (gfc_code *code) thread_limit clauses are evaluated before entering the target construct. */ memset (&clausesb, '\0', sizeof (clausesb)); - clausesb.num_teams_lower - = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower; - clausesb.num_teams_upper - = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper; - clausesb.thread_limit = clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit; - clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower = NULL; - clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper = NULL; - clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit = NULL; + clausesb.num_teams_list + = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_list; + clausesb.num_teams_dims + = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_dims; + clausesb.thread_limit_list + = clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit_list; + clausesb.thread_limit_strict + = clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit_strict; + clausesb.thread_limit_dims + = clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit_dims; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_list = NULL; + clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit_list = NULL; teams_clauses = gfc_trans_omp_clauses (&block, &clausesb, code->loc); pushlevel (); diff --git a/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-1.f90 b/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-1.f90 new file mode 100644 index 000000000000..94349180f5e1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-1.f90 @@ -0,0 +1,116 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +subroutine one_a +!$omp teams num_teams(dims(3) : 1,2,3) & ! { dg-message "sorry, unimplemented: 'num_teams' with 'dims' modifier" } +!$omp& thread_limit ( dims ( 4 ) : 1, 2, 3, 4) ! { dg-message "sorry, unimplemented: 'thread_limit' with 'dims' modifier" } +!$omp parallel num_threads(dims(3): 1,2,3) ! { dg-message "sorry, unimplemented: 'num_threads' with 'dims' modifier" } +!$omp end parallel +!$omp end teams +end + +subroutine one_b +!$omp teams num_teams(dims(3) : 1,2,3) & ! { dg-message "sorry, unimplemented: 'num_teams' with 'dims' modifier" } +!$omp& thread_limit ( dims ( 4 ) , relaxed : 1, 2, 3, 4) ! { dg-message "sorry, unimplemented: 'thread_limit' with 'dims' modifier" } +!$omp parallel num_threads(dims(3) , relaxed : 1,2,3) ! { dg-message "sorry, unimplemented: 'num_threads' with 'dims' modifier" } +!$omp end parallel +!$omp end teams +end + +subroutine one_c +!$omp teams num_teams(dims(3) : 1,2,3) & ! { dg-message "sorry, unimplemented: 'num_teams' with 'dims' modifier" } +!$omp& thread_limit ( dims ( 4 ) , strict : 1, 2, 3, 4) ! { dg-message "sorry, unimplemented: 'thread_limit' with 'dims' modifier" } +!$omp parallel num_threads(dims(3) , strict : 1,2,3) ! { dg-message "sorry, unimplemented: 'num_threads' with 'dims' modifier" } +!$omp end parallel +!$omp end teams +end + +subroutine one_d +!$omp teams num_teams ( dims(3) : 1,2,3) & ! { dg-message "sorry, unimplemented: 'num_teams' with 'dims' modifier" } +!$omp& thread_limit ( relaxed , dims ( 4 ) : 1, 2, 3, 4) ! { dg-message "sorry, unimplemented: 'thread_limit' with 'dims' modifier" } +!$omp parallel num_threads( relaxed , dims(3) : 1,2,3) ! { dg-message "sorry, unimplemented: 'num_threads' with 'dims' modifier" } +!$omp end parallel +!$omp end teams +end + +subroutine one_e +!$omp teams num_teams ( dims(3) : 1,2,3) & ! { dg-message "sorry, unimplemented: 'num_teams' with 'dims' modifier" } +!$omp& thread_limit ( strict , dims ( 4 ) : 1, 2, 3, 4) ! { dg-message "sorry, unimplemented: 'thread_limit' with 'dims' modifier" } +!$omp parallel num_threads( strict , dims(3) : 1,2,3) ! { dg-message "sorry, unimplemented: 'num_threads' with 'dims' modifier" } +!$omp end parallel +!$omp end teams +end + + +subroutine two +!$omp teams thread_limit (strict : 4) ! { dg-message "sorry, unimplemented: 'thread_limit' with 'strict' modifier" } +!$omp parallel num_threads(strict : 2) ! { dg-message "sorry, unimplemented: 'num_threads' with 'strict' modifier" } +!$omp end parallel +!$omp end teams +end + +subroutine zero +!$omp teams num_teams(1234) thread_limit ( 2345) ! OK +!$omp parallel num_threads( 3456) ! OK +!$omp end parallel +!$omp end teams + +!$omp teams num_teams(123:456) +!$omp end teams +end + +subroutine three +!$omp teams num_teams(4567) thread_limit (relaxed : 5678) ! OK +!$omp parallel num_threads(relaxed : 6789) ! OK +!$omp end parallel +!$omp end teams +end + +subroutine four +!$omp parallel num_threads(1 , 2 , 3 ) ! { dg-message "sorry, unimplemented: 'num_threads' with more than one argument" } +!$omp end parallel +end + +subroutine five +!$omp parallel num_threads(relaxed : 1,2,3) ! { dg-message "sorry, unimplemented: 'num_threads' with more than one argument" } +!$omp end parallel +end + +subroutine six +!$omp parallel num_threads(strict : 1,2,3) ! { dg-message "sorry, unimplemented: 'num_threads' with 'strict' modifier" } +!$omp end parallel +end + + +subroutine seven + integer :: static, relaxed, dims(2) + !$omp teams num_teams(static) thread_limit (static) ! OK + !$omp parallel num_threads(static) ! OK + !$omp end parallel + !$omp end teams + + !$omp teams num_teams(relaxed) thread_limit (relaxed) ! OK + !$omp parallel num_threads(relaxed) ! OK + !$omp end parallel + !$omp end teams + + !$omp teams num_teams(dims(2)) thread_limit (dims(2)) ! OK + !$omp parallel num_threads(dims(2)) ! OK + !$omp end parallel + !$omp end teams + +end subroutine + +! Check that the tree is correctly generated: + +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(1234\\) thread_limit\\(2345\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(3456\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(4567\\) thread_limit\\(5678\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(6789\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(123:456\\)" 1 "original" } } + +! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = static;" 3 "original" } } +! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = relaxed;" 3 "original" } } +! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = dims\\\[1\\\];" 3 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(D\\.\[0-9\]+\\) thread_limit\\(D\\.\[0-9\]+\\)" 3 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(D\\.\[0-9\]+\\)" 3 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-2.f90 b/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-2.f90 new file mode 100644 index 000000000000..db570df86f98 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-2.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +! This testcase is ambigous in Fortran +! cf. OpenMP Spec Issues 4998 +! Unresolved when this testcase was written + +! FIXME: Check what's the outcome of the discussion + +! NOTE: GCC currently implements this as spatial dimension +! and not as lower bound ... + +subroutine sub + integer, parameter :: dims(2) = [11,22] +!... + !$omp teams num_teams( dims(1) : 256 ) ! { dg-message "sorry, unimplemented: 'num_teams' with 'dims' modifier" } + !$omp end teams +end + +! ... hence: 'num_teams(256)' and not 'num_teams(11:256)' + +! { dg-final { scan-tree-dump "#pragma omp teams num_teams\\(256\\)" "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-3.f90 b/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-3.f90 new file mode 100644 index 000000000000..22b9f23f6402 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-3.f90 @@ -0,0 +1,252 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +subroutine one + !$omp teams num_teams(1) num_teams(2) ! { dg-error "Duplicated 'num_teams' clause" } + block; end block + + !$omp teams thread_limit(1) thread_limit(2) ! { dg-error "Duplicated 'thread_limit' clause" } + block; end block + + !$omp parallel num_threads(1) num_threads(2) ! { dg-error "Duplicated 'num_threads' clause" } + block; end block + + + !$omp teams num_teams(dims([1,1]) : 1) ! { dg-error "DIMS must be a constant positive integer" } + block; end block + + !$omp teams num_teams(dims(1.0) : 1) ! { dg-error "DIMS must be a constant positive integer" } + block; end block + + !$omp teams num_teams(dims(i) : 1) ! { dg-error "DIMS must be a constant positive integer" } + block; end block + + !$omp teams num_teams(dims(i) : 1) ! { dg-error "DIMS must be a constant positive integer" } + block; end block + + !$omp teams num_teams(dims( 1 - 2) : 1) ! { dg-error "DIMS must be a constant positive integer" } + block; end block + + !$omp teams num_teams(dims( int ( cos(0.0) )) : 1) ! OK + block; end block + + + !$omp teams thread_limit(dims([1,1]) : 1) ! { dg-error "DIMS must be a constant positive integer" } + block; end block + + !$omp teams thread_limit(dims(1.0) : 1) ! { dg-error "DIMS must be a constant positive integer" } + block; end block + + !$omp teams thread_limit(dims(i) : 1) ! { dg-error "DIMS must be a constant positive integer" } + block; end block + + !$omp teams thread_limit(dims(i) : 1) ! { dg-error "DIMS must be a constant positive integer" } + block; end block + + !$omp teams thread_limit(dims( 1 - 2) : 1) ! { dg-error "DIMS must be a constant positive integer" } + block; end block + + !$omp teams thread_limit(dims( int ( cos(0.0) )) : 1) ! OK + block; end block + + + !$omp parallel num_threads(dims([1,1]) : 1) ! { dg-error "DIMS must be a constant positive integer" } + block; end block + + !$omp parallel num_threads(dims(1.0) : 1) ! { dg-error "DIMS must be a constant positive integer" } + block; end block + + !$omp parallel num_threads(dims(i) : 1) ! { dg-error "DIMS must be a constant positive integer" } + block; end block + + !$omp parallel num_threads(dims(i) : 1) ! { dg-error "DIMS must be a constant positive integer" } + block; end block + + !$omp parallel num_threads(dims( 1 - 2) : 1) ! { dg-error "DIMS must be a constant positive integer" } + block; end block + + !$omp parallel num_threads(dims( int ( cos(0.0) )) : 1) ! OK + block; end block +end + +subroutine two + !$omp parallel num_threads(dims( int ( cos(0.0) ) + 1 ) : 1) ! { dg-error "The number of arguments \\(1\\) must be the same as specified for DIMS" } + block; end block + + !$omp teams num_teams(dims( 3 ) : 1, 2, 3 , 4) ! { dg-error "The number of arguments \\(4\\) must be the same as specified for DIMS" } + block; end block + + !$omp teams thread_limit(dims( 3 ) : 1, 4) ! { dg-error "The number of arguments \\(2\\) must be the same as specified for DIMS" } + block; end block +end + +subroutine three + !$omp teams num_teams ! { dg-error "Expected '\\(' after 'num_teams'" } + block; end block + + !$omp teams num_teams( : ! { dg-error "Expected either '\\\[lower-expr : \\\] upper-expr' or 'dims\\(N\\): expr-list'" } + block; end block + + !$omp teams num_teams( ! { dg-error "Expected either '\\\[lower-expr : \\\] upper-expr' or 'dims\\(N\\): expr-list'" } + block; end block + + !$omp teams num_teams( dims ! { dg-error "Failed to match clause" } + block; end block + + !$omp teams num_teams( dims(1) ! { dg-error "Invalid character in name" } + block; end block + + !$omp teams num_teams( dims(1) : ! { dg-error "Expected either '\\\[lower-expr : \\\] upper-expr' or 'dims\\(N\\): expr-list'" } + block; end block + + !$omp teams num_teams( dims(1) : 1 ! { dg-error "Syntax error in OpenMP expression" } + block; end block + + !$omp teams num_teams( 5 : ! { dg-error "Invalid character in name" } + block; end block + + !$omp teams num_teams( 5 : 5 ! { dg-error "Failed to match clause" } + block; end block +end + +subroutine four + !$omp teams thread_limit ! { dg-error "Expected '\\(' after 'thread_limit'" } + block; end block + + !$omp teams thread_limit( : ! { dg-error "Expected STRICT, RELAXED or DIMS modifier" } + block; end block + + !$omp teams thread_limit( ! { dg-error "Expected a list of integer expressions followed by a '\\)' and optionally preceded by the STRICT, RELAXED, or DIMS as modifiers and a colon at .1." } + block; end block + + !$omp teams thread_limit( dims ! { dg-error "Expected a list of integer expressions followed by a '\\)' and optionally preceded by the STRICT, RELAXED, or DIMS as modifiers and a colon at .1." } + block; end block + + !$omp teams thread_limit( dims(1) ! { dg-error "Expected a list of integer expressions followed by a '\\)' and optionally preceded by the STRICT, RELAXED, or DIMS as modifiers and a colon at .1." } + block; end block + + !$omp teams thread_limit( dims(1) : ! { dg-error "Expected a list of integer expressions followed by a '\\)' and optionally preceded by the STRICT, RELAXED, or DIMS as modifiers and a colon at .1." } + block; end block + + !$omp teams thread_limit( dims(1) : 1 ! { dg-error "Expected a list of integer expressions followed by a '\\)' and optionally preceded by the STRICT, RELAXED, or DIMS as modifiers and a colon at .1." } + block; end block + + !$omp teams thread_limit( 5 : ! { dg-error "Expected a list of integer expressions followed by a '\\)' and optionally preceded by the STRICT, RELAXED, or DIMS as modifiers and a colon at .1." } + block; end block + + !$omp teams thread_limit( 5 : 5 ! { dg-error "Expected a list of integer expressions followed by a '\\)' and optionally preceded by the STRICT, RELAXED, or DIMS as modifiers and a colon at .1." } + block; end block +end + +subroutine five + !$omp parallel num_threads ! { dg-error "Expected '\\(' after 'num_threads'" } + block; end block + + !$omp parallel num_threads( : ! { dg-error "Expected STRICT, RELAXED or DIMS modifier" } + block; end block + + !$omp parallel num_threads( ! { dg-error "Expected a list of integer expressions followed by a '\\)' and optionally preceded by the STRICT, RELAXED, or DIMS as modifiers and a colon at .1." } + block; end block + + !$omp parallel num_threads( dims ! { dg-error "Expected a list of integer expressions followed by a '\\)' and optionally preceded by the STRICT, RELAXED, or DIMS as modifiers and a colon at .1." } + block; end block + + !$omp parallel num_threads( dims(1) ! { dg-error "Expected a list of integer expressions followed by a '\\)' and optionally preceded by the STRICT, RELAXED, or DIMS as modifiers and a colon at .1." } + block; end block + + !$omp parallel num_threads( dims(1) : ! { dg-error "Expected a list of integer expressions followed by a '\\)' and optionally preceded by the STRICT, RELAXED, or DIMS as modifiers and a colon at .1." } + block; end block + + !$omp parallel num_threads( dims(1) : 1 ! { dg-error "Expected a list of integer expressions followed by a '\\)' and optionally preceded by the STRICT, RELAXED, or DIMS as modifiers and a colon at .1." } + block; end block + + !$omp parallel num_threads( 5 : ! { dg-error "Expected a list of integer expressions followed by a '\\)' and optionally preceded by the STRICT, RELAXED, or DIMS as modifiers and a colon at .1." } + block; end block + + !$omp parallel num_threads( 5 : 5 ! { dg-error "Expected a list of integer expressions followed by a '\\)' and optionally preceded by the STRICT, RELAXED, or DIMS as modifiers and a colon at .1." } + block; end block +end + +subroutine six + !$omp teams num_teams (dims(1), dims(1) : 1) ! { dg-error "Invalid character in name" } + block; end block + + + !$omp teams thread_limit (dims(1), dims(1) : 1) ! { dg-error "Duplicated DIMS expression" } + block; end block + + !$omp teams thread_limit (dims(1), relaxed, dims(1) : 1) ! { dg-error "Duplicated DIMS expression" } + block; end block + + !$omp teams thread_limit (dims(1), strict, dims(1) : 1) ! { dg-error "Duplicated DIMS expression" } + block; end block + + !$omp teams thread_limit (strict, relaxed, dims(1) : 1) ! { dg-error "Only one STRICT or RELAXED modifier permitted" } + block; end block + + !$omp teams thread_limit (relaxed, strict, dims(1) : 1) ! { dg-error "Only one STRICT or RELAXED modifier permitted" } + block; end block + + !$omp teams thread_limit (strict, relaxed : 1) ! { dg-error "Only one STRICT or RELAXED modifier permitted" } + block; end block + + !$omp teams thread_limit (relaxed, strict : 1) ! { dg-error "Only one STRICT or RELAXED modifier permitted" } + block; end block + + !$omp teams thread_limit (strict, dims(1), strict : 1) ! { dg-error "Only one STRICT or RELAXED modifier permitted" } + block; end block + + !$omp teams thread_limit (relaxed, dims(1), relaxed : 1) ! { dg-error "Only one STRICT or RELAXED modifier permitted" } + block; end block + + !$omp teams thread_limit (strict, strict : 1) ! { dg-error "Only one STRICT or RELAXED modifier permitted" } + block; end block + + !$omp teams thread_limit (relaxed, relaxed : 1) ! { dg-error "Only one STRICT or RELAXED modifier permitted" } + block; end block + + + !$omp parallel num_threads (dims(1), dims(1) : 1) ! { dg-error "Duplicated DIMS expression" } + block; end block + + !$omp parallel num_threads (dims(1), relaxed, dims(1) : 1) ! { dg-error "Duplicated DIMS expression" } + block; end block + + !$omp parallel num_threads (dims(1), strict, dims(1) : 1) ! { dg-error "Duplicated DIMS expression" } + block; end block + + !$omp parallel num_threads (strict, relaxed, dims(1) : 1) ! { dg-error "Only one STRICT or RELAXED modifier permitted" } + block; end block + + !$omp parallel num_threads (relaxed, strict, dims(1) : 1) ! { dg-error "Only one STRICT or RELAXED modifier permitted" } + block; end block + + !$omp parallel num_threads (strict, relaxed : 1) ! { dg-error "Only one STRICT or RELAXED modifier permitted" } + block; end block + + !$omp parallel num_threads (relaxed, strict : 1) ! { dg-error "Only one STRICT or RELAXED modifier permitted" } + block; end block + + !$omp parallel num_threads (strict, dims(1), strict : 1) ! { dg-error "Only one STRICT or RELAXED modifier permitted" } + block; end block + + !$omp parallel num_threads (relaxed, dims(1), relaxed : 1) ! { dg-error "Only one STRICT or RELAXED modifier permitted" } + block; end block + + !$omp parallel num_threads (strict, strict : 1) ! { dg-error "Only one STRICT or RELAXED modifier permitted" } + block; end block + + !$omp parallel num_threads (relaxed, relaxed : 1) ! { dg-error "Only one STRICT or RELAXED modifier permitted" } + block; end block +end subroutine + +subroutine seven + !$omp teams num_teams (2,2) ! { dg-error "Failed to match clause" } + block; end block + + !$omp teams thread_limit (2,2) ! { dg-error "Without the DIM modifier, only a single integer expression may be specified" } + block; end block + + !$omp parallel num_threads (2,2) ! OK + block; end block +end