[flang-commits] [flang] [flang][OpenMP] Add diagnostic for ATOMIC WRITE with pointer to non-intrinsic type (PR #162364)

Krish Gupta via flang-commits flang-commits at lists.llvm.org
Tue Oct 14 13:13:04 PDT 2025


https://github.com/KrxGu updated https://github.com/llvm/llvm-project/pull/162364

>From 022dd654f5735fd4ee159f3595723b0ec952d064 Mon Sep 17 00:00:00 2001
From: Krish Gupta <krishgupta at Krishs-MacBook-Air.local>
Date: Wed, 8 Oct 2025 01:39:02 +0530
Subject: [PATCH 1/2] [flang][OpenMP] Add diagnostic for ATOMIC WRITE with
 pointer to non-intrinsic type

Fixes #161932
---
 flang/lib/Semantics/check-omp-atomic.cpp      | 42 ++++++++++++++++---
 flang/lib/Semantics/check-omp-structure.h     |  2 +
 .../omp-atomic-write-pointer-derived.f90      |  8 ++++
 3 files changed, 47 insertions(+), 5 deletions(-)
 create mode 100644 flang/test/Semantics/OpenMP/omp-atomic-write-pointer-derived.f90

diff --git a/flang/lib/Semantics/check-omp-atomic.cpp b/flang/lib/Semantics/check-omp-atomic.cpp
index 351af5c099aee..345b34ccce06d 100644
--- a/flang/lib/Semantics/check-omp-atomic.cpp
+++ b/flang/lib/Semantics/check-omp-atomic.cpp
@@ -580,6 +580,38 @@ void OmpStructureChecker::CheckAtomicVariable(
   }
 }
 
