[Patch] Fortran/OpenMP: unconstrained/reproducible ordered modifier

[Patch] Fortran/OpenMP: unconstrained/reproducible ordered modifier

[Tobias Burnus]

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

This patch adds Fortran support for the new OpenMP 5.1 unconstrained and reproducible
modifiers to ordered(concurrent).

This patch requires Jakub's patch to handle the middle-end (and C/C++) part,
which still has to be committed. The testcases are based on the C/C++ ones.

OK?

Tobias

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

[-- Attachment #2: omp-concurrent.diff --]
[-- Type: text/x-patch, Size: 34928 bytes --]

Fortran/OpenMP: unconstrained/reproducible ordered modifier

gcc/fortran/ChangeLog:

	* gfortran.h (gfc_omp_clauses): Add order_unconstrained.
	* dump-parse-tree.c (show_omp_clauses): Dump it.
	* openmp.c (gfc_match_omp_clauses): Match unconstrained/reproducible
	modifiers to ordered(concurrent).
	(OMP_DISTRIBUTE_CLAUSES): Accept ordered clause.
	(resolve_omp_clauses): Reject ordered + order on same directive.
	* trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses): Pass
	on unconstrained modifier of ordered(concurrent).

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/order-5.f90: New test.
	* gfortran.dg/gomp/order-6.f90: New test.
	* gfortran.dg/gomp/order-7.f90: New test.
	* gfortran.dg/gomp/order-8.f90: New test.
	* gfortran.dg/gomp/order-9.f90: New test.

 gcc/fortran/dump-parse-tree.c              |   7 +-
 gcc/fortran/gfortran.h                     |   3 +-
 gcc/fortran/openmp.c                       |  25 +-
 gcc/fortran/trans-openmp.c                 |   7 +
 gcc/testsuite/gfortran.dg/gomp/order-5.f90 | 129 +++++++++
 gcc/testsuite/gfortran.dg/gomp/order-6.f90 | 436 +++++++++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/gomp/order-7.f90 |  59 ++++
 gcc/testsuite/gfortran.dg/gomp/order-8.f90 |  61 ++++
 gcc/testsuite/gfortran.dg/gomp/order-9.f90 |  35 +++
 9 files changed, 756 insertions(+), 6 deletions(-)

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index a1df47c2f82..28eb09e261d 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1630,7 +1630,12 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
   if (omp_clauses->independent)
     fputs (" INDEPENDENT", dumpfile);
   if (omp_clauses->order_concurrent)
-    fputs (" ORDER(CONCURRENT)", dumpfile);
+    {
+      fputs (" ORDER(", dumpfile);
+      if (omp_clauses->order_unconstrained)
+	fputs ("UNCONSTRAINED:", dumpfile);
+      fputs ("CONCURRENT)", dumpfile);
+    }
   if (omp_clauses->ordered)
     {
       if (omp_clauses->orderedc)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index fdf556eef3d..8b91225d659 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1491,7 +1491,8 @@ typedef struct gfc_omp_clauses
   unsigned inbranch:1, notinbranch:1, nogroup:1;
   unsigned sched_simd:1, sched_monotonic:1, sched_nonmonotonic:1;
   unsigned simd:1, threads:1, depend_source:1, destroy:1, order_concurrent:1;
-  unsigned capture:1, grainsize_strict:1, num_tasks_strict:1;
+  unsigned order_unconstrained:1, capture:1, grainsize_strict:1;
+  unsigned num_tasks_strict: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.c b/gcc/fortran/openmp.c
index a64b7f5aa10..9ee52d6b0ea 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2369,9 +2369,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  break;
 	case 'o':
 	  if ((mask & OMP_CLAUSE_ORDER)
-	      && !c->order_concurrent
-	      && gfc_match ("order ( concurrent )") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->order_concurrent, "order ("))
+		 != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      if (gfc_match (" reproducible : concurrent )") == MATCH_YES
+		  || gfc_match (" concurrent )") == MATCH_YES)
+		;
+	      else if (gfc_match (" unconstrained : concurrent )") == MATCH_YES)
+		c->order_unconstrained = true;
+	      else
+		{
+		  gfc_error ("Expected ORDER(CONCURRENT) at %C "
+			     "with optional %<reproducible%> or "
+			     "%<unconstrained%> modifier");
+		  goto error;
+		}
 	      c->order_concurrent = true;
 	      continue;
 	    }
