[flang-commits] [flang] [flang][openacc] Check atomic update lhs/rhs are scalar (PR #66113)

[Valentin Clement バレンタイン クレメン via flang-commits]

https://github.com/clementval created https://github.com/llvm/llvm-project/pull/66113:

Add semantic check for `!$acc atomic update`. RHS and LHS of the update assignment must be scalar. 

>From 4dfe2a3619968803fc2f49b588ce593dcb7b6ac2 Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval at gmail.com>
Date: Tue, 12 Sep 2023 10:25:40 -0700
Subject: [PATCH] [flang][openacc] Check atomic update lhs/rhs are scalar

---
 flang/lib/Semantics/check-acc-structure.cpp     | 17 +++++++++++++++++
 flang/lib/Semantics/check-acc-structure.h       |  1 +
 .../Semantics/OpenACC/acc-atomic-validity.f90   |  7 +++++++
 3 files changed, 25 insertions(+)

diff --git a/flang/lib/Semantics/check-acc-structure.cpp b/flang/lib/Semantics/check-acc-structure.cpp
index 4ae034736a40b09..3c9e89940d23784 100644
--- a/flang/lib/Semantics/check-acc-structure.cpp
+++ b/flang/lib/Semantics/check-acc-structure.cpp
@@ -331,6 +331,23 @@ void AccStructureChecker::Leave(const parser::OpenACCAtomicConstruct &x) {
   dirContext_.pop_back();
 }
 
+void AccStructureChecker::Enter(const parser::AccAtomicUpdate &x) {
+  const parser::AssignmentStmt &assignment{
+      std::get<parser::Statement<parser::AssignmentStmt>>(x.t).statement};
+  const auto &var{std::get<parser::Variable>(assignment.t)};
+  const auto &expr{std::get<parser::Expr>(assignment.t)};
+  const auto *rhs{GetExpr(context_, expr)};
+  const auto *lhs{GetExpr(context_, var)};
+  if (lhs && rhs) {
+    if (lhs->Rank() != 0)
+      context_.Say(expr.source,
+          "LHS of atomic update statement must be scalar"_err_en_US);
+    if (rhs->Rank() != 0)
+      context_.Say(var.GetSource(),
+          "RHS of atomic update statement must be scalar"_err_en_US);
+  }
+}
+
 void AccStructureChecker::Enter(const parser::OpenACCCacheConstruct &x) {
   const auto &verbatim = std::get<parser::Verbatim>(x.t);
   PushContextAndClauseSets(verbatim.source, llvm::acc::Directive::ACCD_cache);
diff --git a/flang/lib/Semantics/check-acc-structure.h b/flang/lib/Semantics/check-acc-structure.h
index 6d05acba92cb268..8b87b8ddc502f3f 100644
--- a/flang/lib/Semantics/check-acc-structure.h
+++ b/flang/lib/Semantics/check-acc-structure.h
@@ -62,6 +62,7 @@ class AccStructureChecker
   void Leave(const parser::OpenACCAtomicConstruct &);
   void Enter(const parser::OpenACCCacheConstruct &);
   void Leave(const parser::OpenACCCacheConstruct &);
+  void Enter(const parser::AccAtomicUpdate &);
 
   // Clauses
   void Leave(const parser::AccClauseList &);
diff --git a/flang/test/Semantics/OpenACC/acc-atomic-validity.f90 b/flang/test/Semantics/OpenACC/acc-atomic-validity.f90
index e6d82a77f6c1bc6..ba68031b0f18bc7 100644
--- a/flang/test/Semantics/OpenACC/acc-atomic-validity.f90
+++ b/flang/test/Semantics/OpenACC/acc-atomic-validity.f90
@@ -11,6 +11,7 @@ program openacc_atomic_validity
   integer, parameter :: N = 256
   integer, dimension(N) :: c
 
+
   !$acc parallel
   !$acc atomic update
   c(i) = c(i) + 1
@@ -37,6 +38,12 @@ program openacc_atomic_validity
   c(i) = i
   i = i + 1
   !$acc end atomic
+
+  !$acc atomic update
+  !ERROR: RHS of atomic update statement must be scalar
+  !ERROR: LHS of atomic update statement must be scalar
+  c = c + 1
+
   !$acc end parallel
 
 end program openacc_atomic_validity