The attached patch adds parsing support for the following features:
* strict/relaxed modifiers to thread_limit and num_threads clauses
(default is 'relaxed')
* supporting a list of arguments for num_threads
This is to set the number of threads also for nested parallels;
the OMP_NUM_THREADS env var already supports this.
* Spatial dimension support, e.g. 'num_teams(dim(3) : 32, 32, 32)',
with the num_teams, thread_limit, and num_threads clauses.
(this implies 'strict', unless overridden).
When using any of the new features (but the relaxed modifier),
a 'sorry, unimplemented' is printed.
Comments before I commit this?
Tobias
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 specifiying 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.
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 5f058cdc830..3f1b35b715a 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 92678310ffd..fd34f0c1912 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 df987576fff..48ddd9a72d5 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 64355971d9e..ff021a60fe0 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 preceeded 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 preceeded 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 aa4e8ebfa23..381fb48d008 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 00000000000..94349180f5e
--- /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 00000000000..db570df86f9
--- /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 00000000000..74e76795085
--- /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 preceeded 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 preceeded 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 preceeded 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 preceeded 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 preceeded 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 preceeded 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 preceeded 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 preceeded 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 preceeded 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 preceeded 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 preceeded 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 preceeded 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 preceeded 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 preceeded 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