@@ -3475,7 +3489,8 @@ cleanup:
    | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION)
 #define OMP_DISTRIBUTE_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE		\
-   | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE)
+   | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE \
+   | OMP_CLAUSE_ORDER)
 #define OMP_SINGLE_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE)
 #define OMP_ORDERED_CLAUSES \
@@ -5643,7 +5658,9 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
   if (omp_clauses->orderedc && omp_clauses->orderedc < omp_clauses->collapse)
     gfc_error ("ORDERED clause parameter is less than COLLAPSE at %L",
 	       &code->loc);
-
+  if (omp_clauses->order_concurrent && omp_clauses->ordered)
+    gfc_error ("ORDER clause must not be used together ORDERED at %L",
+	       &code->loc);
   if (omp_clauses->if_expr)
     {
       gfc_expr *expr = omp_clauses->if_expr;
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index e55e0c81868..4ca2c3f9e7f 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -3803,6 +3803,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
   if (clauses->order_concurrent)
     {
       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ORDER);
+      OMP_CLAUSE_ORDER_UNCONSTRAINED (c) = clauses->order_unconstrained;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
@@ -5892,6 +5893,8 @@ gfc_split_omp_clauses (gfc_code *code,
 	    = code->ext.omp_clauses->collapse;
 	  clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_concurrent
 	    = code->ext.omp_clauses->order_concurrent;
+	  clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_unconstrained
+	    = code->ext.omp_clauses->order_unconstrained;
 	}
       if (mask & GFC_OMP_MASK_PARALLEL)
 	{
@@ -5946,6 +5949,8 @@ gfc_split_omp_clauses (gfc_code *code,
 	    = code->ext.omp_clauses->collapse;
 	  clausesa[GFC_OMP_SPLIT_DO].order_concurrent
 	    = code->ext.omp_clauses->order_concurrent;
+	  clausesa[GFC_OMP_SPLIT_DO].order_unconstrained
+	    = code->ext.omp_clauses->order_unconstrained;
 	}
       if (mask & GFC_OMP_MASK_SIMD)
 	{
@@ -5962,6 +5967,8 @@ gfc_split_omp_clauses (gfc_code *code,
 	    = code->ext.omp_clauses->if_exprs[OMP_IF_SIMD];
 	  clausesa[GFC_OMP_SPLIT_SIMD].order_concurrent
 	    = code->ext.omp_clauses->order_concurrent;
+	  clausesa[GFC_OMP_SPLIT_SIMD].order_unconstrained
+	    = code->ext.omp_clauses->order_unconstrained;
 	  /* And this is copied to all.  */
 	  clausesa[GFC_OMP_SPLIT_SIMD].if_expr
 	    = code->ext.omp_clauses->if_expr;
diff --git a/gcc/testsuite/gfortran.dg/gomp/order-5.f90 b/gcc/testsuite/gfortran.dg/gomp/order-5.f90
new file mode 100644
index 00000000000..4d9e33642af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/order-5.f90
@@ -0,0 +1,129 @@
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine f1 (a)
+  integer :: a(*), i
+  !$omp do order(reproducible:concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp simd order ( reproducible : concurrent )
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp do simd order(reproducible :concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+end
+
+subroutine f2 (a)
+  integer :: a(*), i
+  !$omp parallel do order(reproducible: concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp parallel do simd order (reproducible:concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp teams distribute parallel do order(reproducible:concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp teams distribute parallel do simd order(reproducible:concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp teams distribute order(reproducible:concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp teams
+    !$omp distribute parallel do order(reproducible:concurrent)
+    do i = 1, 128
+      a(i) = a(i) + 1
+    end do
+    !$omp distribute parallel do simd order(reproducible:concurrent)
+    do i = 1, 128
+      a(i) = a(i) + 1
+    end do
+    !$omp distribute order(reproducible:concurrent)
+    do i = 1, 128
+      a(i) = a(i) + 1
+    end do
+  !$omp end teams
+  !$omp taskloop simd order (reproducible:concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+end
+
+subroutine f3 (a)
+  integer :: a(*), i
+  !$omp do order(unconstrained:concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp simd order ( unconstrained : concurrent )
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp do simd order(unconstrained :concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+end
+
+subroutine f4 (a)
+  integer :: a(*), i
+  !$omp parallel do order(unconstrained: concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp parallel do simd order (unconstrained:concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp teams distribute parallel do order(unconstrained:concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp teams distribute parallel do simd order(unconstrained:concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp teams distribute order(unconstrained:concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp teams
+    !$omp distribute parallel do order(unconstrained:concurrent)
+    do i = 1, 128
+      a(i) = a(i) + 1
+    end do
+    !$omp distribute parallel do simd order(unconstrained:concurrent)
+    do i = 1, 128
+      a(i) = a(i) + 1
+    end do
+    !$omp distribute order(unconstrained:concurrent)
+    do i = 1, 128
+      a(i) = a(i) + 1
+    end do
+  !$omp end teams
+  !$omp taskloop simd order (unconstrained:concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+end
+
+! { dg-final { scan-tree-dump-times "#pragma omp distribute order\\(concurrent\\)" 6 "original"} }
+! { dg-final { scan-tree-dump-times "#pragma omp distribute order\\(unconstrained:concurrent\\)" 6 "original"} }
+! { dg-final { scan-tree-dump-times "#pragma omp for nowait order\\(concurrent\\)" 6 "original"} }
+! { dg-final { scan-tree-dump-times "#pragma omp for nowait order\\(unconstrained:concurrent\\)" 6 "original"} }
+! { dg-final { scan-tree-dump-times "#pragma omp for order\\(concurrent\\)" 2 "original"} }
+! { dg-final { scan-tree-dump-times "#pragma omp for order\\(unconstrained:concurrent\\)" 2 "original"} }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel" 12 "original"} }
+! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) order\\(concurrent\\)" 6 "original"} }
+! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) order\\(unconstrained:concurrent\\)" 6 "original"} }
+! { dg-final { scan-tree-dump-times "#pragma omp taskloop" 2 "original"} }
+! { dg-final { scan-tree-dump-times "#pragma omp teams" 8 "original"} }
diff --git a/gcc/testsuite/gfortran.dg/gomp/order-6.f90 b/gcc/testsuite/gfortran.dg/gomp/order-6.f90
new file mode 100644
index 00000000000..c8aeecb6f27
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/order-6.f90
@@ -0,0 +1,436 @@
+module m
+  use iso_c_binding
+  implicit none (type, external)
+  interface
+    subroutine foo()
+    end subroutine foo
+    integer function omp_get_thread_num ()
+    end
+    integer function omp_get_num_threads ()
+    end
+    integer function omp_target_is_present (x, i)
+      import :: c_ptr
+      type(c_ptr) :: x
+      integer, value :: i
+    end
+    integer function omp_get_cancellation ()
+    end
+  end interface
+  integer :: v
+contains
+subroutine f1 (a)
+  integer, target :: a(*)
+  integer :: i
+  !$omp simd order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp parallel		! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
+      call foo ()
+      !$omp end parallel
+  end do
+  !$omp simd order(reproducible:concurrent)
+  do i = 1, 64
+    block
+      integer j
+      !$omp simd
+      do j = 1, 64
+        a(64 * i + j) = i + j
+      end do
+    end block
+  end do
+  !$omp simd order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp critical		! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
+      call foo ()
+      !$omp end critical
+  end do
+  !$omp simd order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp ordered simd		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      call foo ()
+      !$omp end ordered
+  end do
+  !$omp simd order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp atomic		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      v = v + 1
+  end do
+  !$omp simd order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp atomic read		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      a(i) = v
+  end do
+  !$omp simd order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp atomic write		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      v = a(i)
+  end do
+  !$omp simd order(reproducible:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_thread_num ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp simd order(reproducible:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_num_threads ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp simd order(reproducible:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_target_is_present (c_loc (a(i)), 0)  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp simd order(reproducible:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_cancellation ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+end
+
+subroutine f2 (a)
+  integer, target :: a(*)
+  integer :: i
+  !$omp do simd order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp parallel		! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
+      call foo ()
+      !$omp end parallel
+  end do
+  !$omp do simd order(reproducible:concurrent)
+  do i = 1, 64
+    block
+      integer j
+      !$omp simd
+      do j = 1, 64
+        a(64 * i + j) = i + j
+      end do
+    end block
+  end do
+  !$omp do simd order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp critical		! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
+      call foo ()
+      !$omp end critical
+  end do
+  !$omp do simd order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp ordered simd		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      call foo ()
+      !$omp end ordered
+  end do
+  !$omp do simd order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp atomic		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      v = v + 1
+  end do
+  !$omp do simd order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp atomic read		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      a(i) = v
+  end do
+  !$omp do simd order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp atomic write		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      v = a(i)
+  end do
+  !$omp do simd order(reproducible:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_thread_num ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do simd order(reproducible:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_num_threads () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do simd order(reproducible:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_target_is_present (c_loc(a(i)), 0)  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do simd order(reproducible:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_cancellation ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+end
+
+subroutine f3 (a)
+  integer, target :: a(*)
+  integer :: i
+  !$omp do order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp parallel
+      call foo ()
+      !$omp end parallel
+  end do
+  !$omp do order(reproducible:concurrent)
+  do i = 1, 64
+    block
+      integer j
+      !$omp simd
+      do j = 1, 64
+        a(64 * i + j) = i + j
+      end do
+    end block
+  end do
+  !$omp do order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp critical		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      call foo ()
+      !$omp end critical
+  end do
+  !$omp do order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp ordered simd		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      call foo ()
+      !$omp end ordered
+  end do
+  !$omp do order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp atomic		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      v = v + 1
+  end do
+  !$omp do order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp atomic read		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      a(i) = v
+  end do
+  !$omp do order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp atomic write		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      v = a(i)
+  end do
+  !$omp do order(reproducible:concurrent)
+  do i = 1, 64
+      !$omp task			! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      a(i) = a(i) + 1
+      !$omp end task
+  end do
+  !$omp do order(reproducible:concurrent)
+  do i = 1, 64
+    block
+      integer j
+      !$omp taskloop		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      do j = 1, 64
+        a(64 * i + j) = i + j
+      end do
+    end block
+  end do
+  !$omp do order(reproducible:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_thread_num ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do order(reproducible:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_num_threads ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do order(reproducible:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_target_is_present (c_loc (a(i)), 0)  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do order(reproducible:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_cancellation ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+end
+
+subroutine f4 (a)
+  integer, target :: a(*)
+  integer :: i
+  !$omp simd order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp parallel		! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
+      call foo ()
+      !$omp end parallel
+  end do
+  !$omp simd order(unconstrained:concurrent)
+  do i = 1, 64
+    block
+      integer j
+      !$omp simd
+      do j = 1, 64
+        a(64 * i + j) = i + j
+      end do
+    end block
+  end do
+  !$omp simd order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp critical		! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
+      call foo ()
+      !$omp end critical
+  end do
+  !$omp simd order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp ordered simd		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      call foo ()
+      !$omp end ordered
+  end do
+  !$omp simd order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp atomic		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      v = v + 1
+  end do
+  !$omp simd order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp atomic read		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      a(i) = v
+  end do
+  !$omp simd order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp atomic write		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      v = a(i)
+  end do
+  !$omp simd order(unconstrained:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_thread_num ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp simd order(unconstrained:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_num_threads ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp simd order(unconstrained:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_target_is_present (c_loc (a(i)), 0)  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp simd order(unconstrained:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_cancellation ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+end
+
+subroutine f5 (a)
+  integer, target :: a(*)
+  integer :: i
+  !$omp do simd order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp parallel		! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
+      call foo ()
+      !$omp end parallel
+  end do
+  !$omp do simd order(unconstrained:concurrent)
+  do i = 1, 64
+    block
+      integer j
+      !$omp simd
+      do j = 1, 64
+        a(64 * i + j) = i + j
+      end do
+    end block
+  end do
+  !$omp do simd order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp critical		! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
+      call foo ()
+      !$omp end critical
+  end do
+  !$omp do simd order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp ordered simd		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      call foo ()
+      !$omp end ordered
+  end do
+  !$omp do simd order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp atomic		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      v = v + 1
+  end do
+  !$omp do simd order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp atomic read		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      a(i) = v
+  end do
+  !$omp do simd order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp atomic write		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      v = a(i)
+  end do
+  !$omp do simd order(unconstrained:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_thread_num ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do simd order(unconstrained:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_num_threads ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do simd order(unconstrained:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_target_is_present (c_loc (a(i)), 0)  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do simd order(unconstrained:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_cancellation ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+end
+
+subroutine f6 (a)
+  integer, target :: a(*)
+  integer :: i
+  !$omp do order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp parallel
+      call foo ()
+      !$omp end parallel
+  end do
+  !$omp do order(unconstrained:concurrent)
+  do i = 1, 64
+    block
+      integer j
+      !$omp simd
+      do j = 1, 64
+        a(64 * i + j) = i + j
+      end do
+    end block
+  end do
+  !$omp do order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp critical		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      call foo ()
+      !$omp end critical
+  end do
+  !$omp do order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp ordered simd		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      call foo ()
+      !$omp end ordered
+  end do
+  !$omp do order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp atomic		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      v = v + 1
+  end do
+  !$omp do order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp atomic read		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      a(i) = v
+  end do
+  !$omp do order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp atomic write		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      v = a(i)
+  end do
+  !$omp do order(unconstrained:concurrent)
+  do i = 1, 64
+      !$omp task			! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      a(i) = a(i) + 1
+      !$omp end task
+  end do
+  !$omp do order(unconstrained:concurrent)
+  do i = 1, 64
+    block
+      integer j
+      !$omp taskloop		! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      do j = 1, 64
+        a(64 * i + j) = i + j
+      end do
+    end block
+  end do
+  !$omp do order(unconstrained:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_thread_num ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do order(unconstrained:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_num_threads ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do order(unconstrained:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_target_is_present (c_loc (a(i)), 0)  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do order(unconstrained:concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_cancellation ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+end
+end module m
diff --git a/gcc/testsuite/gfortran.dg/gomp/order-7.f90 b/gcc/testsuite/gfortran.dg/gomp/order-7.f90
new file mode 100644
index 00000000000..4be8ab37233
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/order-7.f90
@@ -0,0 +1,59 @@
+subroutine f1 (a)
+  integer :: a(*)
+  integer i
+  !$omp do order(concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp simd order ( concurrent )
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp do simd order(concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+end
+
+subroutine f2 (a)
+  integer :: a(*)
+  integer i
+  !$omp parallel do order(concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp parallel do simd order (concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp teams distribute parallel do order(concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp teams distribute parallel do simd order(concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp teams distribute order(concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp teams
+    !$omp distribute parallel do order(concurrent)
+    do i = 1, 128
+      a(i) = a(i) + 1
+    end do
+    !$omp distribute parallel do simd order(concurrent)
+    do i = 1, 128
+      a(i) = a(i) + 1
+    end do
+    !$omp distribute order(concurrent)
+    do i = 1, 128
+      a(i) = a(i) + 1
+    end do
+  !$omp end teams
+  !$omp taskloop simd order (concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/order-8.f90 b/gcc/testsuite/gfortran.dg/gomp/order-8.f90
new file mode 100644
index 00000000000..c753886d621
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/order-8.f90
@@ -0,0 +1,61 @@
+subroutine f1 (a)
+  integer :: a(*)
+  integer i
+  !$omp do order				! { dg-error "Failed to match clause" }
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp do simd order :			! { dg-error "Failed to match clause" }
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp simd order ( foobar )		! { dg-error "Expected ORDER\\(CONCURRENT\\) at .1. with optional 'reproducible' or 'unconstrained' modifier" }
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp do simd order( concurrent	! { dg-error "Expected ORDER\\(CONCURRENT\\) at .1. with optional 'reproducible' or 'unconstrained' modifier" }
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp do simd order( concurrent : foo )! { dg-error "Expected ORDER\\(CONCURRENT\\) at .1. with optional 'reproducible' or 'unconstrained' modifier" }
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+end
+
+subroutine f2 (a)
+  integer :: a(*)
+  integer i
+  !$omp teams
+  !$omp distribute order(concurrent)
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp end teams
+  !$omp taskloop order (concurrent)	! { dg-error "Failed to match clause" }
+  do i = 1, 128
+    a(i) = a(i) + 1
+  end do
+  !$omp do order(concurrent) ordered	! { dg-error "ORDER clause must not be used together ORDERED" }
+  do i = 1, 128
+      !$omp ordered
+      a(i) = a(i) + 1
+      !$omp end ordered
+  end do
+  !$omp do ordered order(concurrent)	! { dg-error "ORDER clause must not be used together ORDERED" }
+  do i = 1, 128
+      !$omp ordered
+      a(i) = a(i) + 1
+      !$omp end ordered
+  end do
+  !$omp do ordered (1) order(concurrent)	! { dg-error "ORDER clause must not be used together ORDERED" }
+  do i = 1, 128
+      !$omp ordered depend (sink: i - 1)
+      !$omp ordered depend (source)
+  end do
+  !$omp do order(concurrent)ordered (1)	! { dg-error "ORDER clause must not be used together ORDERED" }
+  do i = 1, 128
+      !$omp ordered depend (sink: i - 1)
+      !$omp ordered depend (source)
+  end do
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/order-9.f90 b/gcc/testsuite/gfortran.dg/gomp/order-9.f90
new file mode 100644
index 00000000000..c7695114cde
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/order-9.f90
@@ -0,0 +1,35 @@
+subroutine foo
+  !$omp do schedule(static) order(concurrent) order(concurrent) ! { dg-error "Duplicated 'order \\(' clause" }
+  do i = 1, 8
+    call f0 ()
+  end do
+  !$omp do schedule(static) order(reproducible:concurrent) order(unconstrained:concurrent)      ! { dg-error "Duplicated 'order \\(' clause" }
+  do i = 1, 8
+    call f0 ()
+  end do
+
+  !$omp loop bind(thread) order(concurrent) order(concurrent)    ! { dg-error "Duplicated 'order \\(' clause" }
+  do i = 1, 8
+    call f0 ()
+  end do
+  !$omp loop bind(thread) order(reproducible:concurrent) order(unconstrained:concurrent) ! { dg-error "Duplicated 'order \\(' clause" }
+  do i = 1, 8
+    call f0 ()
+  end do
+  !$omp simd order(concurrent) order(concurrent) ! { dg-error "Duplicated 'order \\(' clause" }
+  do i = 1, 8
+    call f0 ()
+  end do
+  !$omp simd order(reproducible:concurrent) order(unconstrained:concurrent)      ! { dg-error "Duplicated 'order \\(' clause" }
+  do i = 1, 8
+    call f0 ()
+  end do
+  !$omp distribute dist_schedule(static) order(concurrent) order(concurrent)     ! { dg-error "Duplicated 'order \\(' clause" }
+  do i = 1, 8
+    call f0 ()
+  end do
+  !$omp loop bind(thread) order(reproducible:concurrent) order(unconstrained:concurrent) ! { dg-error "Duplicated 'order \\(' clause" }
+  do i = 1, 8
+    call f0 ()
+  end do
+end

Re: [Patch] Fortran/OpenMP: unconstrained/reproducible ordered modifier

[Jakub Jelinek]

On Fri, Sep 17, 2021 at 11:42:13PM +0200, Tobias Burnus wrote:
> Fortran/OpenMP: unconstrained/reproducible ordered modifier
> 
> gcc/fortran/ChangeLog:
> 
> 	* gfortran.h (gfc_omp_clauses): Add order_unconstrained.
> 	* dump-parse-tree.c (show_omp_clauses): Dump it.
> 	* openmp.c (gfc_match_omp_clauses): Match unconstrained/reproducible
> 	modifiers to ordered(concurrent).
> 	(OMP_DISTRIBUTE_CLAUSES): Accept ordered clause.
> 	(resolve_omp_clauses): Reject ordered + order on same directive.
> 	* trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses): Pass
> 	on unconstrained modifier of ordered(concurrent).
> 
> gcc/testsuite/ChangeLog:
> 
> 	* gfortran.dg/gomp/order-5.f90: New test.
> 	* gfortran.dg/gomp/order-6.f90: New test.
> 	* gfortran.dg/gomp/order-7.f90: New test.
> 	* gfortran.dg/gomp/order-8.f90: New test.
> 	* gfortran.dg/gomp/order-9.f90: New test.

Ok, thanks.

> @@ -5892,6 +5893,8 @@ gfc_split_omp_clauses (gfc_code *code,
>  	    = code->ext.omp_clauses->collapse;
>  	  clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_concurrent
>  	    = code->ext.omp_clauses->order_concurrent;

So the FE was splitting the order clause to distribute already before,
perhaps we should undo that for gcc 11 which doesn't claim any OpenMP 5.1
support.
The difference is e.g. the distribute parallel do order(concurrent) copyin(thr)
case which used to be ok in 5.0 and is not in 5.1.

	Jakub

[Patch]GCC11 - Fortran: combined directives - order(concurrent) not on distribute (was: Re: [Patch] Fortran/OpenMP: unconstrained/reproducible ordered modifier)

[Tobias Burnus]

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

On 20.09.21 11:55, Jakub Jelinek via Fortran wrote:
> So the FE was splitting the order clause to distribute already before,
> perhaps we should undo that for gcc 11 which doesn't claim any OpenMP 5.1
> support.
> The difference is e.g. the distribute parallel do order(concurrent) copyin(thr)
> case which used to be ok in 5.0 and is not in 5.1.

Well, if I try with GCC 11:

void f(int *a)
{
int  i;
static int thr;
#pragma omp threadprivate (thr)
#pragma omp distribute parallel for order(concurrent) copyin(thr)
   for (i = 0; i < 10; ++i)
    {
     thr = 5;
     a[i] = thr;
    }
}

I get with gcc (+ gfortran):
   error: threadprivate variable ‘thr’ used in a region with ‘order(concurrent)’ clause
I might have misunderstood the example.

  * * *

In any case, for GCC 11, I have now fixed the splitting and added a testcase which
relies on -fdump-tree-original scanning and does not use threadprivate.

OK for GCC 11, only?

Tobias

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

[-- Attachment #2: omp-order-concurrent-11.diff --]
[-- Type: text/x-patch, Size: 2373 bytes --]

GCC11 - Fortran: combined directives - order(concurrent) not on distribute

While OpenMP 5.1 and GCC 12 permits 'order(concurrent)' on distribute,
OpenMP 5.0 and GCC 11 don't. This patch for GCC 11 ensures the clause also
does not end up on 'distribute' when splitting combined directives.

gcc/fortran/ChangeLog:

	* trans-openmp.c (gfc_split_omp_clauses): Don't put 'order(concurrent)'
	on 'distribute' for combined directives, matching OpenMP 5.0

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/distribute-order-concurrent.f90: New test.

 gcc/fortran/trans-openmp.c                         |  2 --
 .../gomp/distribute-order-concurrent.f90           | 25 ++++++++++++++++++++++
 2 files changed, 25 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 7e931bf4bc7..973d916b4a2 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -5176,8 +5176,6 @@ gfc_split_omp_clauses (gfc_code *code,
 	  /* Duplicate collapse.  */
 	  clausesa[GFC_OMP_SPLIT_DISTRIBUTE].collapse
 	    = code->ext.omp_clauses->collapse;
-	  clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_concurrent
-	    = code->ext.omp_clauses->order_concurrent;
 	}
       if (mask & GFC_OMP_MASK_PARALLEL)
 	{
diff --git a/gcc/testsuite/gfortran.dg/gomp/distribute-order-concurrent.f90 b/gcc/testsuite/gfortran.dg/gomp/distribute-order-concurrent.f90
new file mode 100644
index 00000000000..9597d913684
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/distribute-order-concurrent.f90
@@ -0,0 +1,25 @@
+! { dg-additional-options "-fdump-tree-original" }
+!
+! In OpenMP 5.0, 'order(concurrent)' does not apply to distribute
+! Ensure that it is rejected in GCC 11.
+! 
+! Note: OpenMP 5.1 allows it; the GCC 12 testcase for it is gfortran.dg/gomp/order-5.f90
+
+subroutine f(a)
+implicit none
+integer :: i, thr
+!save :: thr
+integer :: a(:)
+
+!$omp distribute parallel do order(concurrent) private(thr)
+  do i = 1, 10
+    thr = 5
+    a(i) = thr
+  end do
+!$omp end distribute parallel do
+end
+
+! { dg-final { scan-tree-dump-not "omp distribute\[^\n\r]*order" "original" } }
+! { dg-final { scan-tree-dump "#pragma omp distribute\[\n\r\]" "original" } }
+! { dg-final { scan-tree-dump "#pragma omp parallel private\\(thr\\)" "original" } }
+! { dg-final { scan-tree-dump "#pragma omp for nowait order\\(concurrent\\)" "original" } }

Re: [Patch]GCC11 - Fortran: combined directives - order(concurrent) not on distribute (was: Re: [Patch] Fortran/OpenMP: unconstrained/reproducible ordered modifier)

[Jakub Jelinek]

On Mon, Sep 20, 2021 at 05:01:32PM +0200, Tobias Burnus wrote:
> On 20.09.21 11:55, Jakub Jelinek via Fortran wrote:
> > So the FE was splitting the order clause to distribute already before,
> > perhaps we should undo that for gcc 11 which doesn't claim any OpenMP 5.1
> > support.
> > The difference is e.g. the distribute parallel do order(concurrent) copyin(thr)
> > case which used to be ok in 5.0 and is not in 5.1.
> 
> Well, if I try with GCC 11:
> 
> void f(int *a)
> {
> int  i;
> static int thr;
> #pragma omp threadprivate (thr)
> #pragma omp distribute parallel for order(concurrent) copyin(thr)
>   for (i = 0; i < 10; ++i)
>    {
>     thr = 5;
>     a[i] = thr;
>    }
> }
> 
> I get with gcc (+ gfortran):
>   error: threadprivate variable ‘thr’ used in a region with ‘order(concurrent)’ clause
> I might have misunderstood the example.

Sure, even before you couldn't use it in the region body, because
order(concurrent) was split to worksharing-loop.
The testcase that used to be accepted and is now rejected is e.g.

int thr;
#pragma omp threadprivate (thr)

void
foo (void)
{
  int i;
#pragma omp distribute parallel for order(concurrent) copyin(thr)
  for (i = 0; i < 10; ++i)
   ;
}

While copyin without actually using the threadprivate var in the body
might look weird, in some cases it might be useful if the threadprivate
variable is used in some following parallel region.

> OK for GCC 11, only?
> 
> Tobias
> 
> -----------------
> Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

> GCC11 - Fortran: combined directives - order(concurrent) not on distribute
> 
> While OpenMP 5.1 and GCC 12 permits 'order(concurrent)' on distribute,
> OpenMP 5.0 and GCC 11 don't. This patch for GCC 11 ensures the clause also
> does not end up on 'distribute' when splitting combined directives.
> 
> gcc/fortran/ChangeLog:
> 
> 	* trans-openmp.c (gfc_split_omp_clauses): Don't put 'order(concurrent)'
> 	on 'distribute' for combined directives, matching OpenMP 5.0
> 
> gcc/testsuite/ChangeLog:
> 
> 	* gfortran.dg/gomp/distribute-order-concurrent.f90: New test.

Ok, thanks.

	Jakub