[flang][OpenMP] Add diagnostic for ATOMIC WRITE with pointer to non-intrinsic type

[KrxGu]

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:

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() 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'

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 - pointer assignment with derived type
What is now rejected
❌ type(t), pointer :: a, b; a = b - 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

[llvmbot]

@llvm/pr-subscribers-flang-semantics

@llvm/pr-subscribers-flang-openmp

Author: Krish Gupta (KrxGu)

Changes

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:

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() 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 — pointer assignment with derived type
What is now rejected
❌ type(t), pointer :: a, b; a = b — 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" />

---

Full diff: https://github.com/llvm/llvm-project/pull/162364.diff

3 Files Affected:

• (modified) flang/lib/Semantics/check-omp-atomic.cpp (+25-1)
• (added) flang/test/Semantics/OpenMP/omp-atomic-write-pointer-derived.f90 (+8)
• (added) flang/test/Semantics/OpenMP/omp-common-fp-lp.f90 (+13)

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
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

[github-actions]

✅ With the latest revision this PR passed the C/C++ code formatter.

[kparzysz]

Unrelated change

[kparzysz]

This isn't specific to WRITE. It should be checked in CheckAtomicType.

[kparzysz]

If you want to work on an issue that is already assigned to someone, at least let them know.

[KrxGu]

If you want to work on an issue that is already assigned to someone, at least let them know.

Hi @kparzysz — apologies for the oversight🙏. I missed that this was already self-assigned to you. I’ll make sure to check assignments and coordinate with the assignee before picking up work in the future.

I’ve opened #162364 with a semantics fix and tests. If you feel it addresses the issue, please go ahead and merge it. If there are minor changes needed, I’m happy to make them quickly. Otherwise, if it’s not up to the mark or conflicts with your approach, I can close the PR. Your call, and thank you for the guidance.