This patch adds Fortran support for OMP 5.1 "canonical loop nest form"
and non-rectangular loops. The C/C++ and middle-end support is already
present except for some missing constraint checks in the gimplifier,
which I've added here. There's still a TODO with respect to the
not-yet-implemented TILE construct.
Is this OK for stage 1 when the time comes?
-Sandra
commit c46a79a9841b90fb0cde564e4147932290d91832
Author: Sandra Loosemore <san...@codesourcery.com>
Date: Fri Mar 25 14:14:37 2022 -0700
Fortran: Add support for OMP non-rectangular loops.
This patch adds support for OMP 5.1 "canonical loop nest form" to the
Fortran front end, marks non-rectangular loops for processing
by the middle end, and implements missing checks in the gimplifier
for additional prohibitions on non-rectangular loops.
Note that the OMP spec also prohibits non-rectangular loops with the TILE
construct; that construct hasn't been implemented yet, so that error will
need to be filled in later.
gcc/fortran/
* gfortran.h (struct gfc_omp_clauses): Add non_rectangular bit.
* openmp.cc (is_outer_iteration_variable): New function.
(expr_is_invariant): New function.
(bound_expr_is_canonical): New function.
(resolve_omp_do): Replace existing non-rectangularity error with
check for canonical form and setting non_rectangular bit.
* trans-openmp.cc (gfc_trans_omp_do): Transfer non_rectangular
flag to generated tree structure.
gcc/
* gimplify.cc (gimplify_omp_for): Update messages for SCHEDULED
and ORDERED clause conflict errors. Add check for GRAINSIZE and
NUM_TASKS on TASKLOOP.
gcc/testsuite/
* c-c++-common/gomp/loop-6.c (f3): New function to test TASKLOOP
diagnostics.
* gfortran.dg/gomp/collapse1.f90: Update expected messages.
* gfortran.dg/gomp/pr85313.f90: Remove dg-error on non-rectangular
loops that are now accepted.
* gfortran.dg/gomp/non-rectangular-loop.f90: New file.
* gfortran.dg/gomp/canonical-loop-1.f90: New file.
* gfortran.dg/gomp/canonical-loop-2.f90: New file.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 7bf1d5a..1bce283 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1533,6 +1533,7 @@ typedef struct gfc_omp_clauses
unsigned simd:1, threads:1, depend_source:1, destroy:1, order_concurrent:1;
unsigned order_unconstrained:1, order_reproducible:1, capture:1;
unsigned grainsize_strict:1, num_tasks_strict:1, compare:1, weak:1;
+ unsigned non_rectangular: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 7141481..4d3fcc8 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -8446,6 +8446,105 @@ gfc_resolve_omp_local_vars (gfc_namespace *ns)
gfc_traverse_ns (ns, handle_local_var);
}
+/* CODE is an OMP loop construct. Return true if VAR matches an iteration
+ variable outer to level DEPTH. */
+static bool
+is_outer_iteration_variable (gfc_code *code, int depth, gfc_symbol *var)
+{
+ int i;
+ gfc_code *do_code = code->block->next;
+
+ for (i = 1; i < depth; i++)
+ {
+ gfc_symbol *ivar = do_code->ext.iterator->var->symtree->n.sym;
+ if (var == ivar)
+ return true;
+ do_code = do_code->block->next;
+ }
+ return false;
+}
+
+/* CODE is an OMP loop construct. Return true if EXPR does not reference
+ any iteration variables outer to level DEPTH. */
+static bool
+expr_is_invariant (gfc_code *code, int depth, gfc_expr *expr)
+{
+ int i;
+ gfc_code *do_code = code->block->next;
+
+ for (i = 1; i < depth; i++)
+ {
+ gfc_symbol *ivar = do_code->ext.iterator->var->symtree->n.sym;
+ if (gfc_find_sym_in_expr (ivar, expr))
+ return false;
+ do_code = do_code->block->next;
+ }
+ return true;
+}
+
+/* CODE is an OMP loop construct. Return true if EXPR matches one of the
+ canonical forms for a bound expression. It may include references to
+ an iteration variable outer to level DEPTH; set OUTER_VARP if so. */
+static bool
+bound_expr_is_canonical (gfc_code *code, int depth, gfc_expr *expr,
+ gfc_symbol **outer_varp)
+{
+ gfc_expr *expr2 = NULL;
+
+ /* Rectangular case. */
+ if (depth == 0 || expr_is_invariant (code, depth, expr))
+ return true;
+
+ /* Any simple variable that didn't pass expr_is_invariant must be
+ an outer_var. */
+ if (expr->expr_type == EXPR_VARIABLE && expr->rank == 0)
+ {
+ *outer_varp = expr->symtree->n.sym;
+ return true;
+ }
+
+ /* All other permitted forms are binary operators. */
+ if (expr->expr_type != EXPR_OP)
+ return false;
+
+ /* Check for plus/minus a loop invariant expr. */
+ if (expr->value.op.op == INTRINSIC_PLUS
+ || expr->value.op.op == INTRINSIC_MINUS)
+ {
+ if (expr_is_invariant (code, depth, expr->value.op.op1))
+ expr2 = expr->value.op.op2;
+ else if (expr_is_invariant (code, depth, expr->value.op.op2))
+ expr2 = expr->value.op.op1;
+ else
+ return false;
+ }
+ else
+ expr2 = expr;
+
+ /* Check for a product with a loop-invariant expr. */
+ if (expr2->expr_type == EXPR_OP
+ && expr2->value.op.op == INTRINSIC_TIMES)
+ {
+ if (expr_is_invariant (code, depth, expr2->value.op.op1))
+ expr2 = expr2->value.op.op2;
+ else if (expr_is_invariant (code, depth, expr2->value.op.op2))
+ expr2 = expr2->value.op.op1;
+ else
+ return false;
+ }
+
+ /* What's left must be a reference to an outer loop variable. */
+ if (expr2->expr_type == EXPR_VARIABLE
+ && expr2->rank == 0
+ && is_outer_iteration_variable (code, depth, expr2->symtree->n.sym))
+ {
+ *outer_varp = expr2->symtree->n.sym;
+ return true;
+ }
+
+ return false;
+}
+
static void
resolve_omp_do (gfc_code *code)
{
@@ -8564,8 +8663,15 @@ resolve_omp_do (gfc_code *code)
if (collapse <= 0)
collapse = 1;
}
+
+ /* While the spec defines the loop nest depth independently of the COLLAPSE
+ clause, in practice the middle end only pays attention to the COLLAPSE
+ depth and treats any further inner loops as the final-loop-body. So
+ here we also check canonical loop nest form only for the number of
+ outer loops specified by the COLLAPSE clause too. */
for (i = 1; i <= collapse; i++)
{
+ gfc_symbol *start_var = NULL, *end_var = NULL;
if (do_code->op == EXEC_DO_WHILE)
{
gfc_error ("%s cannot be a DO WHILE or DO without loop control "
@@ -8606,26 +8712,43 @@ resolve_omp_do (gfc_code *code)
"LINEAR at %L", name, &do_code->loc);
break;
}
- if (i > 1)
+ if (is_outer_iteration_variable (code, i, dovar))
{
- gfc_code *do_code2 = code->block->next;
- int j;
-
- for (j = 1; j < i; j++)
- {
- gfc_symbol *ivar = do_code2->ext.iterator->var->symtree->n.sym;
- if (dovar == ivar
- || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->start)
- || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->end)
- || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->step))
- {
- gfc_error ("%s collapsed loops don't form rectangular "
- "iteration space at %L", name, &do_code->loc);
- break;
- }
- do_code2 = do_code2->block->next;
- }
+ gfc_error ("%s iteration variable used in more than one loop at %L",
+ name, &do_code->loc);
+ break;
}
+ else if (!bound_expr_is_canonical (code, i,
+ do_code->ext.iterator->start,
+ &start_var))
+ {
+ gfc_error ("%s loop start expression not in canonical form at %L",
+ name, &do_code->loc);
+ break;
+ }
+ else if (!bound_expr_is_canonical (code, i,
+ do_code->ext.iterator->end,
+ &end_var))
+ {
+ gfc_error ("%s loop end expression not in canonical form at %L",
+ name, &do_code->loc);
+ break;
+ }
+ else if (start_var && end_var && start_var != end_var)
+ {
+ gfc_error ("%s loop bounds reference different "
+ "iteration variables at %L", name, &do_code->loc);
+ break;
+ }
+ else if (!expr_is_invariant (code, i, do_code->ext.iterator->step))
+ {
+ gfc_error ("%s loop increment not in canonical form at %L",
+ name, &do_code->loc);
+ break;
+ }
+ if (start_var || end_var)
+ code->ext.omp_clauses->non_rectangular = 1;
+
for (c = do_code->next; c; c = c->next)
if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE)
{
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index ba3ff71..b2546b3 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -5409,6 +5409,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
OMP_FOR_INCR (stmt) = incr;
if (orig_decls)
OMP_FOR_ORIG_DECLS (stmt) = orig_decls;
+ OMP_FOR_NON_RECTANGULAR (stmt) = clauses->non_rectangular;
gfc_add_expr_to_block (&block, stmt);
vec_free (doacross_steps);
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index f62f150..5c8a39f 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -12468,11 +12468,11 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p)
OMP_CLAUSE_SCHEDULE))
error_at (EXPR_LOCATION (for_stmt),
"%qs clause may not appear on non-rectangular %qs",
- "schedule", "for");
+ "schedule", (lang_GNU_Fortran () ? "do" : "for"));
if (omp_find_clause (OMP_FOR_CLAUSES (for_stmt), OMP_CLAUSE_ORDERED))
error_at (EXPR_LOCATION (for_stmt),
"%qs clause may not appear on non-rectangular %qs",
- "ordered", "for");
+ "ordered", (lang_GNU_Fortran () ? "do" : "for"));
}
break;
case OMP_DISTRIBUTE:
@@ -12487,6 +12487,19 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p)
ort = ORT_ACC;
break;
case OMP_TASKLOOP:
+ if (OMP_FOR_NON_RECTANGULAR (inner_for_stmt ? inner_for_stmt : for_stmt))
+ {
+ if (omp_find_clause (OMP_FOR_CLAUSES (for_stmt),
+ OMP_CLAUSE_GRAINSIZE))
+ error_at (EXPR_LOCATION (for_stmt),
+ "%qs clause may not appear on non-rectangular %qs",
+ "grainsize", "taskloop");
+ if (omp_find_clause (OMP_FOR_CLAUSES (for_stmt),
+ OMP_CLAUSE_NUM_TASKS))
+ error_at (EXPR_LOCATION (for_stmt),
+ "%qs clause may not appear on non-rectangular %qs",
+ "num_tasks", "taskloop");
+ }
if (omp_find_clause (OMP_FOR_CLAUSES (for_stmt), OMP_CLAUSE_UNTIED))
ort = ORT_UNTIED_TASKLOOP;
else
diff --git a/gcc/testsuite/c-c++-common/gomp/loop-6.c b/gcc/testsuite/c-c++-common/gomp/loop-6.c
index 0d4474d..24383ff 100644
--- a/gcc/testsuite/c-c++-common/gomp/loop-6.c
+++ b/gcc/testsuite/c-c++-common/gomp/loop-6.c
@@ -111,3 +111,17 @@ f2 (void)
for (j = i; j < 64; j++)
;
}
+
+void
+f3 (void)
+{
+ int i = 0, j = 0;
+ #pragma omp taskloop collapse(2) grainsize(4) /* { dg-error "'grainsize' clause may not appear on non-rectangular 'taskloop'" } */
+ for (i = 0; i < 64; i++)
+ for (j = i; j < 64; j++)
+ ;
+ #pragma omp taskloop collapse(2) num_tasks(4) /* { dg-error "'num_tasks' clause may not appear on non-rectangular 'taskloop'" } */
+ for (i = 0; i < 64; i++)
+ for (j = i; j < 64; j++)
+ ;
+}
diff --git a/gcc/testsuite/gfortran.dg/gomp/canonical-loop-1.f90 b/gcc/testsuite/gfortran.dg/gomp/canonical-loop-1.f90
new file mode 100644
index 0000000..c3de8c96
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/canonical-loop-1.f90
@@ -0,0 +1,224 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+! Test that all specified forms of canonical loop bounds are accepted,
+! including non-rectangular loops.
+
+subroutine s1 (a1, a2)
+ integer :: a1, a2
+ integer :: i, j
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = a2, 16
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = i + a2, 16
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = a2 + i, 16
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = i - a2, 16
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = a2 - i, 16
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = a1 * i, 16
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = a1 * i + a2, 16
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = a2 + a1 * i , 16
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = a1 * i - a2, 16
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = a2 - a1 * i, 16
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = i * a1, 16
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = i * a1 + a2, 16
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = a2 + i * a1, 16
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = i * a1 - a2, 16
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = a2 - i * a1, 16
+ end do
+ end do
+
+end subroutine
+
+
+subroutine s2 (a1, a2)
+ integer :: a1, a2
+ integer :: i, j
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, a2
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, i
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, i + a2
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, a2 + i
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, i - a2
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, a2 - i
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, a1 * i
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, a1 * i + a2
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, a2 + a1 * i
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, a1 * i - a2
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, a2 - a1 * i
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, i * a1
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, i * a1 + a2
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, a2 + i * a1
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, i * a1 - a2
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, a2 - i * a1
+ end do
+ end do
+
+end subroutine
+
+subroutine s3 (a1, a2)
+ integer :: a1, a2
+ integer :: i, j, k
+
+ !$omp do collapse(3)
+ do i = 1, 16
+ do j = 1, i
+ do k = j, 16
+ end do
+ end do
+ end do
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/canonical-loop-2.f90 b/gcc/testsuite/gfortran.dg/gomp/canonical-loop-2.f90
new file mode 100644
index 0000000..7df006a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/canonical-loop-2.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+! Test that various non-canonical loops are rejected with a diagnostic.
+
+subroutine s1 (a1, a2)
+ integer :: a1, a2
+ integer :: i, j
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = i * i, 16 ! { dg-error "not in canonical form" }
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = MAX (i, 8), 16 ! { dg-error "not in canonical form" }
+ end do
+ end do
+
+ !$omp do collapse(2)
+ do i = 1, 16
+ do j = 1, 16, i ! { dg-error "not in canonical form" }
+ end do
+ end do
+
+ !$omp do collapse(3)
+ do i = 1, 16
+ do j = 1, 16
+ do k = i, j ! { dg-error "reference different iteration variables" }
+ end do
+ end do
+ end do
+
+ !$omp do collapse(3)
+ do i = 1, 16
+ do j = 1, 16
+ do k = 1, i + j ! { dg-error "not in canonical form" }
+ end do
+ end do
+ end do
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
index 01cfc82..77b2bdd 100644
--- a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
@@ -19,7 +19,7 @@ subroutine collapse1
end do
!$omp parallel do collapse(2)
do i = 1, 5, 2
- do j = i + 1, 7, i ! { dg-error "collapsed loops don.t form rectangular iteration space" }
+ do j = i + 1, 7, i ! { dg-error "loop increment not in canonical form" }
end do
end do
!$omp parallel do collapse(2) shared(j)
@@ -49,7 +49,7 @@ subroutine collapse1_2
integer :: i
!$omp parallel do collapse(2)
do i = -6, 6 ! { dg-error "cannot be redefined inside loop beginning" }
- do i = 4, 6 ! { dg-error "collapsed loops don.t form rectangular iteration space|cannot be redefined" }
+ do i = 4, 6 ! { dg-error "iteration variable used in more than one loop|cannot be redefined" }
end do
end do
end subroutine collapse1_2
diff --git a/gcc/testsuite/gfortran.dg/gomp/non-rectangular-loop.f90 b/gcc/testsuite/gfortran.dg/gomp/non-rectangular-loop.f90
new file mode 100644
index 0000000..a7f41cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/non-rectangular-loop.f90
@@ -0,0 +1,227 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+! Test that errors are given for cases where there are constraints
+! disallowing nonrectangular loops.
+
+! Work-sharing loop disallows "schedule" and "ordered" clauses.
+
+subroutine s1 (a1, a2)
+ integer :: a1, a2
+ integer :: i, j
+
+ !$omp do collapse(2) schedule(static) ! { dg-error "'schedule' clause may not appear on non-rectangular 'do'" }
+ do i = 1, 16
+ do j = 1, i
+ end do
+ end do
+
+ !$omp do collapse(2) schedule(static) ! { dg-error "'schedule' clause may not appear on non-rectangular 'do'" }
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+ !$omp do collapse(2) ordered ! { dg-error "'ordered' clause may not appear on non-rectangular 'do'" }
+ do i = 1, 16
+ do j = 1, i
+ end do
+ end do
+
+ !$omp do collapse(2) ordered ! { dg-error "'ordered' clause may not appear on non-rectangular 'do'" }
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+ ! Derived constructs
+
+ !$omp do simd collapse(2) schedule(static) ! { dg-error "'schedule' clause may not appear on non-rectangular 'do'" }
+ do i = 1, 16
+ do j = 1, i
+ end do
+ end do
+
+ !$omp parallel do collapse(2) schedule(static) ! { dg-error "'schedule' clause may not appear on non-rectangular 'do'" }
+ do i = 1, 16
+ do j = 1, i
+ end do
+ end do
+
+ !$omp parallel do simd collapse(2) schedule(static) ! { dg-error "'schedule' clause may not appear on non-rectangular 'do'" }
+ do i = 1, 16
+ do j = 1, i
+ end do
+ end do
+
+ !$omp target parallel do collapse(2) schedule(static) ! { dg-error "'schedule' clause may not appear on non-rectangular 'do'" }
+ do i = 1, 16
+ do j = 1, i
+ end do
+ end do
+
+ !$omp target parallel do collapse(2) schedule(static) ! { dg-error "'schedule' clause may not appear on non-rectangular 'do'" }
+ do i = 1, 16
+ do j = 1, i
+ end do
+ end do
+
+end subroutine
+
+
+! Distribute construct disallows "dist_schedule" clause.
+
+subroutine s2 (a1, a2)
+ integer :: a1, a2
+ integer :: i, j
+
+ !$omp distribute collapse(2) dist_schedule(static) ! { dg-error "'dist_schedule' clause may not appear on non-rectangular 'distribute'" }
+ do i = 1, 16
+ do j = 1, i
+ end do
+ end do
+
+ !$omp distribute collapse(2) dist_schedule(static) ! { dg-error "'dist_schedule' clause may not appear on non-rectangular 'distribute'" }
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+ ! Derived constructs
+
+ !$omp distribute simd collapse(2) dist_schedule(static) ! { dg-error "'dist_schedule' clause may not appear on non-rectangular 'distribute'" }
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+ !$omp distribute parallel do collapse(2) dist_schedule(static) ! { dg-error "'dist_schedule' clause may not appear on non-rectangular 'distribute'" }
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+ !$omp distribute parallel do simd collapse(2) dist_schedule(static) ! { dg-error "'dist_schedule' clause may not appear on non-rectangular 'distribute'" }
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+ !$omp teams distribute collapse(2) dist_schedule(static) ! { dg-error "'dist_schedule' clause may not appear on non-rectangular 'distribute'" }
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+ !$omp teams distribute simd collapse(2) dist_schedule(static) ! { dg-error "'dist_schedule' clause may not appear on non-rectangular 'distribute'" }
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+ !$omp teams distribute parallel do collapse(2) dist_schedule(static) ! { dg-error "'dist_schedule' clause may not appear on non-rectangular 'distribute'" }
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+ !$omp teams distribute parallel do simd collapse(2) dist_schedule(static) ! { dg-error "'dist_schedule' clause may not appear on non-rectangular 'distribute'" }
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+ !$omp target teams distribute collapse(2) dist_schedule(static) ! { dg-error "'dist_schedule' clause may not appear on non-rectangular 'distribute'" }
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+ !$omp target teams distribute simd collapse(2) dist_schedule(static) ! { dg-error "'dist_schedule' clause may not appear on non-rectangular 'distribute'" }
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+ !$omp target teams distribute parallel do collapse(2) dist_schedule(static) ! { dg-error "'dist_schedule' clause may not appear on non-rectangular 'distribute'" }
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+ !$omp target teams distribute parallel do simd collapse(2) dist_schedule(static) ! { dg-error "'dist_schedule' clause may not appear on non-rectangular 'distribute'" }
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+end subroutine
+
+! Taskloop construct disallows "grainsize" and "num_tasks" clauses.
+
+subroutine s3 (a1, a2)
+ integer :: a1, a2
+ integer :: i, j
+
+ !$omp taskloop collapse(2) grainsize(4) ! { dg-error "'grainsize' clause may not appear on non-rectangular 'taskloop'" }
+ do i = 1, 16
+ do j = 1, i
+ end do
+ end do
+
+ !$omp taskloop collapse(2) grainsize(4) ! { dg-error "'grainsize' clause may not appear on non-rectangular 'taskloop'" }
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+ !$omp taskloop collapse(2) num_tasks(4) ! { dg-error "'num_tasks' clause may not appear on non-rectangular 'taskloop'" }
+ do i = 1, 16
+ do j = 1, i
+ end do
+ end do
+
+ !$omp taskloop collapse(2) num_tasks(4) ! { dg-error "'num_tasks' clause may not appear on non-rectangular 'taskloop'" }
+ do i = 1, 16
+ do j = i, 16
+ end do
+ end do
+
+ ! Derived constructs
+
+ !$omp taskloop simd collapse(2) grainsize(4) ! { dg-error "'grainsize' clause may not appear on non-rectangular 'taskloop'" }
+ do i = 1, 16
+ do j = 1, i
+ end do
+ end do
+
+ !$omp masked taskloop collapse(2) grainsize(4) ! { dg-error "'grainsize' clause may not appear on non-rectangular 'taskloop'" }
+ do i = 1, 16
+ do j = 1, i
+ end do
+ end do
+
+ !$omp masked taskloop simd collapse(2) grainsize(4) ! { dg-error "'grainsize' clause may not appear on non-rectangular 'taskloop'" }
+ do i = 1, 16
+ do j = 1, i
+ end do
+ end do
+
+ !$omp parallel masked taskloop collapse(2) grainsize(4) ! { dg-error "'grainsize' clause may not appear on non-rectangular 'taskloop'" }
+ do i = 1, 16
+ do j = 1, i
+ end do
+ end do
+
+ !$omp parallel masked taskloop simd collapse(2) grainsize(4) ! { dg-error "'grainsize' clause may not appear on non-rectangular 'taskloop'" }
+ do i = 1, 16
+ do j = 1, i
+ end do
+ end do
+
+end subroutine
+
+! TODO: not yet implemented
+! The tile construct disallows all non-rectangular loops.
+
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr85313.f90 b/gcc/testsuite/gfortran.dg/gomp/pr85313.f90
index 0459984..e0401a5 100644
--- a/gcc/testsuite/gfortran.dg/gomp/pr85313.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/pr85313.f90
@@ -3,7 +3,7 @@
!$omp do collapse(3)
do i = 1, 10
- do j = i, 20 ! { dg-error "form rectangular iteration space" }
+ do j = i, 20
do k = 1, 2
end do
end do
@@ -11,14 +11,14 @@
!$omp do collapse(3)
do i = 1, 10
do j = 1, 5
- do k = i, 20 ! { dg-error "form rectangular iteration space" }
+ do k = i, 20
end do
end do
end do
!$omp do collapse(3)
do i = 1, 10
do j = 1, 5
- do k = j, 20 ! { dg-error "form rectangular iteration space" }
+ do k = j, 20
end do
end do
end do
