[flang-commits] [flang] 0ff9625 - [flang][OpenMP] Added atomic update assignment statement related semantic checks

Nimish Mishra via flang-commits flang-commits at lists.llvm.org
Tue Oct 3 07:18:04 PDT 2023


Author: Nimish Mishra
Date: 2023-10-03T19:47:53+05:30
New Revision: 0ff9625c0a15a80d2375c1ab6fb3fd8439b3c78b

URL: https://github.com/llvm/llvm-project/commit/0ff9625c0a15a80d2375c1ab6fb3fd8439b3c78b
DIFF: https://github.com/llvm/llvm-project/commit/0ff9625c0a15a80d2375c1ab6fb3fd8439b3c78b.diff

LOG: [flang][OpenMP] Added atomic update assignment statement related semantic checks

This patch adds the following semantic checks:

- None of expr, and expr_list (as applicable) may access the same storage location as x

- Atomic update statement should be of the form x = x operator expr or
x = expr operator x or x = intrinsic_procedure(x, expr_list) or x = intrinsic_procedure(expr_list, x)

- expr_list is a comma-separated, non-empty list of scalar expressions. If intrinsic_procedure_name
refers to IAND, IOR, or IEOR, exactly one expression must appear in expr_list

Reviewed By: TIFitis

Differential Revision: https://reviews.llvm.org/D128162

Added: 
    

Modified: 
    flang/lib/Semantics/check-omp-structure.cpp
    flang/test/Lower/OpenMP/FIR/atomic-update.f90
    flang/test/Semantics/OpenMP/atomic-hint-clause.f90
    flang/test/Semantics/OpenMP/atomic01.f90
    flang/test/Semantics/OpenMP/atomic02.f90
    flang/test/Semantics/OpenMP/atomic03.f90
    flang/test/Semantics/OpenMP/atomic04.f90
    flang/test/Semantics/OpenMP/atomic05.f90
    flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 7c5574541dc2a8e..4cb100a30244513 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1734,7 +1734,7 @@ bool OmpStructureChecker::IsOperatorValid(const T &node, const D &variable) {
     }
     return common::HasMember<T, AllowedBinaryOperators>;
   }
