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;
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)
{
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 "
"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)
{
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);
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:
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
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++)
+ ;
+}
--- /dev/null
+! { 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
--- /dev/null
+! { 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
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)
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
--- /dev/null
+! { 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.
+
+
!$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
!$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
projects / thirdparty / gcc.git / commitdiff
