Fortran: OpenMP - fixes for omp atomic [PR97655]
authorTobias Burnus <tobias@codesourcery.com>
Mon, 2 Nov 2020 12:07:17 +0000 (13:07 +0100)
committerTobias Burnus <tobias@codesourcery.com>
Mon, 2 Nov 2020 12:07:17 +0000 (13:07 +0100)
gcc/fortran/ChangeLog:

PR fortran/97655
* openmp.c (gfc_match_omp_atomic): Fix mem-order handling;
reject specifying update + capture together.

gcc/testsuite/ChangeLog:

PR fortran/97655
* gfortran.dg/gomp/atomic.f90: Update tree-dump counts; move
invalid OMP 5.0 code to ...
* gfortran.dg/gomp/atomic-2.f90: ... here; update dg-error.
* gfortran.dg/gomp/requires-9.f90: Update tree dump scan.

gcc/fortran/openmp.c
gcc/testsuite/gfortran.dg/gomp/atomic-2.f90
gcc/testsuite/gfortran.dg/gomp/atomic.f90
gcc/testsuite/gfortran.dg/gomp/requires-9.f90

index 608ff5a0b559e1dbcf72c661b79d10854299cfb0..6cb4f2862abd8826064ae69d559c9920c24d23ad 100644 (file)
@@ -4107,12 +4107,13 @@ gfc_match_omp_atomic (void)
 
   if (gfc_match_omp_clauses (&c, OMP_ATOMIC_CLAUSES, true, true) != MATCH_YES)
     return MATCH_ERROR;
+
+  if (c->capture && c->atomic_op != GFC_OMP_ATOMIC_UNSET)
+    gfc_error ("OMP ATOMIC at %L with multiple atomic clauses", &loc);
+
   if (c->atomic_op == GFC_OMP_ATOMIC_UNSET)
     c->atomic_op = GFC_OMP_ATOMIC_UPDATE;
 
-  if (c->capture && c->atomic_op != GFC_OMP_ATOMIC_UPDATE)
-    gfc_error ("OMP ATOMIC at %L with CAPTURE clause must be UPDATE", &loc);
-
   if (c->memorder == OMP_MEMORDER_UNSET)
     {
       gfc_namespace *prog_unit = gfc_current_ns;
@@ -4128,12 +4129,12 @@ gfc_match_omp_atomic (void)
          c->memorder = OMP_MEMORDER_SEQ_CST;
          break;
        case OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL:
-         if (c->atomic_op == GFC_OMP_ATOMIC_READ)
-           c->memorder = OMP_MEMORDER_ACQUIRE;
+         if (c->capture)
+           c->memorder = OMP_MEMORDER_ACQ_REL;
          else if (c->atomic_op == GFC_OMP_ATOMIC_READ)
-           c->memorder = OMP_MEMORDER_RELEASE;
+           c->memorder = OMP_MEMORDER_ACQUIRE;
          else
-           c->memorder = OMP_MEMORDER_ACQ_REL;
+           c->memorder = OMP_MEMORDER_RELEASE;
          break;
        default:
          gcc_unreachable ();
@@ -4161,8 +4162,9 @@ gfc_match_omp_atomic (void)
          }
        break;
       case GFC_OMP_ATOMIC_UPDATE:
