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

[Krish Gupta via flang-commits]

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

Fixes #161932

### Problem
When using `!$omp atomic write` with a POINTER variable to a derived type in intrinsic assignment, Flang would crash with a FIR verifier error instead of providing a clear semantic diagnostic.

**Example that previously crashed:**
```fortran
module p
    type t
    end type
    contains
    subroutine s(a1, a2)
        type(t), pointer :: a1, a2
        !$omp atomic write
        a1 = a2  ! Crashed with FIR verifier error
    end subroutine
end module
```
Solution
Added a semantic check in [CheckAtomicWriteAssignment()](vscode-file://vscode-app/Applications/Visual%20Studio%20Code.app/Contents/Resources/app/out/vs/code/electron-browser/workbench/workbench.html) that detects when:

The assignment is an intrinsic assignment (not pointer assignment =>)
The variable has the POINTER attribute
The pointee type is non-intrinsic (derived type, character, etc.)
The check now emits a clear error message before reaching the FIR stage:
```error: ATOMIC WRITE requires an intrinsic scalar variable; 'a1' has the POINTER attribute and derived type 't'```

<img width="1234" height="214" alt="image" src="https://github.com/user-attachments/assets/1067148f-3734-4a39-913b-df37f0e38b0f" />

What remains valid
According to OpenMP 6.0 spec, the following cases are still allowed:

✅ integer, pointer :: p; p = 5 — pointer to intrinsic type with intrinsic assignment
✅ integer, pointer :: p, q; p => q — pointer assignment
✅ [type(t), pointer :: a, b; a => b](vscode-file://vscode-app/Applications/Visual%20Studio%20Code.app/Contents/Resources/app/out/vs/code/electron-browser/workbench/workbench.html) — pointer assignment with derived type
What is now rejected
❌ [type(t), pointer :: a, b; a = b](vscode-file://vscode-app/Applications/Visual%20Studio%20Code.app/Contents/Resources/app/out/vs/code/electron-browser/workbench/workbench.html) — intrinsic assignment where the dereferenced value is non-intrinsic

Testing
All existing atomic tests pass (15/15)
New test validates the error diagnostic
Verified the original crash scenario now produces a clear error instead

<img width="1180" height="364" alt="image" src="https://github.com/user-attachments/assets/3740f431-cd1a-4cb9-b58c-ad97f17fa52c" />


>From a6d387e265f497f680634f99b365bee9cf9ff33f Mon Sep 17 00:00:00 2001
From: Krish Gupta <krishgupta at Krishs-MacBook-Air.local>
Date: Tue, 7 Oct 2025 12:55:14 +0530
Subject: [PATCH 1/2] [flang][OpenMP] Add test: named COMMON + member with
 firstprivate+lastprivate is valid

---
 flang/test/Semantics/OpenMP/omp-common-fp-lp.f90 | 13 +++++++++++++
 1 file changed, 13 insertions(+)
 create mode 100644 flang/test/Semantics/OpenMP/omp-common-fp-lp.f90

diff --git a/flang/test/Semantics/OpenMP/omp-common-fp-lp.f90 b/flang/test/Semantics/OpenMP/omp-common-fp-lp.f90
new file mode 100644
index 0000000000000..3d6ba1547a09e
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/omp-common-fp-lp.f90
@@ -0,0 +1,13 @@
+! RUN: %flang_fc1 -fopenmp -fsyntax-only %s 2>&1 | FileCheck %s --allow-empty
+! CHECK-NOT: error:
+! CHECK-NOT: warning:
+
+subroutine sub1()
+  common /com/ j
+  j = 10
+!$omp parallel do firstprivate(j) lastprivate(/com/)
+  do i = 1, 10
+     j = j + 1
+  end do
+!$omp end parallel do
+end

>From fc9683e8f38eb53a700be7143824ca7d70a82201 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 2/2] [flang][OpenMP] Add diagnostic for ATOMIC WRITE with
 pointer to non-intrinsic type

Fixes #161932
---
 flang/lib/Semantics/check-omp-atomic.cpp      | 26 ++++++++++++++++++-
 .../omp-atomic-write-pointer-derived.f90      |  8 ++++++
 2 files changed, 33 insertions(+), 1 deletion(-)
 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..00c6a2d2b5fe3 100644
--- a/flang/lib/Semantics/check-omp-atomic.cpp
+++ b/flang/lib/Semantics/check-omp-atomic.cpp
@@ -539,7 +539,6 @@ void OmpStructureChecker::CheckAtomicType(
     return;
   }
 
-  // Variable is a pointer.
   if (typeSpec->IsPolymorphic()) {
     context_.Say(source,
         "Atomic variable %s cannot be a pointer to a polymorphic type"_err_en_US,
@@ -829,6 +828,31 @@ void OmpStructureChecker::CheckAtomicWriteAssignment(
   if (!IsVarOrFunctionRef(atom)) {
     ErrorShouldBeVariable(atom, rsrc);
   } else {
+    // For intrinsic assignment (x = expr), check if the variable is a pointer
+    // to a non-intrinsic type, which is not allowed in ATOMIC WRITE
+    if (!IsPointerAssignment(write)) {
+      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(lsrc,
+                  "ATOMIC WRITE requires an intrinsic scalar variable; '%s'%s"_err_en_US,
+                  sym->name(), details);
+              return;
+            }
+          }
+        }
+      }
+    }
     CheckAtomicVariable(atom, lsrc);
     CheckStorageOverlap(atom, {write.rhs}, source);
   }
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