-  return true;
+  return false;
 }
 
 void OmpStructureChecker::CheckAtomicCaptureStmt(
@@ -1780,9 +1780,12 @@ void OmpStructureChecker::CheckAtomicUpdateStmt(
     const parser::AssignmentStmt &assignment) {
   const auto &expr{std::get<parser::Expr>(assignment.t)};
   const auto &var{std::get<parser::Variable>(assignment.t)};
+  bool isIntrinsicProcedure{false};
+  bool isValidOperator{false};
   common::visit(
       common::visitors{
           [&](const common::Indirection<parser::FunctionReference> &x) {
+            isIntrinsicProcedure = true;
             const auto &procedureDesignator{
                 std::get<parser::ProcedureDesignator>(x.value().v.t)};
             const parser::Name *name{
@@ -1794,46 +1797,61 @@ void OmpStructureChecker::CheckAtomicUpdateStmt(
               context_.Say(expr.source,
                   "Invalid intrinsic procedure name in "
                   "OpenMP ATOMIC (UPDATE) statement"_err_en_US);
-            } else if (name) {
-              bool foundMatch{false};
-              if (auto varDesignatorIndirection =
-                      std::get_if<Fortran::common::Indirection<
-                          Fortran::parser::Designator>>(&var.u)) {
-                const auto &varDesignator = varDesignatorIndirection->value();
-                if (const auto *dataRef = std::get_if<Fortran::parser::DataRef>(
-                        &varDesignator.u)) {
-                  if (const auto *name =
-                          std::get_if<Fortran::parser::Name>(&dataRef->u)) {
-                    const auto &varSymbol = *name->symbol;
-                    if (const auto *e{GetExpr(context_, expr)}) {
-                      for (const Symbol &symbol :
-                          evaluate::CollectSymbols(*e)) {
-                        if (symbol == varSymbol) {
-                          foundMatch = true;
-                          break;
-                        }
-                      }
-                    }
-                  }
-                }
-              }
-              if (!foundMatch) {
-                context_.Say(expr.source,
-                    "Atomic update variable '%s' not found in the "
-                    "argument list of intrinsic procedure"_err_en_US,
-                    var.GetSource().ToString());
-              }
             }
           },
           [&](const auto &x) {
             if (!IsOperatorValid(x, var)) {
               context_.Say(expr.source,
-                  "Invalid operator in OpenMP ATOMIC (UPDATE) "
+                  "Invalid or missing operator in atomic update "
                   "statement"_err_en_US);
-            }
+            } else
+              isValidOperator = true;
           },
       },
       expr.u);
+  if (const auto *e{GetExpr(context_, expr)}) {
+    const auto *v{GetExpr(context_, var)};
+    if (e->Rank() != 0)
+      context_.Say(expr.source,
+          "Expected scalar expression "
+          "on the RHS of atomic update assignment "
+          "statement"_err_en_US);
+    if (v->Rank() != 0)
+      context_.Say(var.GetSource(),
+          "Expected scalar variable "
+          "on the LHS of atomic update assignment "
+          "statement"_err_en_US);
+    const Symbol &varSymbol = evaluate::GetSymbolVector(*v).front();
+    int numOfSymbolMatches{0};
+    SymbolVector exprSymbols = evaluate::GetSymbolVector(*e);
+    for (const Symbol &symbol : exprSymbols) {
+      if (varSymbol == symbol)
+        numOfSymbolMatches++;
+    }
+    if (isIntrinsicProcedure) {
+      std::string varName = var.GetSource().ToString();
+      if (numOfSymbolMatches != 1)
+        context_.Say(expr.source,
+            "Intrinsic procedure"
+            " arguments in atomic update statement"
+            " must have exactly one occurence of '%s'"_err_en_US,
+            varName);
+      else if (varSymbol != exprSymbols.front() &&
+          varSymbol != exprSymbols.back())
+        context_.Say(expr.source,
+            "Atomic update statement "
+            "should be of the form `%s = intrinsic_procedure(%s, expr_list)` "
+            "OR `%s = intrinsic_procedure(expr_list, %s)`"_err_en_US,
+            varName, varName, varName, varName);
+    } else if (isValidOperator) {
+      if (numOfSymbolMatches != 1)
+        context_.Say(expr.source,
+            "Exactly one occurence of '%s' "
+            "expected on the RHS of atomic update assignment statement"_err_en_US,
+            var.GetSource().ToString());
+    }
+  }
+
   ErrIfAllocatableVariable(var);
 }
 

diff  --git a/flang/test/Lower/OpenMP/FIR/atomic-update.f90 b/flang/test/Lower/OpenMP/FIR/atomic-update.f90
index 0c3e25cb4831728..d0185d2f3b14dfe 100644
--- a/flang/test/Lower/OpenMP/FIR/atomic-update.f90
+++ b/flang/test/Lower/OpenMP/FIR/atomic-update.f90
@@ -69,8 +69,8 @@ program OmpAtomicUpdate
 !CHECK:  ^bb0(%[[ARG:.*]]: i32):
 !CHECK:    %[[LOADED_X:.*]] = fir.load %[[X]] : !fir.ref<i32>
 !CHECK:    %[[LOADED_Z:.*]] = fir.load %[[Z]] : !fir.ref<i32>
-!CHECK:    %{{.*}} = arith.cmpi sgt, %[[LOADED_X]], %[[ARG]] : i32
-!CHECK:    %{{.*}} = arith.select %{{.*}}, %[[LOADED_X]], %[[ARG]] : i32
+!CHECK:    %{{.*}} = arith.cmpi sgt, %[[ARG]], %[[LOADED_X]] : i32
+!CHECK:    %{{.*}} = arith.select %{{.*}}, %[[ARG]], %[[LOADED_X]] : i32
 !CHECK:    %{{.*}} = arith.cmpi sgt, %{{.*}}, %[[LOADED_Z]] : i32
 !CHECK:    %[[RESULT:.*]] = arith.select %{{.*}}, %{{.*}}, %[[LOADED_Z]] : i32
 !CHECK:    omp.yield(%[[RESULT]] : i32)
@@ -84,7 +84,7 @@ program OmpAtomicUpdate
     !$omp atomic relaxed update hint(omp_sync_hint_uncontended)
         x = x - 1
     !$omp atomic update relaxed 
-        y = max(x, y, z)
+        y = max(y, x, z)
     !$omp atomic relaxed hint(omp_sync_hint_contended)
         z = z + x
 

diff  --git a/flang/test/Semantics/OpenMP/atomic-hint-clause.f90 b/flang/test/Semantics/OpenMP/atomic-hint-clause.f90
index 3f8fe4953c559f7..5341fb2e7d2885e 100644
--- a/flang/test/Semantics/OpenMP/atomic-hint-clause.f90
+++ b/flang/test/Semantics/OpenMP/atomic-hint-clause.f90
@@ -19,7 +19,7 @@ program sample
         y = y + 10
     
     !$omp atomic update hint(5)
-        y = x
+        y = x + y
     
     !ERROR: Hint clause value is not a valid OpenMP synchronization value
     !$omp atomic hint(7) capture

diff  --git a/flang/test/Semantics/OpenMP/atomic01.f90 b/flang/test/Semantics/OpenMP/atomic01.f90
index 79f69e5843e82ff..5469f82a0083cae 100644
--- a/flang/test/Semantics/OpenMP/atomic01.f90
+++ b/flang/test/Semantics/OpenMP/atomic01.f90
@@ -55,40 +55,49 @@
   !ERROR: More than one memory order clause not allowed on OpenMP Atomic construct
   !ERROR: At most one SEQ_CST clause can appear on the UPDATE directive
   !$omp atomic seq_cst seq_cst update
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
   !ERROR: More than one memory order clause not allowed on OpenMP Atomic construct
   !ERROR: At most one SEQ_CST clause can appear on the UPDATE directive
   !$omp atomic update seq_cst seq_cst
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
   !ERROR: More than one memory order clause not allowed on OpenMP Atomic construct
   !ERROR: At most one SEQ_CST clause can appear on the UPDATE directive
   !$omp atomic seq_cst update seq_cst
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
 
   !ERROR: More than one memory order clause not allowed on OpenMP Atomic construct
   !ERROR: At most one RELEASE clause can appear on the UPDATE directive
   !$omp atomic release release update
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
   !ERROR: More than one memory order clause not allowed on OpenMP Atomic construct
   !ERROR: At most one RELEASE clause can appear on the UPDATE directive
   !$omp atomic update release release
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
   !ERROR: More than one memory order clause not allowed on OpenMP Atomic construct
   !ERROR: At most one RELEASE clause can appear on the UPDATE directive
   !$omp atomic release update release
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
 
   !ERROR: More than one memory order clause not allowed on OpenMP Atomic construct
   !ERROR: At most one RELAXED clause can appear on the UPDATE directive
   !$omp atomic relaxed relaxed update
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
   !ERROR: More than one memory order clause not allowed on OpenMP Atomic construct
   !ERROR: At most one RELAXED clause can appear on the UPDATE directive
   !$omp atomic update relaxed relaxed
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
   !ERROR: More than one memory order clause not allowed on OpenMP Atomic construct
   !ERROR: At most one RELAXED clause can appear on the UPDATE directive
   !$omp atomic relaxed update relaxed
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
 
 !CAPTURE
@@ -240,14 +249,17 @@
   !ERROR: More than one memory order clause not allowed on OpenMP Atomic construct
   !ERROR: At most one RELAXED clause can appear on the ATOMIC directive
   !$omp atomic relaxed relaxed
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
   !ERROR: More than one memory order clause not allowed on OpenMP Atomic construct
   !ERROR: At most one SEQ_CST clause can appear on the ATOMIC directive
   !$omp atomic seq_cst seq_cst
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
   !ERROR: More than one memory order clause not allowed on OpenMP Atomic construct
   !ERROR: At most one RELEASE clause can appear on the ATOMIC directive
   !$omp atomic release release
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
 
 ! 2.17.7.3
@@ -282,21 +294,27 @@
     i = j
   !ERROR: At most one HINT clause can appear on the UPDATE directive
   !$omp atomic hint(omp_sync_hint_contended) hint(omp_sync_hint_speculative) update
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
   !ERROR: At most one HINT clause can appear on the UPDATE directive
   !$omp atomic hint(omp_sync_hint_nonspeculative) update hint(omp_sync_hint_nonspeculative)
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
   !ERROR: At most one HINT clause can appear on the UPDATE directive
   !$omp atomic update hint(omp_sync_hint_none) hint (omp_sync_hint_uncontended)
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
   !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic hint(omp_sync_hint_contended) hint(omp_sync_hint_speculative)
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
   !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic hint(omp_sync_hint_none) hint(omp_sync_hint_nonspeculative)
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
   !ERROR: At most one HINT clause can appear on the ATOMIC directive
   !$omp atomic hint(omp_sync_hint_none) hint (omp_sync_hint_uncontended)
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
 
   !ERROR: At most one HINT clause can appear on the CAPTURE directive
@@ -354,25 +372,31 @@
 
   !ERROR: Clause ACQ_REL is not allowed if clause UPDATE appears on the ATOMIC directive
   !$omp atomic acq_rel update
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
   !ERROR: Clause ACQ_REL is not allowed if clause UPDATE appears on the ATOMIC directive
   !$omp atomic update acq_rel
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
 
   !ERROR: Clause ACQUIRE is not allowed if clause UPDATE appears on the ATOMIC directive
   !$omp atomic acquire update
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
 
   !ERROR: Clause ACQUIRE is not allowed if clause UPDATE appears on the ATOMIC directive
   !$omp atomic update acquire
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
 
   !ERROR: Clause ACQ_REL is not allowed on the ATOMIC directive
   !$omp atomic acq_rel
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
 
   !ERROR: Clause ACQUIRE is not allowed on the ATOMIC directive
   !$omp atomic acquire
+  !ERROR: Invalid or missing operator in atomic update statement
     i = j
 end program
 

diff  --git a/flang/test/Semantics/OpenMP/atomic02.f90 b/flang/test/Semantics/OpenMP/atomic02.f90
index 241c27a31dd942a..c11622c87cbd35a 100644
--- a/flang/test/Semantics/OpenMP/atomic02.f90
+++ b/flang/test/Semantics/OpenMP/atomic02.f90
@@ -26,34 +26,34 @@ program OmpAtomic
    !$omp atomic
    a = a/(b + 1)
    !$omp atomic
-   !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Invalid or missing operator in atomic update statement
    a = a**4
    !$omp atomic
-   !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Invalid or missing operator in atomic update statement
    c = c//d
    !$omp atomic
    !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Invalid or missing operator in atomic update statement
    l = a .LT. b
    !$omp atomic
    !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Invalid or missing operator in atomic update statement
    l = a .LE. b
    !$omp atomic
    !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Invalid or missing operator in atomic update statement
    l = a .EQ. b
    !$omp atomic
    !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Invalid or missing operator in atomic update statement
    l = a .NE. b
    !$omp atomic
    !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Invalid or missing operator in atomic update statement
    l = a .GE. b
    !$omp atomic
    !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Invalid or missing operator in atomic update statement
    l = a .GT. b
    !$omp atomic
    m = m .AND. n
@@ -72,30 +72,30 @@ program OmpAtomic
    !$omp atomic update
    a = a/(b + 1)
    !$omp atomic update
-   !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Invalid or missing operator in atomic update statement
    a = a**4
    !$omp atomic update
-   !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Invalid or missing operator in atomic update statement
    c = c//d
    !$omp atomic update
    !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Invalid or missing operator in atomic update statement
    l = a .LT. b
    !$omp atomic update
    !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Invalid or missing operator in atomic update statement
    l = a .LE. b
    !$omp atomic update
    !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Invalid or missing operator in atomic update statement
    l = a .EQ. b
    !$omp atomic update
    !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Invalid or missing operator in atomic update statement
    l = a .GE. b
    !$omp atomic update
    !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
-   !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Invalid or missing operator in atomic update statement
    l = a .GT. b
    !$omp atomic update
    m = m .AND. n

diff  --git a/flang/test/Semantics/OpenMP/atomic03.f90 b/flang/test/Semantics/OpenMP/atomic03.f90
index f829e78426e5a41..5fc642088ca56f8 100644
--- a/flang/test/Semantics/OpenMP/atomic03.f90
+++ b/flang/test/Semantics/OpenMP/atomic03.f90
@@ -23,26 +23,28 @@ program OmpAtomic
    y = MIN(y, 8)
 
 !$omp atomic
-   !ERROR: Atomic update variable 'z' not found in the argument list of intrinsic procedure
+   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
    z = IAND(y, 4)
 !$omp atomic
-   !ERROR: Atomic update variable 'z' not found in the argument list of intrinsic procedure
+   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
    z = IOR(y, 5)
 !$omp atomic
-   !ERROR: Atomic update variable 'z' not found in the argument list of intrinsic procedure
+   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
    z = IEOR(y, 6)
 !$omp atomic
-   !ERROR: Atomic update variable 'z' not found in the argument list of intrinsic procedure
+   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
    z = MAX(y, 7, b, c)
 !$omp atomic
-   !ERROR: Atomic update variable 'z' not found in the argument list of intrinsic procedure
+   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
    z = MIN(y, 8, a, d)
 
 !$omp atomic
    !ERROR: Invalid intrinsic procedure name in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'y'
    y = FRACTION(x)
 !$omp atomic
    !ERROR: Invalid intrinsic procedure name in OpenMP ATOMIC (UPDATE) statement
+   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'y'
    y = REAL(x)
 !$omp atomic update
    y = IAND(y, 4)
@@ -56,19 +58,19 @@ program OmpAtomic
    y = MIN(y, 8)
 
 !$omp atomic update
-   !ERROR: Atomic update variable 'z' not found in the argument list of intrinsic procedure
+   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
    z = IAND(y, 4)
-!$omp atomic update
-   !ERROR: Atomic update variable 'z' not found in the argument list of intrinsic procedure
+!$omp atomic update 
+   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
    z = IOR(y, 5)
 !$omp atomic update
-   !ERROR: Atomic update variable 'z' not found in the argument list of intrinsic procedure
+   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
    z = IEOR(y, 6)
 !$omp atomic update
-   !ERROR: Atomic update variable 'z' not found in the argument list of intrinsic procedure
+   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
    z = MAX(y, 7)
 !$omp atomic update
-   !ERROR: Atomic update variable 'z' not found in the argument list of intrinsic procedure
+   !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
    z = MIN(y, 8)
 
 !$omp atomic update
@@ -88,6 +90,53 @@ subroutine conflicting_types()
     type(simple) ::s
     z = 1
     !$omp atomic
-    !ERROR: Atomic update variable 'z' not found in the argument list of intrinsic procedure
+    !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'z'
     z = IAND(s%z, 4)
 end subroutine
+
+subroutine more_invalid_atomic_update_stmts()
+    integer :: a, b
+    integer :: k(10)
+    type some_type
+        integer :: m(10)
+    end type
+    type(some_type) :: s
+ 
+    !$omp atomic update
+    !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'a'
+        a = min(a, a, b)
+     
+    !$omp atomic
+    !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'a'
+        a = max(b, a, b, a)
+
+    !$omp atomic
+    !ERROR: Atomic update statement should be of the form `a = intrinsic_procedure(a, expr_list)` OR `a = intrinsic_procedure(expr_list, a)`
+        a = min(b, a, b)
+
+    !$omp atomic
+    !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'a'
+        a = max(b, a, b, a, b)
+    
+    !$omp atomic update
+    !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'y'
+        y = min(z, x)
+     
+    !$omp atomic
+        z = max(z, y)
+
+    !$omp atomic update
+    !ERROR: Expected scalar variable on the LHS of atomic update assignment statement
+    !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'k'
+        k = max(x, y)
+    
+    !$omp atomic
+    !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar REAL(4) and rank 1 array of REAL(4)
+    !ERROR: Expected scalar expression on the RHS of atomic update assignment statement
+        x = min(x, k)
+
+    !$omp atomic
+    !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar REAL(4) and rank 1 array of REAL(4)
+    !ERROR: Expected scalar expression on the RHS of atomic update assignment statement
+        z =z + s%m
+end subroutine

diff  --git a/flang/test/Semantics/OpenMP/atomic04.f90 b/flang/test/Semantics/OpenMP/atomic04.f90
index 9ac8ddee8846156..ddf6b8bc2f5f6fd 100644
--- a/flang/test/Semantics/OpenMP/atomic04.f90
+++ b/flang/test/Semantics/OpenMP/atomic04.f90
@@ -19,21 +19,24 @@ program OmpAtomic
    x = 1 + x
 !$omp atomic
    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
+   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
    x = y + 1
 !$omp atomic
    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   x = 1 + (y + x)
+   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   x = 1 + y
 
 !$omp atomic
-   !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   x = 1 - (10 * (y + x))
+   x = x - 1
 !$omp atomic
    x = 1 - x
 !$omp atomic
    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
+   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
    x = y - 1
 !$omp atomic
    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
+   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
    x = 1 - y
 
 !$omp atomic
@@ -42,10 +45,12 @@ program OmpAtomic
    x = 1*x
 !$omp atomic
    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   x = y*(10 + x)
+   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   x = y*1
 !$omp atomic
    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   x = (44 * x) * y
+   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   x = 1*y
 
 !$omp atomic
    x = x/1
@@ -53,25 +58,29 @@ program OmpAtomic
    x = 1/x
 !$omp atomic
    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
+   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
    x = y/1
 !$omp atomic
    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
+   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
    x = 1/y
 
 !$omp atomic
    m = m .AND. n
 !$omp atomic
    m = n .AND. m
-!$omp atomic
+!$omp atomic 
    !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m`
+   !ERROR: Exactly one occurence of 'm' expected on the RHS of atomic update assignment statement
    m = n .AND. l
 
 !$omp atomic
    m = m .OR. n
 !$omp atomic
    m = n .OR. m
-!$omp atomic
+!$omp atomic 
    !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m`
+   !ERROR: Exactly one occurence of 'm' expected on the RHS of atomic update assignment statement
    m = n .OR. l
 
 !$omp atomic
@@ -80,6 +89,7 @@ program OmpAtomic
    m = n .EQV. m
 !$omp atomic
    !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m`
+   !ERROR: Exactly one occurence of 'm' expected on the RHS of atomic update assignment statement
    m = n .EQV. l
 
 !$omp atomic
@@ -88,6 +98,7 @@ program OmpAtomic
    m = n .NEQV. m
 !$omp atomic
    !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m`
+   !ERROR: Exactly one occurence of 'm' expected on the RHS of atomic update assignment statement
    m = n .NEQV. l
 
 !$omp atomic update
@@ -96,9 +107,11 @@ program OmpAtomic
    x = 1 + x
 !$omp atomic update
    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
+   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
    x = y + 1
 !$omp atomic update
    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
+   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
    x = 1 + y
 
 !$omp atomic update
@@ -107,9 +120,11 @@ program OmpAtomic
    x = 1 - x
 !$omp atomic update
    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
+   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
    x = y - 1
 !$omp atomic update
    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
+   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
    x = 1 - y
 
 !$omp atomic update
@@ -118,9 +133,11 @@ program OmpAtomic
    x = 1*x
 !$omp atomic update
    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
+   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
    x = y*1
 !$omp atomic update
    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
+   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
    x = 1*y
 
 !$omp atomic update
@@ -129,10 +146,12 @@ program OmpAtomic
    x = 1/x
 !$omp atomic update
    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   x = max(x, y) + 10
+   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   x = y/1
 !$omp atomic update
    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
-   x = y * min(x, y)
+   !ERROR: Exactly one occurence of 'x' expected on the RHS of atomic update assignment statement
+   x = 1/y
 
 !$omp atomic update
    m = m .AND. n
@@ -140,6 +159,7 @@ program OmpAtomic
    m = n .AND. m
 !$omp atomic update
    !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m`
+   !ERROR: Exactly one occurence of 'm' expected on the RHS of atomic update assignment statement
    m = n .AND. l
 
 !$omp atomic update
@@ -148,6 +168,7 @@ program OmpAtomic
    m = n .OR. m
 !$omp atomic update
    !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m`
+   !ERROR: Exactly one occurence of 'm' expected on the RHS of atomic update assignment statement
    m = n .OR. l
 
 !$omp atomic update
@@ -156,6 +177,7 @@ program OmpAtomic
    m = n .EQV. m
 !$omp atomic update
    !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m`
+   !ERROR: Exactly one occurence of 'm' expected on the RHS of atomic update assignment statement
    m = n .EQV. l
 
 !$omp atomic update
@@ -164,6 +186,78 @@ program OmpAtomic
    m = n .NEQV. m
 !$omp atomic update
    !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m`
+   !ERROR: Exactly one occurence of 'm' expected on the RHS of atomic update assignment statement
    m = n .NEQV. l
 
 end program OmpAtomic
+
+subroutine more_invalid_atomic_update_stmts()
+    integer :: a, b, c
+    integer :: d(10)
+    real :: x, y, z(10)
+    type some_type
+        real :: m
+        real :: n(10)
+    end type
+    type(some_type) p
+    
+    !$omp atomic
+    !ERROR: Invalid or missing operator in atomic update statement
+        x = x
+
+    !$omp atomic update
+    !ERROR: Invalid or missing operator in atomic update statement
+        x = 1    
+
+    !$omp atomic update
+    !ERROR: Exactly one occurence of 'a' expected on the RHS of atomic update assignment statement
+        a = a * b + a
+
+    !$omp atomic
+    !ERROR: Atomic update statement should be of form `a = a operator expr` OR `a = expr operator a`
+        a = b * (a + 9)
+
+    !$omp atomic update
+    !ERROR: Exactly one occurence of 'a' expected on the RHS of atomic update assignment statement
+        a = a * (a + b)
+
+    !$omp atomic
+    !ERROR: Exactly one occurence of 'a' expected on the RHS of atomic update assignment statement
+        a = (b + a) * a
+
+    !$omp atomic
+    !ERROR: Atomic update statement should be of form `a = a operator expr` OR `a = expr operator a`
+        a = a * b + c
+
+    !$omp atomic update
+    !ERROR: Atomic update statement should be of form `a = a operator expr` OR `a = expr operator a`
+        a = a + b + c
+
+    !$omp atomic
+        a = b * c + a
+
+    !$omp atomic update
+        a = c + b + a
+
+    !$omp atomic
+    !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar INTEGER(4) and rank 1 array of INTEGER(4)
+    !ERROR: Expected scalar expression on the RHS of atomic update assignment statement
+        a = a + d
+
+    !$omp atomic update
+    !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar REAL(4) and rank 1 array of REAL(4)
+    !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x`
+    !ERROR: Expected scalar expression on the RHS of atomic update assignment statement
+        x = x * y / z
+
+    !$omp atomic
+    !ERROR: Atomic update statement should be of form `p%m = p%m operator expr` OR `p%m = expr operator p%m`
+    !ERROR: Exactly one occurence of 'p%m' expected on the RHS of atomic update assignment statement
+        p%m = x + y
+
+    !$omp atomic update
+    !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar REAL(4) and rank 1 array of REAL(4)
+    !ERROR: Expected scalar expression on the RHS of atomic update assignment statement
+    !ERROR: Exactly one occurence of 'p%m' expected on the RHS of atomic update assignment statement
+        p%m = p%m + p%n
+end subroutine

diff  --git a/flang/test/Semantics/OpenMP/atomic05.f90 b/flang/test/Semantics/OpenMP/atomic05.f90
index 70492675e61e182..b3ff6e9b910f4f1 100644
--- a/flang/test/Semantics/OpenMP/atomic05.f90
+++ b/flang/test/Semantics/OpenMP/atomic05.f90
@@ -17,6 +17,7 @@ program OmpAtomic
         x = 2 * 4
     !ERROR: More than one memory order clause not allowed on OpenMP Atomic construct
     !$omp atomic update release, seq_cst
+    !ERROR: Invalid or missing operator in atomic update statement
         x = 10
     !ERROR: More than one memory order clause not allowed on OpenMP Atomic construct
     !$omp atomic capture release, seq_cst

diff  --git a/flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90 b/flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90
index 3ba54a32638b511..7e2d508839ff606 100644
--- a/flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90
+++ b/flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90
@@ -36,10 +36,9 @@ program sample
     !ERROR: k must not have ALLOCATABLE attribute
         k = x
 
-    !$omp atomic update 
-    !ERROR: Atomic update statement should be of form `k = k operator expr` OR `k = expr operator k`
+    !$omp atomic update
     !ERROR: k must not have ALLOCATABLE attribute
-        k = v + k * (v * k)
+        k = k + x * (v * x)
 
     !$omp atomic
     !ERROR: k must not have ALLOCATABLE attribute


        


More information about the flang-commits mailing list