-       if (c->memorder == OMP_MEMORDER_ACQ_REL
-           || c->memorder == OMP_MEMORDER_ACQUIRE)
+       if ((c->memorder == OMP_MEMORDER_ACQ_REL
+            || c->memorder == OMP_MEMORDER_ACQUIRE)
+           && !c->capture)
          {
            gfc_error ("!$OMP ATOMIC UPDATE at %L incompatible with "
                       "ACQ_REL or ACQUIRE clauses", &loc);
index 5094caa515402eb1690effac7549afff04d8b6a1..1de418dcc950e17322f50df99010663446d9f5d1 100644 (file)
@@ -9,25 +9,62 @@ subroutine bar
     i = i + 1
   !$omp end atomic
 
-  !$omp atomic acq_rel capture ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" }
+  !$omp atomic acq_rel ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" }
   i = i + 1
-  v = i
   !$omp end atomic
 
-  !$omp atomic capture,acq_rel , hint (1), update ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" }
+  !$omp atomic capture,acq_rel , hint (1)
   i = i + 1
   v = i
   !$omp end atomic
 
-  !$omp atomic hint(0),acquire capture ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" }
+  !$omp atomic acq_rel , hint (1), update ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" }
+  i = i + 1
+  !$omp end atomic
+
+  !$omp atomic hint(0),acquire capture
   i = i + 1
   v = i
   !$omp end atomic
 
-  !$omp atomic write capture ! { dg-error "OMP ATOMIC at .1. with CAPTURE clause must be UPDATE" }
+  !$omp atomic write capture ! { dg-error "multiple atomic clauses" }
   i = 2
   v = i
   !$omp end atomic
 
   !$omp atomic foobar ! { dg-error "Failed to match clause" }
 end
+
+! moved here from atomic.f90
+subroutine openmp51_foo
+  integer :: x, v
+  !$omp atomic update seq_cst capture  ! { dg-error "multiple atomic clauses" }
+  x = x + 2
+  v = x
+  !$omp end atomic
+  !$omp atomic seq_cst, capture, update  ! { dg-error "multiple atomic clauses" }
+  x = x + 2
+  v = x
+  !$omp end atomic
+  !$omp atomic capture, seq_cst ,update  ! { dg-error "multiple atomic clauses" }
+  x = x + 2
+  v = x
+  !$omp end atomic
+end
+
+subroutine openmp51_bar
+  integer :: i, v
+  real :: f
+  !$omp atomic relaxed capture update  ! { dg-error "multiple atomic clauses" }
+  i = i + 1
+  v = i
+  !$omp end atomic
+  !$omp atomic update capture,release , hint (1)  ! { dg-error "multiple atomic clauses" }
+  i = i + 1
+  v = i
+  !$omp end atomic
+  !$omp atomic hint(0),update relaxed capture  ! { dg-error "multiple atomic clauses" }
+  i = i + 1
+  v = i
+  !$omp end atomic
+end
index 8a1cf5b1f6856de1125759c1032501f9e0ecc444..b4caf03952d59be26a5a5621c2c683208489b58b 100644 (file)
@@ -3,13 +3,13 @@
 
 ! { dg-final { scan-tree-dump-times "#pragma omp atomic relaxed" 4 "original" } }
 ! { dg-final { scan-tree-dump-times "#pragma omp atomic release" 4 "original" } }
-! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture relaxed" 4 "original" } }
-! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture release" 2 "original" } }
+! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture relaxed" 2 "original" } }
+! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture release" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "v = #pragma omp atomic read acquire" 1 "original" } }
 
 ! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst" 7 "original" } }
 ! { dg-final { scan-tree-dump-times "v = #pragma omp atomic read seq_cst" 3 "original" } }
-! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture seq_cst" 6 "original" } }
+! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture seq_cst" 3 "original" } }
 
 
 subroutine foo ()
@@ -36,18 +36,10 @@ subroutine foo ()
   x = x + 2
   v = x
   !$omp end atomic
-  !$omp atomic update seq_cst capture
-  x = x + 2
-  v = x
-  !$omp end atomic
   !$omp atomic seq_cst, capture
   x = x + 2
   v = x
   !$omp end atomic
-  !$omp atomic seq_cst, capture, update
-  x = x + 2
-  v = x
-  !$omp end atomic
   !$omp atomic read , seq_cst
   v = x
   !$omp atomic write ,seq_cst
@@ -58,10 +50,6 @@ subroutine foo ()
   x = x + 2
   v = x
   !$omp end atomic
-  !$omp atomic capture, seq_cst ,update
-  x = x + 2
-  v = x
-  !$omp end atomic
 end
 
 subroutine bar
@@ -78,10 +66,6 @@ subroutine bar
   i = i + 1
   !$omp atomic relaxed
   i = i + 1
-  !$omp atomic relaxed capture update
-  i = i + 1
-  v = i
-  !$omp end atomic
   !$omp atomic relaxed capture
   i = i + 1
   v = i
@@ -90,18 +74,10 @@ subroutine bar
   i = i + 1
   v = i
   !$omp end atomic
-  !$omp atomic update capture,release , hint (1)
-  i = i + 1
-  v = i
-  !$omp end atomic
   !$omp atomic hint(0),relaxed capture
   i = i + 1
   v = i
   !$omp end atomic
-  !$omp atomic hint(0),update relaxed capture
-  i = i + 1
-  v = i
-  !$omp end atomic
   !$omp atomic read acquire
   v = i
   !$omp atomic release,write
index a2b0f50ae73413573e922818c0548e861f4e816d..d90940d95dc7bc0f4efab953c748fe9dbb153572 100644 (file)
@@ -80,6 +80,6 @@ end subroutine
 ! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i5 =" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i5b =" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i6 =" 1 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp atomic acq_rel\[\n\r]\[^\n\r]*&i7 =" 1 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp atomic acq_rel\[\n\r]\[^\n\r]*&i7b =" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp atomic release\[\n\r]\[^\n\r]*&i7 =" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp atomic release\[\n\r]\[^\n\r]*&i7b =" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i8 =" 1 "original" } }