Hi Jakub, hi all,
On 23.08.21 10:25, Jakub Jelinek wrote:
The following patch implements it for C and C++.
The attached patch now adds Fortran support for it,
which is a small change - the two testcases (in 4 files) are
the converted C ones.
Additionally, the previous diagnostic for duplicate clauses
was suboptimal as gfortran simply stopped parsing them.
Thus, a generic "Failed to match clause" was shown instead of
a more explicit message such as "Duplicated 'filter' clause".
Additionally, it was often not quite clear whether the clause
itself or its expression was bogus (due to 'clause ( %e )'
matching).
Now I added a new function which handles those diagnostic.
I had to revert two clauses to avoid matching the shorter string
first - and it now shows 'if' - missing '(' for 'if_present' if
only 'if' but not 'if_present' is supported by the directive.
The error messages are still not optimal, but I think overall an
improvement.
OK? Comment?
Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634
München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas
Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht
München, HRB 106955
Fortran/OpenMP: strict modifier on grainsize/num_tasks + duplicate errors
This patch adds support for the 'strict' modifier on grainsize/num_tasks
clauses, an OpenMP 5.1 feature supported in C/C++ since commit
r12-3066-g3bc75533d1f87f0617be6c1af98804f9127ec637
Additionally, the duplicate-clause diagnostic has been improved.
gcc/fortran/ChangeLog:
* dump-parse-tree.c (show_omp_clauses): Handle 'strict' modifier
on grainsize/num_tasks
* gfortran.h (gfc_omp_clauses): Add grainsize_strict
and num_tasks_strict.
* trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses):
Handle 'strict' modifier on grainsize/num_tasks.
(gfc_match_dupl_check, gfc_match_dupl_memorder,
gfc_match_dupl_atomic): New.
(gfc_match_omp_clauses): Use them; handle 'strict' modified on
grainsize/num_tasks; remove duplicate 'release'/'relaxed' clause
matching; improve error dignostic for 'default'.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/taskloop-4-a.f90: New test.
* testsuite/libgomp.fortran/taskloop-4.f90: New test.
* testsuite/libgomp.fortran/taskloop-5-a.f90: New test.
* testsuite/libgomp.fortran/taskloop-5.f90: New test.
gcc/testsuite/ChangeLog:
* gfortran.dg/goacc/asyncwait-1.f95: Update dg-error.
* gfortran.dg/goacc/default-2.f: Update dg-error.
* gfortran.dg/goacc/enter-exit-data.f95: Update dg-error.
* gfortran.dg/goacc/if.f95: Update dg-error.
* gfortran.dg/goacc/parallel-kernels-clauses.f95: Update dg-error.
* gfortran.dg/goacc/routine-6.f90: Update dg-error.
* gfortran.dg/goacc/sie.f95: Update dg-error.
* gfortran.dg/goacc/update-if_present-2.f90: Update dg-error.
* gfortran.dg/gomp/cancel-2.f90: Update dg-error.
* gfortran.dg/gomp/declare-simd-1.f90: Update dg-error.
* gfortran.dg/gomp/error-3.f90: Update dg-error.
* gfortran.dg/gomp/loop-2.f90: Update dg-error.
* gfortran.dg/gomp/masked-2.f90: Update dg-error.
gcc/fortran/dump-parse-tree.c | 4 +
gcc/fortran/gfortran.h | 2 +-
gcc/fortran/openmp.c | 643 +++++++++++++--------
gcc/fortran/trans-openmp.c | 8 +
gcc/testsuite/gfortran.dg/goacc/asyncwait-1.f95 | 2 +-
gcc/testsuite/gfortran.dg/goacc/default-2.f | 32 +-
.../gfortran.dg/goacc/enter-exit-data.f95 | 4 +-
gcc/testsuite/gfortran.dg/goacc/if.f95 | 12 +-
.../gfortran.dg/goacc/parallel-kernels-clauses.f95 | 16 +-
gcc/testsuite/gfortran.dg/goacc/routine-6.f90 | 2 +-
gcc/testsuite/gfortran.dg/goacc/sie.f95 | 20 +-
.../gfortran.dg/goacc/update-if_present-2.f90 | 10 +-
gcc/testsuite/gfortran.dg/gomp/cancel-2.f90 | 4 +-
gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90 | 2 +-
gcc/testsuite/gfortran.dg/gomp/error-3.f90 | 18 +-
gcc/testsuite/gfortran.dg/gomp/loop-2.f90 | 2 +-
gcc/testsuite/gfortran.dg/gomp/masked-2.f90 | 2 +-
libgomp/testsuite/libgomp.fortran/taskloop-4-a.f90 | 86 +++
libgomp/testsuite/libgomp.fortran/taskloop-4.f90 | 41 ++
libgomp/testsuite/libgomp.fortran/taskloop-5-a.f90 | 95 +++
libgomp/testsuite/libgomp.fortran/taskloop-5.f90 | 75 +++
21 files changed, 790 insertions(+), 290 deletions(-)
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index c75a0a9d095..a1df47c2f82 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1805,6 +1805,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
if (omp_clauses->grainsize)
{
fputs (" GRAINSIZE(", dumpfile);
+ if (omp_clauses->grainsize_strict)
+ fputs ("strict: ", dumpfile);
show_expr (omp_clauses->grainsize);
fputc (')', dumpfile);
}
@@ -1823,6 +1825,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
if (omp_clauses->num_tasks)
{
fputs (" NUM_TASKS(", dumpfile);
+ if (omp_clauses->num_tasks_strict)
+ fputs ("strict: ", dumpfile);
show_expr (omp_clauses->num_tasks);
fputc (')', dumpfile);
}
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 4b26cb430d4..2e38ad3d580 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1490,7 +1490,7 @@ typedef struct gfc_omp_clauses
unsigned inbranch:1, notinbranch:1, nogroup:1;
unsigned sched_simd:1, sched_monotonic:1, sched_nonmonotonic:1;
unsigned simd:1, threads:1, depend_source:1, destroy:1, order_concurrent:1;
- unsigned capture:1;
+ unsigned capture:1, grainsize_strict, num_tasks_strict;
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.c b/gcc/fortran/openmp.c
index 2380866cc3b..715fd321512 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1289,6 +1289,64 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
return MATCH_YES;
}
+
+/* Match with duplicate check. Matches 'name'. If expr != NULL, it
+ then matches '(expr)', otherwise, if open_parens is true,
+ it matches a ' ( ' after 'name'.
+ dupl_message requires '%qs %L' - and is used by
+ gfc_match_dupl_memorder and gfc_match_dupl_atomic. */
+
+static match
+gfc_match_dupl_check (bool not_dupl, const char *name, bool open_parens = false,
+ gfc_expr **expr = NULL, const char *dupl_msg = NULL)
+{
+ match m;
+ locus old_loc = gfc_current_locus;
+ if ((m = gfc_match (name)) != MATCH_YES)
+ return m;
+ if (!not_dupl)
+ {
+ if (dupl_msg)
+ gfc_error (dupl_msg, name, &old_loc);
+ else
+ gfc_error ("Duplicated %qs clause at %L", name, &old_loc);
+ return MATCH_ERROR;
+ }
+ if (open_parens || expr)
+ {
+ if (gfc_match (" ( ") != MATCH_YES)
+ {
+ gfc_error ("Expected %<(%> after %qs at %C", name);
+ return MATCH_ERROR;
+ }
+ if (expr)
+ {
+ if (gfc_match ("%e )", expr) != MATCH_YES)
+ {
+ gfc_error ("Invalid expression after %<%s(%> at %C", name);
+ return MATCH_ERROR;
+ }
+ }
+ }
+ return MATCH_YES;
+}
+
+static match
+gfc_match_dupl_memorder (bool not_dupl, const char *name)
+{
+ return gfc_match_dupl_check (not_dupl, name, false, NULL,
+ "Duplicated memory-order clause: unexpected %s "
+ "clause at %L");
+}
+
+static match
+gfc_match_dupl_atomic (bool not_dupl, const char *name)
+{
+ return gfc_match_dupl_check (not_dupl, name, false, NULL,
+ "Duplicated atomic clause: unexpected %s "
+ "clause at %L");
+}
+
/* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of
clauses that are allowed for a particular directive. */
@@ -1323,6 +1381,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
gfc_omp_namelist **head;
old_loc = gfc_current_locus;
char pc = gfc_peek_ascii_char ();
+ match m;
switch (pc)
{
case 'a':
@@ -1352,17 +1411,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
}
if ((mask & OMP_CLAUSE_MEMORDER)
- && c->memorder == OMP_MEMORDER_UNSET
- && gfc_match ("acq_rel") == MATCH_YES)
+ && (m = gfc_match_dupl_memorder ((c->memorder
+ == OMP_MEMORDER_UNSET),
+ "acq_rel")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->memorder = OMP_MEMORDER_ACQ_REL;
needs_space = true;
continue;
}
if ((mask & OMP_CLAUSE_MEMORDER)
- && c->memorder == OMP_MEMORDER_UNSET
- && gfc_match ("acquire") == MATCH_YES)
+ && (m = gfc_match_dupl_memorder ((c->memorder
+ == OMP_MEMORDER_UNSET),
+ "acquire")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->memorder = OMP_MEMORDER_ACQUIRE;
needs_space = true;
continue;
@@ -1371,7 +1436,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
&& gfc_match ("affinity ( ") == MATCH_YES)
{
gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
- match m = gfc_match_iterator (&ns_iter, true);
+ m = gfc_match_iterator (&ns_iter, true);
if (m == MATCH_ERROR)
break;
if (m == MATCH_YES && gfc_match (" : ") != MATCH_YES)
@@ -1398,9 +1463,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
}
if ((mask & OMP_CLAUSE_AT)
- && c->at == OMP_AT_UNSET
- && gfc_match ("at ( ") == MATCH_YES)
+ && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true))
+ != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
if (gfc_match ("compilation )") == MATCH_YES)
c->at = OMP_AT_COMPILATION;
else if (gfc_match ("execution )") == MATCH_YES)
@@ -1414,11 +1481,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
}
if ((mask & OMP_CLAUSE_ASYNC)
- && !c->async
- && gfc_match ("async") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->async, "async")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->async = true;
- match m = gfc_match (" ( %e )", &c->async_expr);
+ m = gfc_match (" ( %e )", &c->async_expr);
if (m == MATCH_ERROR)
{
gfc_current_locus = old_loc;
@@ -1436,9 +1504,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
}
if ((mask & OMP_CLAUSE_AUTO)
- && !c->par_auto
- && gfc_match ("auto") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->par_auto, "auto"))
+ != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->par_auto = true;
needs_space = true;
continue;
@@ -1452,9 +1522,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
break;
case 'b':
if ((mask & OMP_CLAUSE_BIND)
- && c->bind == OMP_BIND_UNSET
- && gfc_match ("bind ( ") == MATCH_YES)
+ && (m = gfc_match_dupl_check (c->bind == OMP_BIND_UNSET, "bind",
+ true)) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
if (gfc_match ("teams )") == MATCH_YES)
c->bind = OMP_BIND_TEAMS;
else if (gfc_match ("parallel )") == MATCH_YES)
@@ -1472,34 +1544,36 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
break;
case 'c':
if ((mask & OMP_CLAUSE_CAPTURE)
- && !c->capture
- && gfc_match ("capture") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->capture, "capture"))
+ != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->capture = true;
needs_space = true;
continue;
}
- if ((mask & OMP_CLAUSE_COLLAPSE)
- && !c->collapse)
+ if (mask & OMP_CLAUSE_COLLAPSE)
{
gfc_expr *cexpr = NULL;
- match m = gfc_match ("collapse ( %e )", &cexpr);
-
- if (m == MATCH_YES)
- {
- int collapse;
- if (gfc_extract_int (cexpr, &collapse, -1))
+ if ((m = gfc_match_dupl_check (!c->collapse, "collapse", true,
+ &cexpr)) != MATCH_NO)
+ {
+ int collapse;
+ if (m == MATCH_ERROR)
+ goto error;
+ if (gfc_extract_int (cexpr, &collapse, -1))
+ collapse = 1;
+ else if (collapse <= 0)
+ {
+ gfc_error_now ("COLLAPSE clause argument not constant "
+ "positive integer at %C");
collapse = 1;
- else if (collapse <= 0)
- {
- gfc_error_now ("COLLAPSE clause argument not"
- " constant positive integer at %C");
- collapse = 1;
- }
- c->collapse = collapse;
- gfc_free_expr (cexpr);
- continue;
- }
+ }
+ gfc_free_expr (cexpr);
+ c->collapse = collapse;
+ continue;
+ }
}
if ((mask & OMP_CLAUSE_COPY)
&& gfc_match ("copy ( ") == MATCH_YES
@@ -1539,28 +1613,6 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
break;
case 'd':
- if ((mask & OMP_CLAUSE_DEFAULT)
- && c->default_sharing == OMP_DEFAULT_UNKNOWN)
- {
- if (gfc_match ("default ( none )") == MATCH_YES)
- c->default_sharing = OMP_DEFAULT_NONE;
- else if (openacc)
- {
- if (gfc_match ("default ( present )") == MATCH_YES)
- c->default_sharing = OMP_DEFAULT_PRESENT;
- }
- else
- {
- if (gfc_match ("default ( firstprivate )") == MATCH_YES)
- c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE;
- else if (gfc_match ("default ( private )") == MATCH_YES)
- c->default_sharing = OMP_DEFAULT_PRIVATE;
- else if (gfc_match ("default ( shared )") == MATCH_YES)
- c->default_sharing = OMP_DEFAULT_SHARED;
- }
- if (c->default_sharing != OMP_DEFAULT_UNKNOWN)
- continue;
- }
if ((mask & OMP_CLAUSE_DEFAULTMAP)
&& gfc_match ("defaultmap ( ") == MATCH_YES)
{
@@ -1645,6 +1697,43 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
break;
continue;
}
+ if ((mask & OMP_CLAUSE_DEFAULT)
+ && (m = gfc_match_dupl_check (c->default_sharing
+ == OMP_DEFAULT_UNKNOWN, "default",
+ true)) != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ if (gfc_match ("none") == MATCH_YES)
+ c->default_sharing = OMP_DEFAULT_NONE;
+ else if (openacc)
+ {
+ if (gfc_match ("present") == MATCH_YES)
+ c->default_sharing = OMP_DEFAULT_PRESENT;
+ }
+ else
+ {
+ if (gfc_match ("firstprivate") == MATCH_YES)
+ c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE;
+ else if (gfc_match ("private") == MATCH_YES)
+ c->default_sharing = OMP_DEFAULT_PRIVATE;
+ else if (gfc_match ("shared") == MATCH_YES)
+ c->default_sharing = OMP_DEFAULT_SHARED;
+ }
+ if (c->default_sharing == OMP_DEFAULT_UNKNOWN)
+ {
+ if (openacc)
+ gfc_error ("Expected NONE or PRESENT in DEFAULT clause "
+ "at %C");
+ else
+ gfc_error ("Expected NONE, FIRSTPRIVATE, PRIVATE or SHARED "
+ "in DEFAULT clause at %C");
+ goto error;
+ }
+ if (gfc_match (" )") != MATCH_YES)
+ goto error;
+ continue;
+ }
if ((mask & OMP_CLAUSE_DELETE)
&& gfc_match ("delete ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
@@ -1660,7 +1749,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
break;
if (m_it == MATCH_YES && gfc_match (" , ") != MATCH_YES)
break;
- match m = MATCH_YES;
+ m = MATCH_YES;
gfc_omp_depend_op depend_op = OMP_DEPEND_OUT;
if (gfc_match ("inout") == MATCH_YES)
depend_op = OMP_DEPEND_INOUT;
@@ -1736,9 +1825,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
if ((mask & OMP_CLAUSE_DEVICE)
&& !openacc
- && c->device == NULL
- && gfc_match ("device ( %e )", &c->device) == MATCH_YES)
- continue;
+ && (m = gfc_match_dupl_check (!c->device, "device", true,
+ &c->device)) != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ continue;
+ }
if ((mask & OMP_CLAUSE_DEVICE)
&& openacc
&& gfc_match ("device ( ") == MATCH_YES
@@ -1779,7 +1872,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
&& c->dist_sched_kind == OMP_SCHED_NONE
&& gfc_match ("dist_schedule ( static") == MATCH_YES)
{
- match m = MATCH_NO;
+ m = MATCH_NO;
c->dist_sched_kind = OMP_SCHED_STATIC;
m = gfc_match (" , %e )", &c->dist_chunk_size);
if (m != MATCH_YES)
@@ -1795,17 +1888,27 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
break;
case 'f':
if ((mask & OMP_CLAUSE_FILTER)
- && c->filter == NULL
- && gfc_match ("filter ( %e )", &c->filter) == MATCH_YES)
- continue;
+ && (m = gfc_match_dupl_check (!c->filter, "filter", true,
+ &c->filter)) != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ continue;
+ }
if ((mask & OMP_CLAUSE_FINAL)
- && c->final_expr == NULL
- && gfc_match ("final ( %e )", &c->final_expr) == MATCH_YES)
- continue;
+ && (m = gfc_match_dupl_check (!c->final_expr, "final", true,
+ &c->final_expr)) != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ continue;
+ }
if ((mask & OMP_CLAUSE_FINALIZE)
- && !c->finalize
- && gfc_match ("finalize") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->finalize, "finalize"))
+ != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->finalize = true;
needs_space = true;
continue;
@@ -1823,11 +1926,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
break;
case 'g':
if ((mask & OMP_CLAUSE_GANG)
- && !c->gang
- && gfc_match ("gang") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->gang, "gang")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->gang = true;
- match m = match_oacc_clause_gwv (c, GOMP_DIM_GANG);
+ m = match_oacc_clause_gwv (c, GOMP_DIM_GANG);
if (m == MATCH_ERROR)
{
gfc_current_locus = old_loc;
@@ -1838,15 +1942,27 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
}
if ((mask & OMP_CLAUSE_GRAINSIZE)
- && c->grainsize == NULL
- && gfc_match ("grainsize ( %e )", &c->grainsize) == MATCH_YES)
- continue;
+ && (m = gfc_match_dupl_check (!c->grainsize, "grainsize", true))
+ != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ if (gfc_match ("strict : ") == MATCH_YES)
+ c->grainsize_strict = true;
+ if (gfc_match (" %e )", &c->grainsize) != MATCH_YES)
+ goto error;
+ continue;
+ }
break;
case 'h':
if ((mask & OMP_CLAUSE_HINT)
- && c->hint == NULL
- && gfc_match ("hint ( %e )", &c->hint) == MATCH_YES)
- continue;
+ && (m = gfc_match_dupl_check (!c->hint, "hint", true, &c->hint))
+ != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ continue;
+ }
if ((mask & OMP_CLAUSE_HOST_SELF)
&& gfc_match ("host ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
@@ -1855,24 +1971,36 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
break;
case 'i':
+ if ((mask & OMP_CLAUSE_IF_PRESENT)
+ && (m = gfc_match_dupl_check (!c->if_present, "if_present"))
+ != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ c->if_present = true;
+ needs_space = true;
+ continue;
+ }
if ((mask & OMP_CLAUSE_IF)
- && c->if_expr == NULL
- && gfc_match ("if ( ") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->if_expr, "if", true))
+ != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
if (!openacc)
{
/* This should match the enum gfc_omp_if_kind order. */
static const char *ifs[OMP_IF_LAST] = {
- " cancel : %e )",
- " parallel : %e )",
- " simd : %e )",
- " task : %e )",
- " taskloop : %e )",
- " target : %e )",
- " target data : %e )",
- " target update : %e )",
- " target enter data : %e )",
- " target exit data : %e )" };
+ "cancel : %e )",
+ "parallel : %e )",
+ "simd : %e )",
+ "task : %e )",
+ "taskloop : %e )",
+ "target : %e )",
+ "target data : %e )",
+ "target update : %e )",
+ "target enter data : %e )",
+ "target exit data : %e )" };
int i;
for (i = 0; i < OMP_IF_LAST; i++)
if (c->if_exprs[i] == NULL
@@ -1881,34 +2009,29 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if (i < OMP_IF_LAST)
continue;
}
- if (gfc_match ("%e )", &c->if_expr) == MATCH_YES)
+ if (gfc_match (" %e )", &c->if_expr) == MATCH_YES)
continue;
- gfc_current_locus = old_loc;
- }
- if ((mask & OMP_CLAUSE_IF_PRESENT)
- && !c->if_present
- && gfc_match ("if_present") == MATCH_YES)
- {
- c->if_present = true;
- needs_space = true;
- continue;
+ goto error;
}
if ((mask & OMP_CLAUSE_IN_REDUCTION)
&& gfc_match_omp_clause_reduction (pc, c, openacc,
allow_derived) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_INBRANCH)
- && !c->inbranch
- && !c->notinbranch
- && gfc_match ("inbranch") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->inbranch && !c->notinbranch,
+ "inbranch")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->inbranch = needs_space = true;
continue;
}
if ((mask & OMP_CLAUSE_INDEPENDENT)
- && !c->independent
- && gfc_match ("independent") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->independent, "independent"))
+ != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->independent = true;
needs_space = true;
continue;
@@ -2089,16 +2212,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
gfc_current_locus = old_loc;
break;
}
- if ((mask & OMP_CLAUSE_MERGEABLE) && !c->mergeable
- && gfc_match ("mergeable") == MATCH_YES)
+ if ((mask & OMP_CLAUSE_MERGEABLE)
+ && (m = gfc_match_dupl_check (!c->mergeable, "mergeable"))
+ != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->mergeable = needs_space = true;
continue;
}
if ((mask & OMP_CLAUSE_MESSAGE)
- && !c->message
- && gfc_match ("message ( %e )", &c->message) == MATCH_YES)
- continue;
+ && (m = gfc_match_dupl_check (!c->message, "message", true,
+ &c->message)) != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ continue;
+ }
break;
case 'n':
if ((mask & OMP_CLAUSE_NO_CREATE)
@@ -2108,16 +2238,19 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
allow_derived))
continue;
if ((mask & OMP_CLAUSE_NOGROUP)
- && !c->nogroup
- && gfc_match ("nogroup") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->nogroup, "nogroup"))
+ != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->nogroup = needs_space = true;
continue;
}
if ((mask & OMP_CLAUSE_NOHOST)
- && !c->nohost
- && gfc_match ("nohost") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->nohost, "nohost")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->nohost = needs_space = true;
continue;
}
@@ -2127,43 +2260,69 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
true) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_NOTINBRANCH)
- && !c->notinbranch
- && !c->inbranch
- && gfc_match ("notinbranch") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->notinbranch && !c->inbranch,
+ "notinbranch")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->notinbranch = needs_space = true;
continue;
}
if ((mask & OMP_CLAUSE_NOWAIT)
- && !c->nowait
- && gfc_match ("nowait") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->nowait, "nowait")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->nowait = needs_space = true;
continue;
}
if ((mask & OMP_CLAUSE_NUM_GANGS)
- && c->num_gangs_expr == NULL
- && gfc_match ("num_gangs ( %e )",
- &c->num_gangs_expr) == MATCH_YES)
- continue;
+ && (m = gfc_match_dupl_check (!c->num_gangs_expr, "num_gangs",
+ true)) != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ if (gfc_match (" %e )", &c->num_gangs_expr) != MATCH_YES)
+ goto error;
+ continue;
+ }
if ((mask & OMP_CLAUSE_NUM_TASKS)
- && c->num_tasks == NULL
- && gfc_match ("num_tasks ( %e )", &c->num_tasks) == MATCH_YES)
- continue;
+ && (m = gfc_match_dupl_check (!c->num_tasks, "num_tasks", true))
+ != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ if (gfc_match ("strict : ") == MATCH_YES)
+ c->num_tasks_strict = true;
+ if (gfc_match (" %e )", &c->num_tasks) != MATCH_YES)
+ goto error;
+ continue;
+ }
if ((mask & OMP_CLAUSE_NUM_TEAMS)
- && c->num_teams == NULL
- && gfc_match ("num_teams ( %e )", &c->num_teams) == MATCH_YES)
- continue;
+ && (m = gfc_match_dupl_check (!c->num_teams, "num_teams", true,
+ &c->num_teams)) != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ continue;
+ }
if ((mask & OMP_CLAUSE_NUM_THREADS)
- && c->num_threads == NULL
- && (gfc_match ("num_threads ( %e )", &c->num_threads)
- == MATCH_YES))
- continue;
+ && (m = gfc_match_dupl_check (!c->num_threads, "num_threads", true,
+ &c->num_threads)) != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ continue;
+ }
if ((mask & OMP_CLAUSE_NUM_WORKERS)
- && c->num_workers_expr == NULL
- && gfc_match ("num_workers ( %e )",
- &c->num_workers_expr) == MATCH_YES)
- continue;
+ && (m = gfc_match_dupl_check (!c->num_workers_expr, "num_workers",
+ true, &c->num_workers_expr))
+ != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ continue;
+ }
break;
case 'o':
if ((mask & OMP_CLAUSE_ORDER)
@@ -2174,11 +2333,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
}
if ((mask & OMP_CLAUSE_ORDERED)
- && !c->ordered
- && gfc_match ("ordered") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->ordered, "ordered"))
+ != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
gfc_expr *cexpr = NULL;
- match m = gfc_match (" ( %e )", &cexpr);
+ m = gfc_match (" ( %e )", &cexpr);
c->ordered = true;
if (m == MATCH_YES)
@@ -2250,35 +2411,46 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
OMP_MAP_ALLOC, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_PRIORITY)
- && c->priority == NULL
- && gfc_match ("priority ( %e )", &c->priority) == MATCH_YES)
- continue;
+ && (m = gfc_match_dupl_check (!c->priority, "priority", true,
+ &c->priority)) != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ continue;
+ }
if ((mask & OMP_CLAUSE_PRIVATE)
&& gfc_match_omp_variable_list ("private (",
&c->lists[OMP_LIST_PRIVATE],
true) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_PROC_BIND)
- && c->proc_bind == OMP_PROC_BIND_UNKNOWN)
+ && (m = gfc_match_dupl_check ((c->proc_bind
+ == OMP_PROC_BIND_UNKNOWN),
+ "proc_bind", true)) != MATCH_NO)
{
- /* Primary is new and master is deprecated in OpenMP 5.1. */
- if (gfc_match ("proc_bind ( primary )") == MATCH_YES)
- c->proc_bind = OMP_PROC_BIND_MASTER;
- else if (gfc_match ("proc_bind ( master )") == MATCH_YES)
+ if (m == MATCH_ERROR)
+ goto error;
+ if (gfc_match ("primary )") == MATCH_YES)
+ c->proc_bind = OMP_PROC_BIND_PRIMARY;
+ else if (gfc_match ("master )") == MATCH_YES)
c->proc_bind = OMP_PROC_BIND_MASTER;
- else if (gfc_match ("proc_bind ( spread )") == MATCH_YES)
+ else if (gfc_match ("spread )") == MATCH_YES)
c->proc_bind = OMP_PROC_BIND_SPREAD;
- else if (gfc_match ("proc_bind ( close )") == MATCH_YES)
+ else if (gfc_match ("close )") == MATCH_YES)
c->proc_bind = OMP_PROC_BIND_CLOSE;
- if (c->proc_bind != OMP_PROC_BIND_UNKNOWN)
- continue;
+ else
+ goto error;
+ continue;
}
break;
case 'r':
if ((mask & OMP_CLAUSE_ATOMIC)
- && c->atomic_op == GFC_OMP_ATOMIC_UNSET
- && gfc_match ("read") == MATCH_YES)
+ && (m = gfc_match_dupl_atomic ((c->atomic_op
+ == GFC_OMP_ATOMIC_UNSET),
+ "read")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->atomic_op = GFC_OMP_ATOMIC_READ;
needs_space = true;
continue;
@@ -2288,33 +2460,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
allow_derived) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_MEMORDER)
- && c->memorder == OMP_MEMORDER_UNSET
- && gfc_match ("relaxed") == MATCH_YES)
- {
- c->memorder = OMP_MEMORDER_RELAXED;
- needs_space = true;
- continue;
- }
- if ((mask & OMP_CLAUSE_MEMORDER)
- && c->memorder == OMP_MEMORDER_UNSET
- && gfc_match ("release") == MATCH_YES)
- {
- c->memorder = OMP_MEMORDER_RELEASE;
- needs_space = true;
- continue;
- }
- if ((mask & OMP_CLAUSE_MEMORDER)
- && c->memorder == OMP_MEMORDER_UNSET
- && gfc_match ("relaxed") == MATCH_YES)
+ && (m = gfc_match_dupl_memorder ((c->memorder
+ == OMP_MEMORDER_UNSET),
+ "relaxed")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->memorder = OMP_MEMORDER_RELAXED;
needs_space = true;
continue;
}
if ((mask & OMP_CLAUSE_MEMORDER)
- && c->memorder == OMP_MEMORDER_UNSET
- && gfc_match ("release") == MATCH_YES)
+ && (m = gfc_match_dupl_memorder ((c->memorder
+ == OMP_MEMORDER_UNSET),
+ "release")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->memorder = OMP_MEMORDER_RELEASE;
needs_space = true;
continue;
@@ -2322,13 +2484,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
break;
case 's':
if ((mask & OMP_CLAUSE_SAFELEN)
- && c->safelen_expr == NULL
- && gfc_match ("safelen ( %e )", &c->safelen_expr) == MATCH_YES)
- continue;
+ && (m = gfc_match_dupl_check (!c->safelen_expr, "safelen",
+ true, &c->safelen_expr))
+ != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ continue;
+ }
if ((mask & OMP_CLAUSE_SCHEDULE)
- && c->sched_kind == OMP_SCHED_NONE
- && gfc_match ("schedule ( ") == MATCH_YES)
+ && (m = gfc_match_dupl_check (c->sched_kind == OMP_SCHED_NONE,
+ "schedule", true)) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
int nmodifiers = 0;
locus old_loc2 = gfc_current_locus;
do
@@ -2375,7 +2544,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
c->sched_kind = OMP_SCHED_AUTO;
if (c->sched_kind != OMP_SCHED_NONE)
{
- match m = MATCH_NO;
+ m = MATCH_NO;
if (c->sched_kind != OMP_SCHED_RUNTIME
&& c->sched_kind != OMP_SCHED_AUTO)
m = gfc_match (" , %e )", &c->chunk_size);
@@ -2396,17 +2565,21 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
allow_derived))
continue;
if ((mask & OMP_CLAUSE_SEQ)
- && !c->seq
- && gfc_match ("seq") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->seq, "seq")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->seq = true;
needs_space = true;
continue;
}
if ((mask & OMP_CLAUSE_MEMORDER)
- && c->memorder == OMP_MEMORDER_UNSET
- && gfc_match ("seq_cst") == MATCH_YES)
+ && (m = gfc_match_dupl_memorder ((c->memorder
+ == OMP_MEMORDER_UNSET),
+ "seq_cst")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->memorder = OMP_MEMORDER_SEQ_CST;
needs_space = true;
continue;
@@ -2417,20 +2590,27 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
true) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_SIMDLEN)
- && c->simdlen_expr == NULL
- && gfc_match ("simdlen ( %e )", &c->simdlen_expr) == MATCH_YES)
- continue;
+ && (m = gfc_match_dupl_check (!c->simdlen_expr, "simdlen", true,
+ &c->simdlen_expr)) != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ continue;
+ }
if ((mask & OMP_CLAUSE_SIMD)
- && !c->simd
- && gfc_match ("simd") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->simd, "simd")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->simd = needs_space = true;
continue;
}
if ((mask & OMP_CLAUSE_SEVERITY)
- && c->severity == OMP_SEVERITY_UNSET
- && gfc_match ("severity ( ") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->severity, "severity", true))
+ != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
if (gfc_match ("fatal )") == MATCH_YES)
c->severity = OMP_SEVERITY_FATAL;
else if (gfc_match ("warning )") == MATCH_YES)
@@ -2450,14 +2630,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
allow_derived) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_THREAD_LIMIT)
- && c->thread_limit == NULL
- && gfc_match ("thread_limit ( %e )",
- &c->thread_limit) == MATCH_YES)
- continue;
+ && (m = gfc_match_dupl_check (!c->thread_limit, "thread_limit",
+ true, &c->thread_limit))
+ != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ continue;
+ }
if ((mask & OMP_CLAUSE_THREADS)
- && !c->threads
- && gfc_match ("threads") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->threads, "threads"))
+ != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->threads = needs_space = true;
continue;
}
@@ -2485,16 +2671,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
false) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_UNTIED)
- && !c->untied
- && gfc_match ("untied") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->untied, "untied")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->untied = needs_space = true;
continue;
}
if ((mask & OMP_CLAUSE_ATOMIC)
- && c->atomic_op == GFC_OMP_ATOMIC_UNSET
- && gfc_match ("update") == MATCH_YES)
+ && (m = gfc_match_dupl_atomic ((c->atomic_op
+ == GFC_OMP_ATOMIC_UNSET),
+ "update")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->atomic_op = GFC_OMP_ATOMIC_UPDATE;
needs_space = true;
continue;
@@ -2519,21 +2709,24 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
/* VECTOR_LENGTH must be matched before VECTOR, because the latter
doesn't unconditionally match '('. */
if ((mask & OMP_CLAUSE_VECTOR_LENGTH)
- && c->vector_length_expr == NULL
- && (gfc_match ("vector_length ( %e )", &c->vector_length_expr)
- == MATCH_YES))
- continue;
+ && (m = gfc_match_dupl_check (!c->vector_length_expr,
+ "vector_length", true,
+ &c->vector_length_expr))
+ != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ continue;
+ }
if ((mask & OMP_CLAUSE_VECTOR)
- && !c->vector
- && gfc_match ("vector") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->vector, "vector")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->vector = true;
- match m = match_oacc_clause_gwv (c, GOMP_DIM_VECTOR);
+ m = match_oacc_clause_gwv (c, GOMP_DIM_VECTOR);
if (m == MATCH_ERROR)
- {
- gfc_current_locus = old_loc;
- break;
- }
+ goto error;
if (m == MATCH_NO)
needs_space = true;
continue;
@@ -2543,12 +2736,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if ((mask & OMP_CLAUSE_WAIT)
&& gfc_match ("wait") == MATCH_YES)
{
- match m = match_oacc_expr_list (" (", &c->wait_list, false);
+ m = match_oacc_expr_list (" (", &c->wait_list, false);
if (m == MATCH_ERROR)
- {
- gfc_current_locus = old_loc;
- break;
- }
+ goto error;
else if (m == MATCH_NO)
{
gfc_expr *expr
@@ -2566,24 +2756,25 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
}
if ((mask & OMP_CLAUSE_WORKER)
- && !c->worker
- && gfc_match ("worker") == MATCH_YES)
+ && (m = gfc_match_dupl_check (!c->worker, "worker")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->worker = true;
- match m = match_oacc_clause_gwv (c, GOMP_DIM_WORKER);
+ m = match_oacc_clause_gwv (c, GOMP_DIM_WORKER);
if (m == MATCH_ERROR)
- {
- gfc_current_locus = old_loc;
- break;
- }
+ goto error;
else if (m == MATCH_NO)
needs_space = true;
continue;
}
if ((mask & OMP_CLAUSE_ATOMIC)
- && c->atomic_op == GFC_OMP_ATOMIC_UNSET
- && gfc_match ("write") == MATCH_YES)
+ && (m = gfc_match_dupl_atomic ((c->atomic_op
+ == GFC_OMP_ATOMIC_UNSET),
+ "write")) != MATCH_NO)
{
+ if (m == MATCH_ERROR)
+ goto error;
c->atomic_op = GFC_OMP_ATOMIC_WRITE;
needs_space = true;
continue;
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 91888f31cb3..40d2fd206e4 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -3998,6 +3998,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GRAINSIZE);
OMP_CLAUSE_GRAINSIZE_EXPR (c) = grainsize;
+ if (clauses->grainsize_strict)
+ OMP_CLAUSE_GRAINSIZE_STRICT (c) = 1;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
@@ -4013,6 +4015,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TASKS);
OMP_CLAUSE_NUM_TASKS_EXPR (c) = num_tasks;
+ if (clauses->num_tasks_strict)
+ OMP_CLAUSE_NUM_TASKS_STRICT (c) = 1;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
@@ -5964,8 +5968,12 @@ gfc_split_omp_clauses (gfc_code *code,
= code->ext.omp_clauses->nogroup;
clausesa[GFC_OMP_SPLIT_TASKLOOP].grainsize
= code->ext.omp_clauses->grainsize;
+ clausesa[GFC_OMP_SPLIT_TASKLOOP].grainsize_strict
+ = code->ext.omp_clauses->grainsize_strict;
clausesa[GFC_OMP_SPLIT_TASKLOOP].num_tasks
= code->ext.omp_clauses->num_tasks;
+ clausesa[GFC_OMP_SPLIT_TASKLOOP].num_tasks_strict
+ = code->ext.omp_clauses->num_tasks_strict;
clausesa[GFC_OMP_SPLIT_TASKLOOP].priority
= code->ext.omp_clauses->priority;
clausesa[GFC_OMP_SPLIT_TASKLOOP].final_expr
diff --git a/gcc/testsuite/gfortran.dg/goacc/asyncwait-1.f95 b/gcc/testsuite/gfortran.dg/goacc/asyncwait-1.f95
index c8a72fabadd..f67dd9cb4e3 100644
--- a/gcc/testsuite/gfortran.dg/goacc/asyncwait-1.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/asyncwait-1.f95
@@ -53,7 +53,7 @@ program asyncwait
end do
!$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" }
- !$acc parallel copyin (a(1:N)) copy (b(1:N)) async (*) ! { dg-error "Invalid character in name at" }
+ !$acc parallel copyin (a(1:N)) copy (b(1:N)) async (*) ! { dg-error "Invalid character in name" }
do i = 1, N
b(i) = a(i)
end do
diff --git a/gcc/testsuite/gfortran.dg/goacc/default-2.f b/gcc/testsuite/gfortran.dg/goacc/default-2.f
index ea82388eae9..963d9780c65 100644
--- a/gcc/testsuite/gfortran.dg/goacc/default-2.f
+++ b/gcc/testsuite/gfortran.dg/goacc/default-2.f
@@ -3,44 +3,44 @@
SUBROUTINE F1
IMPLICIT NONE
-!$ACC KERNELS DEFAULT ! { dg-error "Failed to match clause" }
+!$ACC KERNELS DEFAULT ! { dg-error "Expected '\\(' after 'default" }
!$ACC END KERNELS ! { dg-error "Unexpected" }
-!$ACC PARALLEL DEFAULT ! { dg-error "Failed to match clause" }
+!$ACC PARALLEL DEFAULT ! { dg-error "Expected '\\(' after 'default" }
!$ACC END PARALLEL ! { dg-error "Unexpected" }
-!$ACC KERNELS DEFAULT ( ! { dg-error "Failed to match clause" }
+!$ACC KERNELS DEFAULT ( ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
!$ACC END KERNELS ! { dg-error "Unexpected" }
-!$ACC PARALLEL DEFAULT ( ! { dg-error "Failed to match clause" }
+!$ACC PARALLEL DEFAULT ( ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
!$ACC END PARALLEL ! { dg-error "Unexpected" }
-!$ACC KERNELS DEFAULT (, ! { dg-error "Failed to match clause" }
+!$ACC KERNELS DEFAULT (, ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
!$ACC END KERNELS ! { dg-error "Unexpected" }
-!$ACC PARALLEL DEFAULT (, ! { dg-error "Failed to match clause" }
+!$ACC PARALLEL DEFAULT (, ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
!$ACC END PARALLEL ! { dg-error "Unexpected" }
-!$ACC KERNELS DEFAULT () ! { dg-error "Failed to match clause" }
+!$ACC KERNELS DEFAULT () ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
!$ACC END KERNELS ! { dg-error "Unexpected" }
-!$ACC PARALLEL DEFAULT () ! { dg-error "Failed to match clause" }
+!$ACC PARALLEL DEFAULT () ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
!$ACC END PARALLEL ! { dg-error "Unexpected" }
-!$ACC KERNELS DEFAULT (,) ! { dg-error "Failed to match clause" }
+!$ACC KERNELS DEFAULT (,) ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
!$ACC END KERNELS ! { dg-error "Unexpected" }
-!$ACC PARALLEL DEFAULT (,) ! { dg-error "Failed to match clause" }
+!$ACC PARALLEL DEFAULT (,) ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
!$ACC END PARALLEL ! { dg-error "Unexpected" }
-!$ACC KERNELS DEFAULT (FIRSTPRIVATE) ! { dg-error "Failed to match clause" }
+!$ACC KERNELS DEFAULT (FIRSTPRIVATE) ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
!$ACC END KERNELS ! { dg-error "Unexpected" }
-!$ACC PARALLEL DEFAULT (FIRSTPRIVATE) ! { dg-error "Failed to match clause" }
+!$ACC PARALLEL DEFAULT (FIRSTPRIVATE) ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
!$ACC END PARALLEL ! { dg-error "Unexpected" }
-!$ACC KERNELS DEFAULT (PRIVATE) ! { dg-error "Failed to match clause" }
+!$ACC KERNELS DEFAULT (PRIVATE) ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
!$ACC END KERNELS ! { dg-error "Unexpected" }
-!$ACC PARALLEL DEFAULT (PRIVATE) ! { dg-error "Failed to match clause" }
+!$ACC PARALLEL DEFAULT (PRIVATE) ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
!$ACC END PARALLEL ! { dg-error "Unexpected" }
-!$ACC KERNELS DEFAULT (SHARED) ! { dg-error "Failed to match clause" }
+!$ACC KERNELS DEFAULT (SHARED) ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
!$ACC END KERNELS ! { dg-error "Unexpected" }
-!$ACC PARALLEL DEFAULT (SHARED) ! { dg-error "Failed to match clause" }
+!$ACC PARALLEL DEFAULT (SHARED) ! { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
!$ACC END PARALLEL ! { dg-error "Unexpected" }
!$ACC KERNELS DEFAULT (NONE ! { dg-error "Failed to match clause" }
diff --git a/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95 b/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95
index c2a49796318..e71077aec01 100644
--- a/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95
@@ -28,7 +28,7 @@ contains
!$acc enter data
!$acc enter data if (.false.)
!$acc enter data if (l)
- !$acc enter data if (.false.) if (l) ! { dg-error "Failed to match clause" }
+ !$acc enter data if (.false.) if (l) ! { dg-error "Duplicated 'if' clause" }
!$acc enter data if (i) ! { dg-error "LOGICAL" }
!$acc enter data if (1) ! { dg-error "LOGICAL" }
!$acc enter data if (a) ! { dg-error "LOGICAL" }
@@ -63,7 +63,7 @@ contains
!$acc exit data
!$acc exit data if (.false.)
!$acc exit data if (l)
- !$acc exit data if (.false.) if (l) ! { dg-error "Failed to match clause" }
+ !$acc exit data if (.false.) if (l) ! { dg-error "Duplicated 'if' clause" }
!$acc exit data if (i) ! { dg-error "LOGICAL" }
!$acc exit data if (1) ! { dg-error "LOGICAL" }
!$acc exit data if (a) ! { dg-error "LOGICAL" }
diff --git a/gcc/testsuite/gfortran.dg/goacc/if.f95 b/gcc/testsuite/gfortran.dg/goacc/if.f95
index 35e9cfee134..56f3711f320 100644
--- a/gcc/testsuite/gfortran.dg/goacc/if.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/if.f95
@@ -6,7 +6,7 @@ program test
logical :: x
integer :: i
- !$acc parallel if ! { dg-error "Failed to match clause" }
+ !$acc parallel if ! { dg-error "Expected '\\(' after 'if'" }
!$acc parallel if () ! { dg-error "Invalid character" }
!$acc parallel if (i) ! { dg-error "scalar LOGICAL expression" }
!$acc end parallel
@@ -14,11 +14,11 @@ program test
!$acc end parallel
!$acc kernels if (i) ! { dg-error "scalar LOGICAL expression" }
!$acc end kernels
- !$acc kernels if ! { dg-error "Failed to match clause" }
+ !$acc kernels if ! { dg-error "Expected '\\(' after 'if'" }
!$acc kernels if () ! { dg-error "Invalid character" }
!$acc kernels if (1) ! { dg-error "scalar LOGICAL expression" }
!$acc end kernels
- !$acc data if ! { dg-error "Failed to match clause" }
+ !$acc data if ! { dg-error "Expected '\\(' after 'if'" }
!$acc data if () ! { dg-error "Invalid character" }
!$acc data if (i) ! { dg-error "scalar LOGICAL expression" }
!$acc end data
@@ -26,9 +26,9 @@ program test
!$acc end data
! at most one if clause may appear
- !$acc parallel if (.false.) if (.false.) { dg-error "Failed to match clause" }
- !$acc kernels if (.false.) if (.false.) { dg-error "Failed to match clause" }
- !$acc data if (.false.) if (.false.) { dg-error "Failed to match clause" }
+ !$acc parallel if (.false.) if (.false.) { dg-error "Duplicated 'if' clause" }
+ !$acc kernels if (.false.) if (.false.) { dg-error "Duplicated 'if' clause" }
+ !$acc data if (.false.) if (.false.) { dg-error "Duplicated 'if' clause" }
!$acc parallel if (x)
!$acc end parallel
diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95
index 72ba147565b..70b84f11549 100644
--- a/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95
@@ -59,17 +59,17 @@ program test
!$acc parallel default ( none )
!$acc end parallel
- !$acc kernels default { dg-error "Failed to match clause" }
- !$acc parallel default { dg-error "Failed to match clause" }
+ !$acc kernels default { dg-error "Expected '\\(' after 'default'" }
+ !$acc parallel default { dg-error "Expected '\\(' after 'default'" }
- !$acc kernels default() { dg-error "Failed to match clause" }
- !$acc parallel default() { dg-error "Failed to match clause" }
+ !$acc kernels default() { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
+ !$acc parallel default() { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
- !$acc kernels default(i) { dg-error "Failed to match clause" }
- !$acc parallel default(i) { dg-error "Failed to match clause" }
+ !$acc kernels default(i) { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
+ !$acc parallel default(i) { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
- !$acc kernels default(1) { dg-error "Failed to match clause" }
- !$acc parallel default(1) { dg-error "Failed to match clause" }
+ !$acc kernels default(1) { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
+ !$acc parallel default(1) { dg-error "Expected NONE or PRESENT in DEFAULT clause" }
! Wait
!$acc kernels wait (l) ! { dg-error "INTEGER" }
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
index 3cd543e5aad..2b22b1c0fbe 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
@@ -118,7 +118,7 @@ subroutine subr10 (x)
end subroutine subr10
subroutine subr20 (x)
- !$acc routine (subr20) nohost nohost ! { dg-error "Failed to match clause" }
+ !$acc routine (subr20) nohost nohost ! { dg-error "Duplicated 'nohost' clause" }
integer, intent(inout) :: x
if (x < 1) then
x = 1
diff --git a/gcc/testsuite/gfortran.dg/goacc/sie.f95 b/gcc/testsuite/gfortran.dg/goacc/sie.f95
index 194a1daae5f..5982d5d229f 100644
--- a/gcc/testsuite/gfortran.dg/goacc/sie.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/sie.f95
@@ -67,7 +67,7 @@ program test
!$acc end kernels
- !$acc parallel num_gangs ! { dg-error "Failed to match clause" }
+ !$acc parallel num_gangs ! { dg-error "Expected '\\(' after 'num_gangs'" }
!$acc parallel num_gangs(3)
!$acc end parallel
@@ -95,7 +95,7 @@ program test
!$acc parallel num_gangs("1") ! { dg-error "scalar INTEGER expression" }
!$acc end parallel
- !$acc kernels num_gangs ! { dg-error "Failed to match clause" }
+ !$acc kernels num_gangs ! { dg-error "Expected '\\(' after 'num_gangs'" }
!$acc kernels num_gangs(3)
!$acc end kernels
@@ -124,7 +124,7 @@ program test
!$acc end kernels
- !$acc parallel num_workers ! { dg-error "Failed to match clause" }
+ !$acc parallel num_workers ! { dg-error "Expected '\\(' after 'num_workers'" }
!$acc parallel num_workers(3)
!$acc end parallel
@@ -141,7 +141,7 @@ program test
!$acc parallel num_workers(0) ! { dg-warning "must be positive" }
!$acc end parallel
- !$acc parallel num_workers() ! { dg-error "Invalid character in name" }
+ !$acc parallel num_workers() ! { dg-error "Invalid expression after 'num_workers\\('" }
!$acc parallel num_workers(1.5) ! { dg-error "scalar INTEGER expression" }
!$acc end parallel
@@ -152,7 +152,7 @@ program test
!$acc parallel num_workers("1") ! { dg-error "scalar INTEGER expression" }
!$acc end parallel
- !$acc kernels num_workers ! { dg-error "Failed to match clause" }
+ !$acc kernels num_workers ! { dg-error "Expected '\\(' after 'num_workers'" }
!$acc kernels num_workers(3)
!$acc end kernels
@@ -169,7 +169,7 @@ program test
!$acc kernels num_workers(0) ! { dg-warning "must be positive" }
!$acc end kernels
- !$acc kernels num_workers() ! { dg-error "Invalid character in name" }
+ !$acc kernels num_workers() ! { dg-error "Invalid expression after 'num_workers\\('" }
!$acc kernels num_workers(1.5) ! { dg-error "scalar INTEGER expression" }
!$acc end kernels
@@ -181,7 +181,7 @@ program test
!$acc end kernels
- !$acc parallel vector_length ! { dg-error "Failed to match clause" }
+ !$acc parallel vector_length ! { dg-error "Expected '\\(' after 'vector_length'" }
!$acc parallel vector_length(3)
!$acc end parallel
@@ -198,7 +198,7 @@ program test
!$acc parallel vector_length(0) ! { dg-warning "must be positive" }
!$acc end parallel
- !$acc parallel vector_length() ! { dg-error "Invalid character in name" }
+ !$acc parallel vector_length() ! { dg-error "Invalid expression after 'vector_length\\('" }
!$acc parallel vector_length(1.5) ! { dg-error "scalar INTEGER expression" }
!$acc end parallel
@@ -209,7 +209,7 @@ program test
!$acc parallel vector_length("1") ! { dg-error "scalar INTEGER expression" }
!$acc end parallel
- !$acc kernels vector_length ! { dg-error "Failed to match clause" }
+ !$acc kernels vector_length ! { dg-error "Expected '\\(' after 'vector_length'" }
!$acc kernels vector_length(3)
!$acc end kernels
@@ -226,7 +226,7 @@ program test
!$acc kernels vector_length(0) ! { dg-warning "must be positive" }
!$acc end kernels
- !$acc kernels vector_length() ! { dg-error "Invalid character in name" }
+ !$acc kernels vector_length() ! { dg-error "Invalid expression after 'vector_length\\('" }
!$acc kernels vector_length(1.5) ! { dg-error "scalar INTEGER expression" }
!$acc end kernels
diff --git a/gcc/testsuite/gfortran.dg/goacc/update-if_present-2.f90 b/gcc/testsuite/gfortran.dg/goacc/update-if_present-2.f90
index bf8b319a78e..368e9370c60 100644
--- a/gcc/testsuite/gfortran.dg/goacc/update-if_present-2.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/update-if_present-2.f90
@@ -12,10 +12,10 @@ subroutine t1
allocate (x, y, z(100))
- !$acc enter data copyin(a) if_present ! { dg-error "Failed to match clause" }
- !$acc exit data copyout(a) if_present ! { dg-error "Failed to match clause" }
+ !$acc enter data copyin(a) if_present ! { dg-error "Expected '\\(' after 'if'" }
+ !$acc exit data copyout(a) if_present ! { dg-error "Expected '\\(' after 'if'" }
- !$acc data copy(a) if_present ! { dg-error "Failed to match clause" }
+ !$acc data copy(a) if_present ! { dg-error "Expected '\\(' after 'if'" }
!$acc end data ! { dg-error "Unexpected ..ACC END DATA statement" }
!$acc declare link(a) if_present ! { dg-error "Unexpected junk after" }
@@ -40,12 +40,12 @@ subroutine t2
end do
!$acc end parallel
- !$acc kernels loop if_present ! { dg-error "Failed to match clause" }
+ !$acc kernels loop if_present ! { dg-error "Expected '\\(' after 'if'" }
do b = 1, 10
end do
!$acc end kernels loop ! { dg-error "Unexpected ..ACC END KERNELS LOOP statement" }
- !$acc parallel loop if_present ! { dg-error "Failed to match clause" }
+ !$acc parallel loop if_present ! { dg-error "Expected '\\(' after 'if'" }
do b = 1, 10
end do
!$acc end parallel loop ! { dg-error "Unexpected ..ACC END PARALLEL LOOP statement" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/cancel-2.f90 b/gcc/testsuite/gfortran.dg/gomp/cancel-2.f90
index 481b1aa5d2f..4ffbb2f209c 100644
--- a/gcc/testsuite/gfortran.dg/gomp/cancel-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/cancel-2.f90
@@ -5,11 +5,11 @@ subroutine foo ()
!$omp cancel parallel if (.true.)
!$omp cancel parallel if (cancel: .true.)
- !$omp cancel parallel if (.true.) if (.true.) ! { dg-error "Failed to match clause" }
+ !$omp cancel parallel if (.true.) if (.true.) ! { dg-error "Duplicated 'if' clause" }
!$omp cancel parallel if (cancel: .true.) if (cancel: .true.) ! { dg-error "Failed to match clause" }
!$omp cancel parallel if (cancel: .true.) if (.true.) ! { dg-error "IF clause without modifier at .1. used together with IF clauses with modifiers" }
!$omp cancel parallel if (cancel: .true.) if (parallel: .true.) ! { dg-error "IF clause modifier PARALLEL at .1. not appropriate for the current OpenMP construct" }
- !$omp cancel parallel if (.true.) if (cancel: .true.) ! { dg-error "Failed to match clause at" }
+ !$omp cancel parallel if (.true.) if (cancel: .true.) ! { dg-error "Duplicated 'if' clause" }
!$omp cancel parallel if (parallel: .true.) if (cancel: .true.) ! { dg-error "IF clause modifier PARALLEL at .1. not appropriate for the current OpenMP construct" }
!$omp end parallel
end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90
index 40169d38da4..04abd5128f5 100644
--- a/gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-simd-1.f90
@@ -2,7 +2,7 @@
subroutine fn1 (x)
integer :: x
-!$omp declare simd (fn1) inbranch notinbranch uniform (x) ! { dg-error "Failed to match clause" }
+!$omp declare simd (fn1) inbranch notinbranch uniform (x) ! { dg-error "Duplicated 'notinbranch' clause" }
end subroutine fn1
subroutine fn2 (x)
!$omp declare simd (fn100) ! { dg-error "should refer to containing procedure" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/error-3.f90 b/gcc/testsuite/gfortran.dg/gomp/error-3.f90
index 67948cdc52a..b4d8b77a7fd 100644
--- a/gcc/testsuite/gfortran.dg/gomp/error-3.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/error-3.f90
@@ -1,23 +1,23 @@
module m
!$omp error asdf ! { dg-error "Failed to match clause" }
-!$omp error at ! { dg-error "Failed to match clause" }
+!$omp error at ! { dg-error "Expected '\\(' after 'at'" }
!$omp error at( ! { dg-error "Expected COMPILATION or EXECUTION in AT clause at" }
!$omp error at(runtime) ! { dg-error "Expected COMPILATION or EXECUTION in AT clause at" }
!$omp error at(+ ! { dg-error "Expected COMPILATION or EXECUTION in AT clause at" }
!$omp error at(compilation ! { dg-error "Expected COMPILATION or EXECUTION in AT clause at" }
-!$omp error severity ! { dg-error "Failed to match clause" }
+!$omp error severity ! { dg-error "Expected '\\(' after 'severity'" }
!$omp error severity( ! { dg-error "Expected FATAL or WARNING in SEVERITY clause at" }
!$omp error severity(error) ! { dg-error "Expected FATAL or WARNING in SEVERITY clause at" }
!$omp error severity(- ! { dg-error "Expected FATAL or WARNING in SEVERITY clause at" }
!$omp error severity(fatal ! { dg-error "Expected FATAL or WARNING in SEVERITY clause at" }
-!$omp error message ! { dg-error "Failed to match clause" }
-!$omp error message( ! { dg-error "Invalid character in name" }
-!$omp error message(0 ! { dg-error "Failed to match clause" }
-!$omp error message("foo" ! { dg-error "Failed to match clause" }
+!$omp error message ! { dg-error "Expected '\\(' after 'message'" }
+!$omp error message( ! { dg-error "Invalid expression after 'message\\('" }
+!$omp error message(0 ! { dg-error "Invalid expression after 'message\\('" }
+!$omp error message("foo" ! { dg-error "Invalid expression after 'message\\('" }
-!$omp error at(compilation) at(compilation) ! { dg-error "Failed to match clause at" }
-!$omp error severity(fatal) severity(warning) ! { dg-error "Failed to match clause at" }
-!$omp error message("foo") message("foo") ! { dg-error "Failed to match clause at" }
+!$omp error at(compilation) at(compilation) ! { dg-error "Duplicated 'at' clause at" }
+!$omp error severity(fatal) severity(warning) ! { dg-error "Duplicated 'severity' clause at" }
+!$omp error message("foo") message("foo") ! { dg-error "Duplicated 'message' clause at" }
!$omp error message("foo"),at(compilation),severity(fatal),asdf ! { dg-error "Failed to match clause" }
!$omp error at(execution) ! { dg-error "Unexpected !.OMP ERROR statement in MODULE" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-2.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-2.f90
index 0cb86612566..4962683f2b0 100644
--- a/gcc/testsuite/gfortran.dg/gomp/loop-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-2.f90
@@ -37,7 +37,7 @@ end do
do i = 1, 64
end do
-!$omp loop bind(teams) bind(teams) ! { dg-error "24: Failed to match clause" }
+!$omp loop bind(teams) bind(teams) ! { dg-error "Duplicated 'bind' clause" }
do i = 1, 64
end do
diff --git a/gcc/testsuite/gfortran.dg/gomp/masked-2.f90 b/gcc/testsuite/gfortran.dg/gomp/masked-2.f90
index 95ef78c0664..b6eb8619a81 100644
--- a/gcc/testsuite/gfortran.dg/gomp/masked-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/masked-2.f90
@@ -41,6 +41,6 @@ end
end module
subroutine bar
- !$omp masked filter (0) filter (0) ! { dg-error "27: Failed to match clause" }
+ !$omp masked filter (0) filter (0) ! { dg-error "Duplicated 'filter' clause" }
call foobar
end
diff --git a/libgomp/testsuite/libgomp.fortran/taskloop-4-a.f90 b/libgomp/testsuite/libgomp.fortran/taskloop-4-a.f90
new file mode 100644
index 00000000000..2049f5c8bca
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/taskloop-4-a.f90
@@ -0,0 +1,86 @@
+! { dg-do compile { target skip-all-targets } }
+! Only used by taskloop-4.f90
+! To avoid inlining
+
+module m2
+ use m_taskloop4
+ implicit none (external, type)
+contains
+
+subroutine grainsize (a, b, c, d)
+ integer, value :: a, b, c, d
+ integer :: i, j, k
+ j = 0
+ k = 0
+ !$omp taskloop firstprivate (j, k) grainsize(d)
+ do i = a, b - 1, c
+ if (j == 0) then
+ !$omp atomic capture
+ k = v
+ v = v + 1
+ !$omp end atomic
+ if (k >= 64) &
+ stop 1
+ end if
+ j = j + 1
+ u(k) = j
+ end do
+end
+
+subroutine num_tasks (a, b, c, d)
+ integer, value :: a, b, c, d
+ integer :: i, j, k
+ j = 0
+ k = 0
+ !$omp taskloop firstprivate (j, k) num_tasks(d)
+ do i = a, b - 1, c
+ if (j == 0) then
+ !$omp atomic capture
+ k = v
+ v = v + 1
+ !$omp end atomic
+ if (k >= 64) &
+ stop 2
+ end if
+ j = j + 1
+ u(k) = j
+ end do
+ end
+end module
+
+program main
+ use m2
+ implicit none (external, type)
+ !$omp parallel
+ !$omp single
+ block
+ integer :: min_iters, max_iters, ntasks
+
+ ! If grainsize is present, # of task loop iters is >= grainsize && < 2 * grainsize,
+ ! unless # of loop iterations is smaller than grainsize.
+ if (test (0, 79, 1, 17, grainsize, ntasks, min_iters, max_iters) /= 79) &
+ stop 3
+ if (min_iters < 17 .or. max_iters >= 17 * 2) &
+ stop 4
+ if (test (-49, 2541, 7, 28, grainsize, ntasks, min_iters, max_iters) /= 370) &
+ stop 5
+ if (min_iters < 28 .or. max_iters >= 28 * 2) &
+ stop 6
+ if (test (7, 21, 2, 15, grainsize, ntasks, min_iters, max_iters) /= 7) &
+ stop 7
+ if (ntasks /= 1 .or. min_iters /= 7 .or. max_iters /= 7) &
+ stop 8
+ ! If num_tasks is present, # of tasks is min (# of loop iters, num_tasks)
+ ! and each task has at least one iteration.
+ if (test (-51, 2500, 48, 9, num_tasks, ntasks, min_iters, max_iters) /= 54) &
+ stop 9
+ if (ntasks /= 9) &
+ stop 10
+ if (test (0, 25, 2, 17, num_tasks, ntasks, min_iters, max_iters) /= 13) &
+ stop 11
+ if (ntasks /= 13) &
+ stop 12
+ end block
+ !$omp end single
+ !$omp end parallel
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/taskloop-4.f90 b/libgomp/testsuite/libgomp.fortran/taskloop-4.f90
new file mode 100644
index 00000000000..a90fd0b6653
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/taskloop-4.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+! { dg-options "-O2" }
+! { dg-additional-sources taskloop-4-a.f90 }
+
+module m_taskloop4
+ implicit none (type, external)
+ integer :: v, u(0:63)
+
+contains
+integer function test (a, b, c, d, fn, num_tasks, min_iters, max_iters)
+ integer, value :: a, b, c, d
+ interface
+ subroutine fn (n1, n2, n3, n4)
+ integer, value :: n1, n2, n3, n4
+ end
+ end interface
+ integer :: num_tasks, min_iters, max_iters
+ integer :: i, t
+
+ t = 0
+ u = 0
+ v = 0
+ call fn (a, b, c, d)
+ min_iters = 0
+ max_iters = 0
+ num_tasks = v
+ if (v /= 0) then
+ min_iters = u(0)
+ max_iters = u(0)
+ t = u(0)
+ do i = 1, v - 1
+ if (min_iters > u(i)) &
+ min_iters = u(i)
+ if (max_iters < u(i)) &
+ max_iters = u(i)
+ t = t + u(i)
+ end do
+ end if
+ test = t
+end
+end module
diff --git a/libgomp/testsuite/libgomp.fortran/taskloop-5-a.f90 b/libgomp/testsuite/libgomp.fortran/taskloop-5-a.f90
new file mode 100644
index 00000000000..f12681baafa
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/taskloop-5-a.f90
@@ -0,0 +1,95 @@
+! { dg-do compile { target skip-all-targets } }
+! Only used by taskloop-5-a.f90
+! To avoid inlining
+
+module m2
+ use m_taskloop5
+ implicit none (external, type)
+contains
+
+subroutine grainsize (a, b, c, d)
+ integer, value :: a, b, c, d
+ integer :: i, j, k
+ j = 0
+ k = 0
+ !$omp taskloop firstprivate (j, k) grainsize(strict:d)
+ do i = a, b - 1, c
+ if (j == 0) then
+ !$omp atomic capture
+ k = v
+ v = v + 1
+ !$omp end atomic
+ if (k >= 64) &
+ stop 3
+ w(k) = i
+ end if
+ j = j + 1
+ u(k) = j
+ end do
+end
+
+subroutine num_tasks (a, b, c, d)
+ integer, value :: a, b, c, d
+ integer :: i, j, k
+ j = 0
+ k = 0
+ !$omp taskloop firstprivate (j, k) num_tasks(strict:d)
+ do i = a, b - 1, c
+ if (j == 0) then
+ !$omp atomic capture
+ k = v
+ v = v + 1
+ !$omp end atomic
+ if (k >= 64) &
+ stop 4
+ w(k) = i
+ end if
+ j = j + 1
+ u(k) = j
+ end do
+end
+end module
+
+program main
+ use m2
+ implicit none (external, type)
+ !$omp parallel
+ !$omp single
+ block
+ integer :: min_iters, max_iters, ntasks, sep
+
+ ! If grainsize is present and has strict modifier, # of task loop iters is == grainsize,
+ ! except that it can be smaller on the last task.
+ if (test (0, 79, 1, 17, grainsize, ntasks, min_iters, max_iters, sep) /= 79) &
+ stop 5
+ if (ntasks /= 5 .or. min_iters /= 11 .or. max_iters /= 17 .or. sep /= 4) &
+ stop
+ if (test (-49, 2541, 7, 28, grainsize, ntasks, min_iters, max_iters, sep) /= 370) &
+ stop 6
+ if (ntasks /= 14 .or. min_iters /= 6 .or. max_iters /= 28 .or. sep /= 13) &
+ stop
+ if (test (7, 21, 2, 15, grainsize, ntasks, min_iters, max_iters, sep) /= 7) &
+ stop 7
+ if (ntasks /= 1 .or. min_iters /= 7 .or. max_iters /= 7 .or. sep /= 1) &
+ stop 8
+ ! If num_tasks is present, # of tasks is min (# of loop iters, num_tasks)
+ ! and each task has at least one iteration. If strict modifier is present,
+ ! first set of tasks has ceil (# of loop iters / num_tasks) iterations,
+ ! followed by possibly empty set of tasks with floor (# of loop iters / num_tasks)
+ ! iterations.
+ if (test (-51, 2500, 48, 9, num_tasks, ntasks, min_iters, max_iters, sep) /= 54) &
+ stop 9
+ if (ntasks /= 9 .or. min_iters /= 6 .or. max_iters /= 6 .or. sep /= 9) &
+ stop 10
+ if (test (0, 57, 1, 9, num_tasks, ntasks, min_iters, max_iters, sep) /= 57) &
+ stop 11
+ if (ntasks /= 9 .or. min_iters /= 6 .or. max_iters /= 7 .or. sep /= 3) &
+ stop 12
+ if (test (0, 25, 2, 17, num_tasks, ntasks, min_iters, max_iters, sep) /= 13) &
+ stop 13
+ if (ntasks /= 13 .or. min_iters /= 1 .or. max_iters /= 1 .or. sep /= 13) &
+ stop 14
+ end block
+ !$omp end single
+ !$omp end parallel
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/taskloop-5.f90 b/libgomp/testsuite/libgomp.fortran/taskloop-5.f90
new file mode 100644
index 00000000000..0dd443a4c97
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/taskloop-5.f90
@@ -0,0 +1,75 @@
+! { dg-do run }
+! { dg-options "-O2" }
+! { dg-additional-sources taskloop-5-a.f90 }
+
+module m_taskloop5
+ implicit none (type, external)
+ integer :: u(0:63), v, w(0:63)
+
+contains
+integer function test (a, b, c, d, fn, num_tasks, min_iters, max_iters, sep)
+ integer, value :: a, b, c, d
+ interface
+ subroutine fn (n1, n2, n3, n4)
+ integer, value :: n1, n2, n3, n4
+ end
+ end interface
+ integer :: num_tasks, min_iters, max_iters, sep
+ integer :: i, j, t
+
+ t = 0
+ u = 0
+ v = 0
+ call fn (a, b, c, d)
+ min_iters = 0
+ max_iters = 0
+ num_tasks = v
+ sep = v
+ if (v /= 0) then
+ min_iters = u(0)
+ max_iters = u(0)
+ t = u(0)
+ do i = 1, v - 1
+ if (min_iters > u(i)) &
+ min_iters = u(i)
+ if (max_iters < u(i)) &
+ max_iters = u(i)
+ t = t + u(i)
+ end do
+
+ if (min_iters /= max_iters) then
+ do i = 0, v - 2
+ block
+ integer :: min_idx
+ min_idx = i
+ do j = i + 1, v - 1
+ if (w(min_idx) > w(j)) &
+ min_idx = j
+ end do
+ if (min_idx /= i) then
+ block
+ integer tem
+ tem = u(i)
+ u(i) = u(min_idx)
+ u(min_idx) = tem
+ tem = w(i)
+ w(i) = w(min_idx)
+ w(min_idx) = tem
+ end block
+ end if
+ end block
+ end do
+ if (u(0) /= max_iters) &
+ stop 1
+ do i = 1, v - 1
+ if (u(i) /= u(i - 1)) then
+ if (sep /= v .or. u(i) /= min_iters) &
+ stop 2
+ sep = i;
+ end if
+ end do
+ end if
+ end if
+ test = t
+end
+end module