+void OmpStructureChecker::CheckAtomicVariable(const SomeExpr &atom,
+    parser::CharBlock source, const evaluate::Assignment &assign) {
+  // First do all the standard checks
+  CheckAtomicVariable(atom, source);
+
+  // For intrinsic assignment, check if the variable is a pointer
+  // to a non-intrinsic type, which is not allowed in atomic operations
+  if (!IsPointerAssignment(assign)) {
+    std::vector<SomeExpr> dsgs{GetAllDesignators(atom)};
+    if (!dsgs.empty()) {
+      evaluate::SymbolVector syms{evaluate::GetSymbolVector(dsgs.front())};
+      if (!syms.empty() && IsPointer(syms.back())) {
+        SymbolRef sym = syms.back();
+        if (const DeclTypeSpec *typeSpec{sym->GetType()}) {
+          using Category = DeclTypeSpec::Category;
+          Category cat{typeSpec->category()};
+          if (cat != Category::Numeric && cat != Category::Logical) {
+            std::string details = " has the POINTER attribute";
+            if (const auto *derived{typeSpec->AsDerived()}) {
+              details +=
+                  " and derived type '"s + derived->name().ToString() + "'";
+            }
+            context_.Say(source,
+                "ATOMIC operation requires an intrinsic scalar variable; '%s'%s"_err_en_US,
+                sym->name(), details);
+          }
+        }
+      }
+    }
+  }
+}
+
 void OmpStructureChecker::CheckStorageOverlap(const SomeExpr &base,
     llvm::ArrayRef<evaluate::Expr<evaluate::SomeType>> exprs,
     parser::CharBlock source) {
@@ -789,7 +821,7 @@ void OmpStructureChecker::CheckAtomicCaptureAssignment(
   if (!IsVarOrFunctionRef(atom)) {
     ErrorShouldBeVariable(atom, rsrc);
   } else {
-    CheckAtomicVariable(atom, rsrc);
+    CheckAtomicVariable(atom, rsrc, capture);
     // This part should have been checked prior to calling this function.
     assert(*GetConvertInput(capture.rhs) == atom &&
         "This cannot be a capture assignment");
@@ -808,7 +840,7 @@ void OmpStructureChecker::CheckAtomicReadAssignment(
     if (!IsVarOrFunctionRef(atom)) {
       ErrorShouldBeVariable(atom, rsrc);
     } else {
-      CheckAtomicVariable(atom, rsrc);
+      CheckAtomicVariable(atom, rsrc, read);
       CheckStorageOverlap(atom, {read.lhs}, source);
     }
   } else {
@@ -829,7 +861,7 @@ void OmpStructureChecker::CheckAtomicWriteAssignment(
   if (!IsVarOrFunctionRef(atom)) {
     ErrorShouldBeVariable(atom, rsrc);
   } else {
-    CheckAtomicVariable(atom, lsrc);
+    CheckAtomicVariable(atom, lsrc, write);
     CheckStorageOverlap(atom, {write.rhs}, source);
   }
 }
@@ -854,7 +886,7 @@ OmpStructureChecker::CheckAtomicUpdateAssignment(
     return std::nullopt;
   }
 
-  CheckAtomicVariable(atom, lsrc);
+  CheckAtomicVariable(atom, lsrc, update);
 
   auto [hasErrors, tryReassoc]{CheckAtomicUpdateAssignmentRhs(
       atom, update.rhs, source, /*suppressDiagnostics=*/true)};
@@ -1017,7 +1049,7 @@ void OmpStructureChecker::CheckAtomicConditionalUpdateAssignment(
     return;
   }
 
-  CheckAtomicVariable(atom, alsrc);
+  CheckAtomicVariable(atom, alsrc, assign);
 
   auto top{GetTopLevelOperationIgnoreResizing(cond)};
   // Missing arguments to operations would have been diagnosed by now.
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index f507278fba5f2..d273929987f09 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -266,6 +266,8 @@ class OmpStructureChecker
       SymbolRef sym, parser::CharBlock source, std::string_view name);
   void CheckAtomicVariable(
       const evaluate::Expr<evaluate::SomeType> &, parser::CharBlock);
+  void CheckAtomicVariable(const evaluate::Expr<evaluate::SomeType> &,
+      parser::CharBlock, const evaluate::Assignment &);
   std::pair<const parser::ExecutionPartConstruct *,
       const parser::ExecutionPartConstruct *>
   CheckUpdateCapture(const parser::ExecutionPartConstruct *ec1,
diff --git a/flang/test/Semantics/OpenMP/omp-atomic-write-pointer-derived.f90 b/flang/test/Semantics/OpenMP/omp-atomic-write-pointer-derived.f90
new file mode 100644
index 0000000000000..d1ca2308047ad
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/omp-atomic-write-pointer-derived.f90
@@ -0,0 +1,8 @@
+! RUN: not %flang_fc1 -fopenmp -fsyntax-only %s 2>&1 | FileCheck %s
+type t
+end type
+type(t), pointer :: a1, a2
+!$omp atomic write
+a1 = a2
+! CHECK: error: ATOMIC WRITE requires an intrinsic scalar variable; 'a1' has the POINTER attribute and derived type 't'
+end

>From 65472a5aab54ebf100f838e72552d8c3f7109b30 Mon Sep 17 00:00:00 2001
From: Krish Gupta <krishgupta at Krishs-MacBook-Air.local>
Date: Sun, 12 Oct 2025 11:58:01 +0530
Subject: [PATCH 2/2] [flang][OpenMP] Centralize pointer-to-non-intrinsic check
 via bool flag

---
 flang/lib/Semantics/check-omp-atomic.cpp      | 71 ++++++++-----------
 flang/lib/Semantics/check-omp-structure.h     |  8 +--
 .../omp-atomic-write-pointer-derived.f90      |  2 +-
 3 files changed, 34 insertions(+), 47 deletions(-)

diff --git a/flang/lib/Semantics/check-omp-atomic.cpp b/flang/lib/Semantics/check-omp-atomic.cpp
index 345b34ccce06d..515121af04d56 100644
--- a/flang/lib/Semantics/check-omp-atomic.cpp
+++ b/flang/lib/Semantics/check-omp-atomic.cpp
@@ -519,8 +519,8 @@ struct AtomicAnalysis {
 ///   function references with scalar data pointer result of non-character
 ///   intrinsic type or variables that are non-polymorphic scalar pointers
 ///   and any length type parameter must be constant.
-void OmpStructureChecker::CheckAtomicType(
-    SymbolRef sym, parser::CharBlock source, std::string_view name) {
+void OmpStructureChecker::CheckAtomicType(SymbolRef sym,
+    parser::CharBlock source, std::string_view name, bool checkTypeOnPointer) {
   const DeclTypeSpec *typeSpec{sym->GetType()};
   if (!typeSpec) {
     return;
@@ -547,6 +547,22 @@ void OmpStructureChecker::CheckAtomicType(
     return;
   }
 
+  // Apply pointer-to-non-intrinsic rule only for intrinsic-assignment paths.
+  if (checkTypeOnPointer) {
+    using Category = DeclTypeSpec::Category;
+    Category cat{typeSpec->category()};
+    if (cat != Category::Numeric && cat != Category::Logical) {
+      std::string details = " has the POINTER attribute";
+      if (const auto *derived{typeSpec->AsDerived()}) {
+        details += " and derived type '"s + derived->name().ToString() + "'";
+      }
+      context_.Say(source,
+          "ATOMIC operation requires an intrinsic scalar variable; '%s'%s"_err_en_US,
+          sym->name(), details);
+      return;
+    }
+  }
+
   // Go over all length parameters, if any, and check if they are
   // explicit.
   if (const DerivedTypeSpec *derived{typeSpec->AsDerived()}) {
@@ -562,7 +578,7 @@ void OmpStructureChecker::CheckAtomicType(
 }
 
 void OmpStructureChecker::CheckAtomicVariable(
-    const SomeExpr &atom, parser::CharBlock source) {
+    const SomeExpr &atom, parser::CharBlock source, bool checkTypeOnPointer) {
   if (atom.Rank() != 0) {
     context_.Say(source, "Atomic variable %s should be a scalar"_err_en_US,
         atom.AsFortran());
@@ -572,7 +588,7 @@ void OmpStructureChecker::CheckAtomicVariable(
   assert(dsgs.size() == 1 && "Should have a single top-level designator");
   evaluate::SymbolVector syms{evaluate::GetSymbolVector(dsgs.front())};
 
-  CheckAtomicType(syms.back(), source, atom.AsFortran());
+  CheckAtomicType(syms.back(), source, atom.AsFortran(), checkTypeOnPointer);
 
   if (IsAllocatable(syms.back()) && !IsArrayElement(atom)) {
     context_.Say(source, "Atomic variable %s cannot be ALLOCATABLE"_err_en_US,
@@ -580,38 +596,6 @@ void OmpStructureChecker::CheckAtomicVariable(
   }
 }
 
-void OmpStructureChecker::CheckAtomicVariable(const SomeExpr &atom,
-    parser::CharBlock source, const evaluate::Assignment &assign) {
-  // First do all the standard checks
-  CheckAtomicVariable(atom, source);
-
-  // For intrinsic assignment, check if the variable is a pointer
-  // to a non-intrinsic type, which is not allowed in atomic operations
-  if (!IsPointerAssignment(assign)) {
-    std::vector<SomeExpr> dsgs{GetAllDesignators(atom)};
-    if (!dsgs.empty()) {
-      evaluate::SymbolVector syms{evaluate::GetSymbolVector(dsgs.front())};
-      if (!syms.empty() && IsPointer(syms.back())) {
-        SymbolRef sym = syms.back();
-        if (const DeclTypeSpec *typeSpec{sym->GetType()}) {
-          using Category = DeclTypeSpec::Category;
-          Category cat{typeSpec->category()};
-          if (cat != Category::Numeric && cat != Category::Logical) {
-            std::string details = " has the POINTER attribute";
-            if (const auto *derived{typeSpec->AsDerived()}) {
-              details +=
-                  " and derived type '"s + derived->name().ToString() + "'";
-            }
-            context_.Say(source,
-                "ATOMIC operation requires an intrinsic scalar variable; '%s'%s"_err_en_US,
-                sym->name(), details);
-          }
-        }
-      }
-    }
-  }
-}
-
 void OmpStructureChecker::CheckStorageOverlap(const SomeExpr &base,
     llvm::ArrayRef<evaluate::Expr<evaluate::SomeType>> exprs,
     parser::CharBlock source) {
@@ -821,7 +805,8 @@ void OmpStructureChecker::CheckAtomicCaptureAssignment(
   if (!IsVarOrFunctionRef(atom)) {
     ErrorShouldBeVariable(atom, rsrc);
   } else {
-    CheckAtomicVariable(atom, rsrc, capture);
+    CheckAtomicVariable(
+        atom, rsrc, /*checkTypeOnPointer=*/!IsPointerAssignment(capture));
     // This part should have been checked prior to calling this function.
     assert(*GetConvertInput(capture.rhs) == atom &&
         "This cannot be a capture assignment");
@@ -840,7 +825,8 @@ void OmpStructureChecker::CheckAtomicReadAssignment(
     if (!IsVarOrFunctionRef(atom)) {
       ErrorShouldBeVariable(atom, rsrc);
     } else {
-      CheckAtomicVariable(atom, rsrc, read);
+      CheckAtomicVariable(
+          atom, rsrc, /*checkTypeOnPointer=*/!IsPointerAssignment(read));
       CheckStorageOverlap(atom, {read.lhs}, source);
     }
   } else {
@@ -861,7 +847,8 @@ void OmpStructureChecker::CheckAtomicWriteAssignment(
   if (!IsVarOrFunctionRef(atom)) {
     ErrorShouldBeVariable(atom, rsrc);
   } else {
-    CheckAtomicVariable(atom, lsrc, write);
+    CheckAtomicVariable(
+        atom, lsrc, /*checkTypeOnPointer=*/!IsPointerAssignment(write));
     CheckStorageOverlap(atom, {write.rhs}, source);
   }
 }
@@ -886,7 +873,8 @@ OmpStructureChecker::CheckAtomicUpdateAssignment(
     return std::nullopt;
   }
 
-  CheckAtomicVariable(atom, lsrc, update);
+  CheckAtomicVariable(
+      atom, lsrc, /*checkTypeOnPointer=*/!IsPointerAssignment(update));
 
   auto [hasErrors, tryReassoc]{CheckAtomicUpdateAssignmentRhs(
       atom, update.rhs, source, /*suppressDiagnostics=*/true)};
@@ -1049,7 +1037,8 @@ void OmpStructureChecker::CheckAtomicConditionalUpdateAssignment(
     return;
   }
 
-  CheckAtomicVariable(atom, alsrc, assign);
+  CheckAtomicVariable(
+      atom, alsrc, /*checkTypeOnPointer=*/!IsPointerAssignment(assign));
 
   auto top{GetTopLevelOperationIgnoreResizing(cond)};
   // Missing arguments to operations would have been diagnosed by now.
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index d273929987f09..543642ff322aa 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -262,12 +262,10 @@ class OmpStructureChecker
   void CheckStorageOverlap(const evaluate::Expr<evaluate::SomeType> &,
       llvm::ArrayRef<evaluate::Expr<evaluate::SomeType>>, parser::CharBlock);
   void ErrorShouldBeVariable(const MaybeExpr &expr, parser::CharBlock source);
-  void CheckAtomicType(
-      SymbolRef sym, parser::CharBlock source, std::string_view name);
-  void CheckAtomicVariable(
-      const evaluate::Expr<evaluate::SomeType> &, parser::CharBlock);
+  void CheckAtomicType(SymbolRef sym, parser::CharBlock source,
+      std::string_view name, bool checkTypeOnPointer = true);
   void CheckAtomicVariable(const evaluate::Expr<evaluate::SomeType> &,
-      parser::CharBlock, const evaluate::Assignment &);
+      parser::CharBlock, bool checkTypeOnPointer = true);
   std::pair<const parser::ExecutionPartConstruct *,
       const parser::ExecutionPartConstruct *>
   CheckUpdateCapture(const parser::ExecutionPartConstruct *ec1,
diff --git a/flang/test/Semantics/OpenMP/omp-atomic-write-pointer-derived.f90 b/flang/test/Semantics/OpenMP/omp-atomic-write-pointer-derived.f90
index d1ca2308047ad..6268b0bc07d57 100644
--- a/flang/test/Semantics/OpenMP/omp-atomic-write-pointer-derived.f90
+++ b/flang/test/Semantics/OpenMP/omp-atomic-write-pointer-derived.f90
@@ -4,5 +4,5 @@
 type(t), pointer :: a1, a2
 !$omp atomic write
 a1 = a2
-! CHECK: error: ATOMIC WRITE requires an intrinsic scalar variable; 'a1' has the POINTER attribute and derived type 't'
+! CHECK: error: ATOMIC operation requires an intrinsic scalar variable; 'a1' has the POINTER attribute and derived type 't'
 end



More information about the flang-commits mailing list