public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/omp/gcc-12] Fortran: Add support for OMP non-rectangular loops.
@ 2022-06-29 14:47 Kwok Yeung
  0 siblings, 0 replies; only message in thread
From: Kwok Yeung @ 2022-06-29 14:47 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:aec89cc4c8051e11c74c2fd79e79f514a2a66577

commit aec89cc4c8051e11c74c2fd79e79f514a2a66577
Author: Sandra Loosemore <sandra@codesourcery.com>
Date:   Thu May 5 11:37:16 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.
    
    (cherry picked from commit 705bcedf6eae2d7c68bd3df2c98dad4f06650fde)

Diff:
---
 gcc/ChangeLog.omp                                  |   9 +
 gcc/fortran/ChangeLog.omp                          |  14 ++
 gcc/fortran/gfortran.h                             |   1 +
 gcc/fortran/openmp.cc                              | 159 +++++++++++++--
 gcc/fortran/trans-openmp.cc                        |   1 +
 gcc/gimplify.cc                                    |  17 +-
 gcc/testsuite/ChangeLog.omp                        |  14 ++
 gcc/testsuite/c-c++-common/gomp/loop-6.c           |  14 ++
 .../gfortran.dg/gomp/canonical-loop-1.f90          | 224 ++++++++++++++++++++
 .../gfortran.dg/gomp/canonical-loop-2.f90          |  44 ++++
 gcc/testsuite/gfortran.dg/gomp/collapse1.f90       |   4 +-
 .../gfortran.dg/gomp/non-rectangular-loop.f90      | 227 +++++++++++++++++++++
 gcc/testsuite/gfortran.dg/gomp/pr85313.f90         |   6 +-
 13 files changed, 709 insertions(+), 25 deletions(-)

diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index 916f4a896b5..ac8455b6a3e 100644
--- a/gcc/ChangeLog.omp
+++ b/gcc/ChangeLog.omp
@@ -1,3 +1,12 @@
+2022-05-05  Sandra Loosemore  <sandra@codesourcery.com>
+
+	Backport from mainline:
+	2022-05-05  Sandra Loosemore  <sandra@codesourcery.com>
+
+	* gimplify.cc (gimplify_omp_for): Update messages for SCHEDULED
+	and ORDERED clause conflict errors.  Add check for GRAINSIZE and
+	NUM_TASKS on TASKLOOP.
+
 2022-05-02  Marcel Vollweiler  <marcel@codesourcery.com>
 
 	Backport from mainline:
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 31a71943e96..ec748026a73 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,17 @@
+2022-05-05  Sandra Loosemore  <sandra@codesourcery.com>
+
+	Backport from mainline:
+	2022-05-05  Sandra Loosemore  <sandra@codesourcery.com>
+
+	* 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.
+
 2022-03-24  Sandra Loosemore  <sandra@codesourcery.com>
 
 	Backport from mainline:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index f9f6b7baae5..3c4219d69a5 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1540,6 +1540,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 dcd828c8e59..b6f070bc876 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -9224,6 +9224,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)
 {
@@ -9342,8 +9441,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 "
@@ -9384,26 +9490,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 969f2a19f24..3e756a02d01 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -6985,6 +6985,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 9734e8ccca6..f1df08c9936 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -13253,11 +13253,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:
@@ -13272,6 +13272,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/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index a5fb514f01c..95d966fd7dc 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,17 @@
+2022-05-05  Sandra Loosemore <sandra@codesourcery.com>
+
+	Backport from mainline:
+	2022-05-05  Sandra Loosemore <sandra@codesourcery.com>
+
+	* 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.
+
 2022-06-17  Chung-Lin Tang  <cltang@codesourcery.com>
 
 	Backport from mainline:
diff --git a/gcc/testsuite/c-c++-common/gomp/loop-6.c b/gcc/testsuite/c-c++-common/gomp/loop-6.c
index 0d4474dbebb..24383ff04ea 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 00000000000..c3de8c9644c
--- /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 00000000000..7df006abd27
--- /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 01cfc82b760..77b2bdd7fcb 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 00000000000..a7f41cb69ca
--- /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 04599849ed7..e0401a5fdec 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] only message in thread

only message in thread, other threads:[~2022-06-29 14:47 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-06-29 14:47 [gcc/devel/omp/gcc-12] Fortran: Add support for OMP non-rectangular loops Kwok Yeung

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).