public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [Patch] Fortran/OpenMP: unconstrained/reproducible ordered modifier
@ 2021-09-17 21:42 Tobias Burnus
  2021-09-20  9:55 ` Jakub Jelinek
  0 siblings, 1 reply; 4+ messages in thread
From: Tobias Burnus @ 2021-09-17 21:42 UTC (permalink / raw)
  To: Jakub Jelinek, gcc-patches, fortran

[-- 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

^ permalink raw reply	[flat|nested] 4+ messages in thread
end of thread, other threads:[~2021-09-20 15:14 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-09-17 21:42 [Patch] Fortran/OpenMP: unconstrained/reproducible ordered modifier Tobias Burnus
2021-09-20  9:55 ` Jakub Jelinek
2021-09-20 15:01   ` [Patch]GCC11 - Fortran: combined directives - order(concurrent) not on distribute (was: Re: [Patch] Fortran/OpenMP: unconstrained/reproducible ordered modifier) Tobias Burnus
2021-09-20 15:13     ` 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).