Fortran: OpenMP - fixes for omp atomic [PR97655]

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.

4 files changed, 58 insertions, 43 deletions

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 608ff5a..6cb4f28 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -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);
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90
index 5094caa..1de418d 100644
--- a/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic.f90
index 8a1cf5b..b4caf03 100644
--- a/gcc/testsuite/gfortran.dg/gomp/atomic.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-9.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-9.f90
index a2b0f50..d90940d 100644
--- a/gcc/testsuite/gfortran.dg/gomp/requires-9.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-9.f90
@@ -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" } }