public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* [PATCH, stage 1] Fortran: Add support for OMP non-rectangular loops
@ 2022-03-26  2:03 Sandra Loosemore
  2022-05-04 12:33 ` Jakub Jelinek
  0 siblings, 1 reply; 2+ messages in thread
From: Sandra Loosemore @ 2022-03-26  2:03 UTC (permalink / raw)
  To: fortran; +Cc: gcc-patches

[-- Attachment #1: Type: text/plain, Size: 370 bytes --]

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

[-- Attachment #2: nonrectangular.patch --]
[-- Type: text/x-patch, Size: 24700 bytes --]

commit c46a79a9841b90fb0cde564e4147932290d91832
Author: Sandra Loosemore <sandra@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

^ permalink raw reply	[flat|nested] 2+ messages in thread

* Re: [PATCH, stage 1] Fortran: Add support for OMP non-rectangular loops
  2022-03-26  2:03 [PATCH, stage 1] Fortran: Add support for OMP non-rectangular loops Sandra Loosemore
@ 2022-05-04 12:33 ` Jakub Jelinek
  0 siblings, 0 replies; 2+ messages in thread
From: Jakub Jelinek @ 2022-05-04 12:33 UTC (permalink / raw)
  To: Sandra Loosemore; +Cc: fortran, gcc-patches

On Fri, Mar 25, 2022 at 08:03:38PM -0600, Sandra Loosemore wrote:
>     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.
> 
> --- 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"));

Please drop the superfluous ()s around the argument, just use
		      "...", lang_GNU_Fortran () ? "do" : "for");

Ok for trunk with that nit fixed.  And thanks for discovering the missing
grainsize/num_tasks checks.

	Jakub


^ permalink raw reply	[flat|nested] 2+ messages in thread

end of thread, other threads:[~2022-05-04 12:33 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-03-26  2:03 [PATCH, stage 1] Fortran: Add support for OMP non-rectangular loops Sandra Loosemore
2022-05-04 12:33 ` Jakub Jelinek

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).