[flang-commits] [flang] [FLANG][OpenMP] Handling pure directives in DO CONCURRENT (PR #216642)

via flang-commits flang-commits at lists.llvm.org
Tue Sep 1 10:52:29 PDT 2026


https://github.com/ShashwathiNavada updated https://github.com/llvm/llvm-project/pull/216642

>From 4b13bf0d1fb507723914c1fbfcc0aff5283924c0 Mon Sep 17 00:00:00 2001
From: Shashwathi N <nshashwa at pe34genoa.hpc.amslabs.hpecorp.net>
Date: Mon, 17 Aug 2026 00:57:19 -0500
Subject: [PATCH 1/6] [FLANG][OpenMP] Handling pure directives in DO CONCURRENt

---
 flang/docs/OpenMPSupport.md                   |  2 +-
 flang/lib/Semantics/check-omp-structure.cpp   | 52 +++++++++++++++----
 flang/lib/Semantics/check-omp-structure.h     |  4 ++
 .../OpenMP/do-concurrent-pure-version.f90     | 22 ++++++++
 .../Semantics/OpenMP/do-concurrent-pure.f90   | 48 +++++++++++++++++
 5 files changed, 117 insertions(+), 11 deletions(-)
 create mode 100644 flang/test/Semantics/OpenMP/do-concurrent-pure-version.f90
 create mode 100644 flang/test/Semantics/OpenMP/do-concurrent-pure.f90

diff --git a/flang/docs/OpenMPSupport.md b/flang/docs/OpenMPSupport.md
index 63c210ca6d966..1a9d92c9424a1 100644
--- a/flang/docs/OpenMPSupport.md
+++ b/flang/docs/OpenMPSupport.md
@@ -234,7 +234,7 @@ Parser/Semantics, MLIR, Lowering, or the OpenMPIRBuilder.
 | loop construct with DO CONCURRENT | <span class="progress">in progress</span> | | Experimental support is available and under active development. | [llvm/llvm-project#178138](https://github.com/llvm/llvm-project/pull/178138), [llvm/llvm-project#190990](https://github.com/llvm/llvm-project/pull/190990) |
 | optional argument for all clauses | <span class="part">partial</span> | | Semantics coverage exists across clause tests (for example `flang/test/Semantics/OpenMP/if-clause-50.f90`). | |
 | canonical loop sequences | <span class="part">partial</span> | | Related loop/transform coverage exists (`flang/test/Semantics/OpenMP/loop-transformation-construct01.f90`, `flang/test/Lower/OpenMP/loop-directive.f90`). | [llvm/llvm-project#161213](https://github.com/llvm/llvm-project/pull/161213), [llvm/llvm-project#168884](https://github.com/llvm/llvm-project/pull/168884), [llvm/llvm-project#170734](https://github.com/llvm/llvm-project/pull/170734), [llvm/llvm-project#170735](https://github.com/llvm/llvm-project/pull/170735) |
-| pure directives in DO CONCURRENT | <span class="none">unclaimed</span> | | Define exact PURE+DO CONCURRENT directive legality in semantics and add lowering tests proving accepted forms remain side-effect safe. | |
+| pure directives in DO CONCURRENT | <span class="part">partial</span> | | Semantics enforce that OpenMP directives inside a DO CONCURRENT body must have the "pure" property. | |
 | pure procedure support extended to more directives | <span class="good">done</span> | | Semantics extend the OpenMP 5.2 pure-procedure allow list with the newly added loop-transforming constructs and the scan directive. | [llvm/llvm-project#212676](https://github.com/llvm/llvm-project/pull/212676) |
 | extensions to depobj construct | <span class="none">unclaimed</span> | | Semantics and deprecation diagnostics exist for several depobj forms, but extension support remains incomplete in lowering (for example `flang/test/Lower/OpenMP/Todo/depobj-construct.f90`). Implement lowering for extension operands/modifiers and add non-TODO lowering tests. | |
 | extensions to atomic construct | <span class="part">partial</span> | | Atomic compare lowering is now available (`flang/test/Lower/OpenMP/atomic-compare.f90`), but fail/capture-related extension paths remain incomplete (`flang/test/Lower/OpenMP/Todo/atomic-compare-fail.f90`). | [llvm/llvm-project#184761](https://github.com/llvm/llvm-project/pull/184761) |
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 274efa64d03d0..204c2c49ef401 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -957,12 +957,8 @@ void OmpStructureChecker::CheckDirectiveDeprecation(
   // one another, but only the top-level directive should cause a warning.
 }
 
-void OmpStructureChecker::CheckDirectiveInPureProcedure(
-    parser::CharBlock source, llvm::omp::Directive id) {
-  const Scope &scope{context_.FindScope(source)};
-  if (!FindPureProcedureContaining(scope)) {
-    return;
-  }
+void OmpStructureChecker::CheckDirectivePureSince(
+    parser::CharBlock source, llvm::omp::Directive id, const char *where) {
   unsigned version{context_.langOptions().OpenMPVersion};
   // A directive's "pure" property is version-specific: pureSince is the
   // OpenMP version at which the directive gained that property.
@@ -972,13 +968,47 @@ void OmpStructureChecker::CheckDirectiveInPureProcedure(
   }
   if (pureSince != 0x7FFFFFFF) {
     context_.Say(source,
-        "The OpenMP directive '%s' is not allowed in a PURE procedure in %s, %s"_err_en_US,
-        parser::omp::GetUpperName(id, version), ThisVersion(version),
+        "The OpenMP directive '%s' is not allowed in %s in %s, %s"_err_en_US,
+        parser::omp::GetUpperName(id, version), where, ThisVersion(version),
         TryVersion(pureSince));
   } else {
     context_.Say(source,
-        "The OpenMP directive '%s' is not allowed in a PURE procedure"_err_en_US,
-        parser::omp::GetUpperName(id, version));
+        "The OpenMP directive '%s' is not allowed in %s"_err_en_US,
+        parser::omp::GetUpperName(id, version), where);
+  }
+}
+
+void OmpStructureChecker::CheckDirectiveInPureProcedure(
+    parser::CharBlock source, llvm::omp::Directive id) {
+  const Scope &scope{context_.FindScope(source)};
+  if (!FindPureProcedureContaining(scope)) {
+    return;
+  }
+  CheckDirectivePureSince(source, id, "a PURE procedure");
+}
+
+void OmpStructureChecker::CheckDirectiveInDoConcurrent(
+    parser::CharBlock source, llvm::omp::Directive id) {
+  // Look for any enclosing DO CONCURRENT, not just the nearest DO, since a
+  // plain DO nested inside DO CONCURRENT is still part of its body.
+  for (const LoopOrConstruct &c : llvm::reverse(constructStack_)) {
+    auto *doConstruct{std::get_if<const parser::DoConstruct *>(&c)};
+    if (!doConstruct || !(*doConstruct)->IsDoConcurrent()) {
+      continue;
+    }
+    unsigned version{context_.langOptions().OpenMPVersion};
+    if (!IsDoConcurrentLegal(version)) {
+      // Prior to OpenMP 6.0, no OpenMP directive, regardless of its "pure"
+      // property, was allowed inside a DO CONCURRENT construct.
+      context_.Say(source,
+          "The OpenMP directive '%s' is not allowed inside a DO CONCURRENT construct"_err_en_US,
+          parser::omp::GetUpperName(id, version));
+    } else {
+      // Starting with OpenMP 6.0, directives that have the "pure" property
+      // are permitted inside a DO CONCURRENT construct.
+      CheckDirectivePureSince(source, id, "a DO CONCURRENT construct");
+    }
+    return;
   }
 }
 
@@ -1331,6 +1361,7 @@ void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) {
   dirStack_.push_back(&GetOmpDirectiveSpecification(x));
   CheckDirectiveDeprecation(x);
   CheckDirectiveInPureProcedure(dirName.source, dirName.v);
+  CheckDirectiveInDoConcurrent(dirName.source, dirName.v);
 
   // Verify clauses
   common::visit(
@@ -1388,6 +1419,7 @@ void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeConstruct &x) {
       llvm::iterator_range(std::list<parser::OmpClause>{}));
 
   CheckDirectiveInPureProcedure(dirName.source, dirName.v);
+  CheckDirectiveInDoConcurrent(dirName.source, dirName.v);
   EnterDirectiveNest(DeclarativeNest);
 }
 
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index 5eb33133e1efd..000ef81786e81 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -348,8 +348,12 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
   void CheckDirectiveSpelling(
       parser::CharBlock spelling, llvm::omp::Directive id);
   void CheckDirectiveDeprecation(const parser::OpenMPConstruct &x);
+  void CheckDirectivePureSince(parser::CharBlock source,
+      llvm::omp::Directive id, const char *where);
   void CheckDirectiveInPureProcedure(
       parser::CharBlock source, llvm::omp::Directive id);
+  void CheckDirectiveInDoConcurrent(
+      parser::CharBlock source, llvm::omp::Directive id);
   void CheckClauses(parser::OmpDirectiveName dirName,
       llvm::iterator_range<ClauseIterator> beginClauses,
       llvm::iterator_range<ClauseIterator> endClauses);
diff --git a/flang/test/Semantics/OpenMP/do-concurrent-pure-version.f90 b/flang/test/Semantics/OpenMP/do-concurrent-pure-version.f90
new file mode 100644
index 0000000000000..e23bfac8b8303
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/do-concurrent-pure-version.f90
@@ -0,0 +1,22 @@
+! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp -fopenmp-version=52
+
+! Prior to OpenMP 6.0, no OpenMP directive is allowed inside a DO CONCURRENT
+! construct, regardless of whether it would otherwise have the "pure"
+! property (e.g. SIMD, which has been "pure" since OpenMP 4.5).
+
+module m
+contains
+  subroutine do_concurrent_bad(a, n)
+    integer, intent(in) :: n
+    integer, intent(inout) :: a(n)
+    integer :: i, j
+    do concurrent (i = 1:n)
+      !ERROR: The OpenMP directive 'SIMD' is not allowed inside a DO CONCURRENT construct
+      !$omp simd
+      do j = 1, n
+      end do
+      !ERROR: The OpenMP directive 'BARRIER' is not allowed inside a DO CONCURRENT construct
+      !$omp barrier
+    end do
+  end subroutine
+end module
diff --git a/flang/test/Semantics/OpenMP/do-concurrent-pure.f90 b/flang/test/Semantics/OpenMP/do-concurrent-pure.f90
new file mode 100644
index 0000000000000..cefc68190d61c
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/do-concurrent-pure.f90
@@ -0,0 +1,48 @@
+! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp -fopenmp-version=60
+
+! Starting with OpenMP 6.0, directives with the "pure" property are allowed
+! in a DO CONCURRENT construct; other directives are still rejected.
+
+module m
+contains
+  subroutine do_concurrent_valid(a, n)
+    integer, intent(in) :: n
+    integer, intent(inout) :: a(n)
+    integer :: i
+    do concurrent (i = 1:n)
+      !$omp nothing
+      a(i) = a(i) + 1
+    end do
+  end subroutine
+
+  subroutine do_concurrent_bad(a, n)
+    integer, intent(in) :: n
+    integer, intent(inout) :: a(n)
+    integer :: i
+    do concurrent (i = 1:n)
+      !ERROR: The OpenMP directive 'BARRIER' is not allowed in a DO CONCURRENT construct
+      !$omp barrier
+      !ERROR: The OpenMP directive 'PARALLEL' is not allowed in a DO CONCURRENT construct
+      !$omp parallel
+      !$omp end parallel
+      !ERROR: The OpenMP directive 'ATOMIC' is not allowed in a DO CONCURRENT construct
+      !$omp atomic
+      a(i) = a(i) + 1
+    end do
+  end subroutine
+
+  ! A plain DO nested in DO CONCURRENT is still part of its body.
+  subroutine do_concurrent_nested_do(a, n)
+    integer, intent(in) :: n
+    integer, intent(inout) :: a(n)
+    integer :: i, j
+    do concurrent (i = 1:n)
+      do j = 1, n
+        !ERROR: The OpenMP directive 'TASK' is not allowed in a DO CONCURRENT construct
+        !$omp task
+        !$omp end task
+      end do
+      a(i) = a(i) + 1
+    end do
+  end subroutine
+end module

>From f608c4107540b7ce8e70af6be8f4375a6ccf4f5d Mon Sep 17 00:00:00 2001
From: Shashwathi N <nshashwa at pe34genoa.hpc.amslabs.hpecorp.net>
Date: Mon, 17 Aug 2026 01:06:01 -0500
Subject: [PATCH 2/6] Updated Doc

---
 flang/docs/OpenMPSupport.md               | 2 +-
 flang/lib/Semantics/check-omp-structure.h | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/flang/docs/OpenMPSupport.md b/flang/docs/OpenMPSupport.md
index 1a9d92c9424a1..0eed6e1265476 100644
--- a/flang/docs/OpenMPSupport.md
+++ b/flang/docs/OpenMPSupport.md
@@ -234,7 +234,7 @@ Parser/Semantics, MLIR, Lowering, or the OpenMPIRBuilder.
 | loop construct with DO CONCURRENT | <span class="progress">in progress</span> | | Experimental support is available and under active development. | [llvm/llvm-project#178138](https://github.com/llvm/llvm-project/pull/178138), [llvm/llvm-project#190990](https://github.com/llvm/llvm-project/pull/190990) |
 | optional argument for all clauses | <span class="part">partial</span> | | Semantics coverage exists across clause tests (for example `flang/test/Semantics/OpenMP/if-clause-50.f90`). | |
 | canonical loop sequences | <span class="part">partial</span> | | Related loop/transform coverage exists (`flang/test/Semantics/OpenMP/loop-transformation-construct01.f90`, `flang/test/Lower/OpenMP/loop-directive.f90`). | [llvm/llvm-project#161213](https://github.com/llvm/llvm-project/pull/161213), [llvm/llvm-project#168884](https://github.com/llvm/llvm-project/pull/168884), [llvm/llvm-project#170734](https://github.com/llvm/llvm-project/pull/170734), [llvm/llvm-project#170735](https://github.com/llvm/llvm-project/pull/170735) |
-| pure directives in DO CONCURRENT | <span class="part">partial</span> | | Semantics enforce that OpenMP directives inside a DO CONCURRENT body must have the "pure" property. | |
+| pure directives in DO CONCURRENT | <span class="good">done</span> | | Semantics enforce that OpenMP directives inside a DO CONCURRENT body must have the "pure" property. | [llvm/llvm-project#216642](https://github.com/llvm/llvm-project/pull/216642) |
 | pure procedure support extended to more directives | <span class="good">done</span> | | Semantics extend the OpenMP 5.2 pure-procedure allow list with the newly added loop-transforming constructs and the scan directive. | [llvm/llvm-project#212676](https://github.com/llvm/llvm-project/pull/212676) |
 | extensions to depobj construct | <span class="none">unclaimed</span> | | Semantics and deprecation diagnostics exist for several depobj forms, but extension support remains incomplete in lowering (for example `flang/test/Lower/OpenMP/Todo/depobj-construct.f90`). Implement lowering for extension operands/modifiers and add non-TODO lowering tests. | |
 | extensions to atomic construct | <span class="part">partial</span> | | Atomic compare lowering is now available (`flang/test/Lower/OpenMP/atomic-compare.f90`), but fail/capture-related extension paths remain incomplete (`flang/test/Lower/OpenMP/Todo/atomic-compare-fail.f90`). | [llvm/llvm-project#184761](https://github.com/llvm/llvm-project/pull/184761) |
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index 000ef81786e81..92ab031758baf 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -348,8 +348,8 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
   void CheckDirectiveSpelling(
       parser::CharBlock spelling, llvm::omp::Directive id);
   void CheckDirectiveDeprecation(const parser::OpenMPConstruct &x);
-  void CheckDirectivePureSince(parser::CharBlock source,
-      llvm::omp::Directive id, const char *where);
+  void CheckDirectivePureSince(
+      parser::CharBlock source, llvm::omp::Directive id, const char *where);
   void CheckDirectiveInPureProcedure(
       parser::CharBlock source, llvm::omp::Directive id);
   void CheckDirectiveInDoConcurrent(

>From 939dfd0abeaf92a623140483def3b0079546064e Mon Sep 17 00:00:00 2001
From: Shashwathi N <nshashwa at pe34genoa.hpc.amslabs.hpecorp.net>
Date: Thu, 20 Aug 2026 09:05:37 -0500
Subject: [PATCH 3/6] Suggested change

---
 flang/lib/Semantics/check-omp-structure.cpp   |  2 +-
 flang/lib/Semantics/check-omp-variant.cpp     |  4 ++
 .../OpenMP/do-concurrent-pure-version.f90     |  4 +-
 .../Semantics/OpenMP/do-concurrent-pure.f90   | 65 ++++++++++++++++++-
 4 files changed, 71 insertions(+), 4 deletions(-)

diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 204c2c49ef401..a988ae7921177 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1001,7 +1001,7 @@ void OmpStructureChecker::CheckDirectiveInDoConcurrent(
       // Prior to OpenMP 6.0, no OpenMP directive, regardless of its "pure"
       // property, was allowed inside a DO CONCURRENT construct.
       context_.Say(source,
-          "The OpenMP directive '%s' is not allowed inside a DO CONCURRENT construct"_err_en_US,
+          "The OpenMP directive '%s' is not allowed in a DO CONCURRENT construct"_err_en_US,
           parser::omp::GetUpperName(id, version));
     } else {
       // Starting with OpenMP 6.0, directives that have the "pure" property
diff --git a/flang/lib/Semantics/check-omp-variant.cpp b/flang/lib/Semantics/check-omp-variant.cpp
index 0f8daf84d25ec..6bd6fcbad6831 100644
--- a/flang/lib/Semantics/check-omp-variant.cpp
+++ b/flang/lib/Semantics/check-omp-variant.cpp
@@ -744,6 +744,10 @@ void OmpStructureChecker::Enter(const parser::OmpDirectiveSpecification &x) {
   if (dirId != llvm::omp::Directive::OMPD_metadirective) {
     metadirectiveLoopVariants_.push_back(
         {currentWhenSelector_, &x, checkDefaultNoneInAssociatedLoop});
+    // METADIRECTIVE is "pure", but its selected variant may not be.
+    // Check each variant independently.
+    CheckDirectiveInPureProcedure(x.DirName().source, dirId);
+    CheckDirectiveInDoConcurrent(x.DirName().source, dirId);
   }
 }
 
diff --git a/flang/test/Semantics/OpenMP/do-concurrent-pure-version.f90 b/flang/test/Semantics/OpenMP/do-concurrent-pure-version.f90
index e23bfac8b8303..b4a85e61f2f64 100644
--- a/flang/test/Semantics/OpenMP/do-concurrent-pure-version.f90
+++ b/flang/test/Semantics/OpenMP/do-concurrent-pure-version.f90
@@ -11,11 +11,11 @@ subroutine do_concurrent_bad(a, n)
     integer, intent(inout) :: a(n)
     integer :: i, j
     do concurrent (i = 1:n)
-      !ERROR: The OpenMP directive 'SIMD' is not allowed inside a DO CONCURRENT construct
+      !ERROR: The OpenMP directive 'SIMD' is not allowed in a DO CONCURRENT construct
       !$omp simd
       do j = 1, n
       end do
-      !ERROR: The OpenMP directive 'BARRIER' is not allowed inside a DO CONCURRENT construct
+      !ERROR: The OpenMP directive 'BARRIER' is not allowed in a DO CONCURRENT construct
       !$omp barrier
     end do
   end subroutine
diff --git a/flang/test/Semantics/OpenMP/do-concurrent-pure.f90 b/flang/test/Semantics/OpenMP/do-concurrent-pure.f90
index cefc68190d61c..c3449772fa56b 100644
--- a/flang/test/Semantics/OpenMP/do-concurrent-pure.f90
+++ b/flang/test/Semantics/OpenMP/do-concurrent-pure.f90
@@ -8,13 +8,76 @@ module m
   subroutine do_concurrent_valid(a, n)
     integer, intent(in) :: n
     integer, intent(inout) :: a(n)
-    integer :: i
+    integer :: i, j
     do concurrent (i = 1:n)
       !$omp nothing
+      !$omp simd
+      do j = 1, n
+        a(i) = a(i) + 1
+      end do
+    end do
+  end subroutine
+
+  ! A DO CONCURRENT nested in another DO CONCURRENT is checked against its
+  ! innermost enclosing DO CONCURRENT.
+  subroutine do_concurrent_nested_do_concurrent(a, n)
+    integer, intent(in) :: n
+    integer, intent(inout) :: a(n, n)
+    integer :: i, j, k
+    do concurrent (i = 1:n)
+      do concurrent (j = 1:n)
+        !$omp simd
+        do k = 1, n
+          a(i, j) = a(i, j) + 1
+        end do
+        !ERROR: The OpenMP directive 'PARALLEL' is not allowed in a DO CONCURRENT construct
+        !$omp parallel
+        !$omp end parallel
+      end do
+    end do
+  end subroutine
+
+  ! A BLOCK construct nested in DO CONCURRENT is still part of its body.
+  subroutine do_concurrent_nested_block(a, n)
+    integer, intent(in) :: n
+    integer, intent(inout) :: a(n)
+    integer :: i
+    do concurrent (i = 1:n)
+      block
+        !$omp nothing
+        !ERROR: The OpenMP directive 'CRITICAL' is not allowed in a DO CONCURRENT construct
+        !$omp critical
+        a(i) = a(i) + 1
+        !$omp end critical
+      end block
+    end do
+  end subroutine
+
+  ! A METADIRECTIVE only reflects its own "pure" property; whichever variant
+  ! it selects must be checked independently.
+  subroutine do_concurrent_metadirective(a, n)
+    integer, intent(in) :: n
+    integer, intent(inout) :: a(n)
+    integer :: i
+    do concurrent (i = 1:n)
+      !$omp metadirective when(user={condition(.true.)}: nothing)
+      !$omp metadirective when(user={condition(.false.)}: nothing) otherwise(assume no_openmp)
       a(i) = a(i) + 1
     end do
   end subroutine
 
+  subroutine do_concurrent_metadirective_bad(a, n)
+    integer, intent(in) :: n
+    integer, intent(inout) :: a(n)
+    integer :: i
+    do concurrent (i = 1:n)
+      !ERROR: The OpenMP directive 'PARALLEL' is not allowed in a DO CONCURRENT construct
+      !$omp metadirective when(user={condition(.true.)}: parallel)
+      block
+      end block
+    end do
+  end subroutine
+
   subroutine do_concurrent_bad(a, n)
     integer, intent(in) :: n
     integer, intent(inout) :: a(n)

>From 7ae76785b89e08557f6d0f78eae057d7be73795b Mon Sep 17 00:00:00 2001
From: Shashwathi N <shashwathinavada at gmail.com>
Date: Thu, 20 Aug 2026 10:28:56 -0500
Subject: [PATCH 4/6] Fix the regressin

---
 flang/lib/Semantics/check-omp-variant.cpp     | 20 +++++++++++---
 .../Semantics/OpenMP/do-concurrent-pure.f90   | 27 +++++++++++++++++++
 2 files changed, 43 insertions(+), 4 deletions(-)

diff --git a/flang/lib/Semantics/check-omp-variant.cpp b/flang/lib/Semantics/check-omp-variant.cpp
index 6bd6fcbad6831..2bc568fd168f6 100644
--- a/flang/lib/Semantics/check-omp-variant.cpp
+++ b/flang/lib/Semantics/check-omp-variant.cpp
@@ -744,10 +744,22 @@ void OmpStructureChecker::Enter(const parser::OmpDirectiveSpecification &x) {
   if (dirId != llvm::omp::Directive::OMPD_metadirective) {
     metadirectiveLoopVariants_.push_back(
         {currentWhenSelector_, &x, checkDefaultNoneInAssociatedLoop});
-    // METADIRECTIVE is "pure", but its selected variant may not be.
-    // Check each variant independently.
-    CheckDirectiveInPureProcedure(x.DirName().source, dirId);
-    CheckDirectiveInDoConcurrent(x.DirName().source, dirId);
+    // Metadirective is "pure", but its selected variant may not be.
+    // Check the variant independently only when metadirective is legal;
+    // otherwise, the outer metadirective check already reports the error.
+    if (GetDirectiveNest(MetadirectiveNest)) {
+      unsigned version{context_.langOptions().OpenMPVersion};
+      if (version >= llvm::omp::getDirectivePureSince(
+                         llvm::omp::Directive::OMPD_metadirective)) {
+        CheckDirectiveInPureProcedure(x.DirName().source, dirId);
+      }
+      if (IsDoConcurrentLegal(version)) {
+        CheckDirectiveInDoConcurrent(x.DirName().source, dirId);
+      }
+    } else {
+      CheckDirectiveInPureProcedure(x.DirName().source, dirId);
+      CheckDirectiveInDoConcurrent(x.DirName().source, dirId);
+    }
   }
 }
 
diff --git a/flang/test/Semantics/OpenMP/do-concurrent-pure.f90 b/flang/test/Semantics/OpenMP/do-concurrent-pure.f90
index c3449772fa56b..ed5211a816db5 100644
--- a/flang/test/Semantics/OpenMP/do-concurrent-pure.f90
+++ b/flang/test/Semantics/OpenMP/do-concurrent-pure.f90
@@ -78,6 +78,33 @@ subroutine do_concurrent_metadirective_bad(a, n)
     end do
   end subroutine
 
+  ! An APPLY clause's directive-variant must be pure too, independently of
+  ! its host directive (TILE, which is itself pure).
+  subroutine do_concurrent_apply(a, n)
+    integer, intent(in) :: n
+    integer, intent(inout) :: a(n, n)
+    integer :: i, j
+    do concurrent (i = 1:n)
+      !$omp tile sizes(2) apply(grid: nothing)
+      do j = 1, n
+        a(i, j) = a(i, j) + 1
+      end do
+    end do
+  end subroutine
+
+  subroutine do_concurrent_apply_bad(a, n)
+    integer, intent(in) :: n
+    integer, intent(inout) :: a(n, n)
+    integer :: i, j
+    do concurrent (i = 1:n)
+      !ERROR: The OpenMP directive 'BARRIER' is not allowed in a DO CONCURRENT construct
+      !$omp tile sizes(2) apply(grid: barrier)
+      do j = 1, n
+        a(i, j) = a(i, j) + 1
+      end do
+    end do
+  end subroutine
+
   subroutine do_concurrent_bad(a, n)
     integer, intent(in) :: n
     integer, intent(inout) :: a(n)

>From 361b580d8185550d2e17f672556fb0382934060a Mon Sep 17 00:00:00 2001
From: Shashwathi N <shashwathinavada at gmail.com>
Date: Tue, 1 Sep 2026 12:16:43 -0500
Subject: [PATCH 5/6] Suggested changes

---
 flang/include/flang/Semantics/openmp-utils.h  |  1 +
 flang/lib/Semantics/check-omp-structure.cpp   | 29 ++++++++++-----
 flang/lib/Semantics/check-omp-structure.h     | 13 ++++---
 flang/lib/Semantics/check-omp-variant.cpp     |  8 ++--
 flang/lib/Semantics/openmp-utils.cpp          |  8 +++-
 .../Semantics/OpenMP/do-concurrent-pure.f90   | 37 +++++++++++++++++++
 .../test/Semantics/OpenMP/pure-procedure.f90  |  6 ++-
 7 files changed, 79 insertions(+), 23 deletions(-)

diff --git a/flang/include/flang/Semantics/openmp-utils.h b/flang/include/flang/Semantics/openmp-utils.h
index 031926d4a7cc2..4f962bc507c34 100644
--- a/flang/include/flang/Semantics/openmp-utils.h
+++ b/flang/include/flang/Semantics/openmp-utils.h
@@ -311,6 +311,7 @@ struct OmpErrorArgs {
 
 /// Scan the clause list of an `!$omp error` directive for its AT, SEVERITY, and
 /// MESSAGE clause values.
+OmpErrorArgs GetErrorDirectiveArgs(const parser::OmpDirectiveSpecification &spec);
 OmpErrorArgs GetErrorDirectiveArgs(const parser::OmpErrorDirective &errDir);
 
 inline bool IsDoConcurrentLegal(unsigned version) {
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index a988ae7921177..91ead4be9e41c 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -957,12 +957,19 @@ void OmpStructureChecker::CheckDirectiveDeprecation(
   // one another, but only the top-level directive should cause a warning.
 }
 
-void OmpStructureChecker::CheckDirectivePureSince(
-    parser::CharBlock source, llvm::omp::Directive id, const char *where) {
+void OmpStructureChecker::CheckDirectivePureSince(parser::CharBlock source,
+    llvm::omp::Directive id, const char *where,
+    const parser::OmpDirectiveSpecification &spec) {
   unsigned version{context_.langOptions().OpenMPVersion};
   // A directive's "pure" property is version-specific: pureSince is the
   // OpenMP version at which the directive gained that property.
   unsigned pureSince{llvm::omp::getDirectivePureSince(id)};
+  if (id == llvm::omp::Directive::OMPD_error &&
+      GetErrorDirectiveArgs(spec).at !=
+          parser::OmpAtClause::ActionTime::Compilation) {
+    // ERROR is only "pure" when its action-time is compilation.
+    pureSince = 0x7FFFFFFF;
+  }
   if (version >= pureSince) {
     return;
   }
@@ -979,16 +986,18 @@ void OmpStructureChecker::CheckDirectivePureSince(
 }
 
 void OmpStructureChecker::CheckDirectiveInPureProcedure(
-    parser::CharBlock source, llvm::omp::Directive id) {
+    parser::CharBlock source, llvm::omp::Directive id,
+    const parser::OmpDirectiveSpecification &spec) {
   const Scope &scope{context_.FindScope(source)};
   if (!FindPureProcedureContaining(scope)) {
     return;
   }
-  CheckDirectivePureSince(source, id, "a PURE procedure");
+  CheckDirectivePureSince(source, id, "a PURE procedure", spec);
 }
 
 void OmpStructureChecker::CheckDirectiveInDoConcurrent(
-    parser::CharBlock source, llvm::omp::Directive id) {
+    parser::CharBlock source, llvm::omp::Directive id,
+    const parser::OmpDirectiveSpecification &spec) {
   // Look for any enclosing DO CONCURRENT, not just the nearest DO, since a
   // plain DO nested inside DO CONCURRENT is still part of its body.
   for (const LoopOrConstruct &c : llvm::reverse(constructStack_)) {
@@ -1006,7 +1015,7 @@ void OmpStructureChecker::CheckDirectiveInDoConcurrent(
     } else {
       // Starting with OpenMP 6.0, directives that have the "pure" property
       // are permitted inside a DO CONCURRENT construct.
-      CheckDirectivePureSince(source, id, "a DO CONCURRENT construct");
+      CheckDirectivePureSince(source, id, "a DO CONCURRENT construct", spec);
     }
     return;
   }
@@ -1360,8 +1369,8 @@ void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) {
   PushContextAndClauseSets(dirName.source, dirName.v);
   dirStack_.push_back(&GetOmpDirectiveSpecification(x));
   CheckDirectiveDeprecation(x);
-  CheckDirectiveInPureProcedure(dirName.source, dirName.v);
-  CheckDirectiveInDoConcurrent(dirName.source, dirName.v);
+  CheckDirectiveInPureProcedure(dirName.source, dirName.v, *dirStack_.back());
+  CheckDirectiveInDoConcurrent(dirName.source, dirName.v, *dirStack_.back());
 
   // Verify clauses
   common::visit(
@@ -1418,8 +1427,8 @@ void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeConstruct &x) {
   CheckClauses(dirName, llvm::iterator_range(dirStack_.back()->Clauses().v),
       llvm::iterator_range(std::list<parser::OmpClause>{}));
 
-  CheckDirectiveInPureProcedure(dirName.source, dirName.v);
-  CheckDirectiveInDoConcurrent(dirName.source, dirName.v);
+  CheckDirectiveInPureProcedure(dirName.source, dirName.v, *dirStack_.back());
+  CheckDirectiveInDoConcurrent(dirName.source, dirName.v, *dirStack_.back());
   EnterDirectiveNest(DeclarativeNest);
 }
 
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index 92ab031758baf..8b7537f529cda 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -348,12 +348,13 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
   void CheckDirectiveSpelling(
       parser::CharBlock spelling, llvm::omp::Directive id);
   void CheckDirectiveDeprecation(const parser::OpenMPConstruct &x);
-  void CheckDirectivePureSince(
-      parser::CharBlock source, llvm::omp::Directive id, const char *where);
-  void CheckDirectiveInPureProcedure(
-      parser::CharBlock source, llvm::omp::Directive id);
-  void CheckDirectiveInDoConcurrent(
-      parser::CharBlock source, llvm::omp::Directive id);
+  void CheckDirectivePureSince(parser::CharBlock source,
+      llvm::omp::Directive id, const char *where,
+      const parser::OmpDirectiveSpecification &spec);
+  void CheckDirectiveInPureProcedure(parser::CharBlock source,
+      llvm::omp::Directive id, const parser::OmpDirectiveSpecification &spec);
+  void CheckDirectiveInDoConcurrent(parser::CharBlock source,
+      llvm::omp::Directive id, const parser::OmpDirectiveSpecification &spec);
   void CheckClauses(parser::OmpDirectiveName dirName,
       llvm::iterator_range<ClauseIterator> beginClauses,
       llvm::iterator_range<ClauseIterator> endClauses);
diff --git a/flang/lib/Semantics/check-omp-variant.cpp b/flang/lib/Semantics/check-omp-variant.cpp
index 2bc568fd168f6..4ff4a6f4fa718 100644
--- a/flang/lib/Semantics/check-omp-variant.cpp
+++ b/flang/lib/Semantics/check-omp-variant.cpp
@@ -751,14 +751,14 @@ void OmpStructureChecker::Enter(const parser::OmpDirectiveSpecification &x) {
       unsigned version{context_.langOptions().OpenMPVersion};
       if (version >= llvm::omp::getDirectivePureSince(
                          llvm::omp::Directive::OMPD_metadirective)) {
-        CheckDirectiveInPureProcedure(x.DirName().source, dirId);
+        CheckDirectiveInPureProcedure(x.DirName().source, dirId, x);
       }
       if (IsDoConcurrentLegal(version)) {
-        CheckDirectiveInDoConcurrent(x.DirName().source, dirId);
+        CheckDirectiveInDoConcurrent(x.DirName().source, dirId, x);
       }
     } else {
-      CheckDirectiveInPureProcedure(x.DirName().source, dirId);
-      CheckDirectiveInDoConcurrent(x.DirName().source, dirId);
+      CheckDirectiveInPureProcedure(x.DirName().source, dirId, x);
+      CheckDirectiveInDoConcurrent(x.DirName().source, dirId, x);
     }
   }
 }
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index dc3d5a302e841..eff5beffd5760 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -920,9 +920,9 @@ bool IsFullUnroll(const parser::OmpDirectiveSpecification &spec) {
   return false;
 }
 
-OmpErrorArgs GetErrorDirectiveArgs(const parser::OmpErrorDirective &errDir) {
+OmpErrorArgs GetErrorDirectiveArgs(const parser::OmpDirectiveSpecification &spec) {
   OmpErrorArgs args;
-  for (const parser::OmpClause &clause : errDir.v.Clauses().v) {
+  for (const parser::OmpClause &clause : spec.Clauses().v) {
     if (const auto *at{std::get_if<parser::OmpClause::At>(&clause.u)}) {
       args.at = at->v.v;
     } else if (const auto *sev{
@@ -936,6 +936,10 @@ OmpErrorArgs GetErrorDirectiveArgs(const parser::OmpErrorDirective &errDir) {
   return args;
 }
 
+OmpErrorArgs GetErrorDirectiveArgs(const parser::OmpErrorDirective &errDir) {
+  return GetErrorDirectiveArgs(errDir.v);
+}
+
 static bool IsTransformableLoop(const parser::OmpDirectiveSpecification &spec) {
   return !IsFullUnroll(spec) && IsLoopTransforming(spec.DirId());
 }
diff --git a/flang/test/Semantics/OpenMP/do-concurrent-pure.f90 b/flang/test/Semantics/OpenMP/do-concurrent-pure.f90
index ed5211a816db5..0e694995e85ad 100644
--- a/flang/test/Semantics/OpenMP/do-concurrent-pure.f90
+++ b/flang/test/Semantics/OpenMP/do-concurrent-pure.f90
@@ -78,6 +78,43 @@ subroutine do_concurrent_metadirective_bad(a, n)
     end do
   end subroutine
 
+  ! An `!$omp error` directive is only "pure" when its action-time is
+  ! compilation; AT(EXECUTION) defers the mandated abort to run time, so it
+  ! is never allowed in a DO CONCURRENT construct.
+  subroutine do_concurrent_error_at_compilation(a, n)
+    integer, intent(in) :: n
+    integer, intent(inout) :: a(n)
+    integer :: i
+    do concurrent (i = 1:n)
+      !WARNING: ok
+      !$omp error at(compilation) severity(warning) message("ok")
+      a(i) = a(i) + 1
+    end do
+  end subroutine
+
+  subroutine do_concurrent_error_at_execution(a, n)
+    integer, intent(in) :: n
+    integer, intent(inout) :: a(n)
+    integer :: i
+    do concurrent (i = 1:n)
+      !ERROR: The OpenMP directive 'ERROR' is not allowed in a DO CONCURRENT construct
+      !$omp error at(execution) severity(fatal) message("boom")
+      a(i) = a(i) + 1
+    end do
+  end subroutine
+
+  ! The same AT(EXECUTION) restriction applies to a METADIRECTIVE's variant.
+  subroutine do_concurrent_metadirective_error_at_execution(a, n)
+    integer, intent(in) :: n
+    integer, intent(inout) :: a(n)
+    integer :: i
+    do concurrent (i = 1:n)
+      !ERROR: The OpenMP directive 'ERROR' is not allowed in a DO CONCURRENT construct
+      !$omp metadirective when(user={condition(.true.)}: error at(execution) severity(fatal) message("boom"))
+      a(i) = a(i) + 1
+    end do
+  end subroutine
+
   ! An APPLY clause's directive-variant must be pure too, independently of
   ! its host directive (TILE, which is itself pure).
   subroutine do_concurrent_apply(a, n)
diff --git a/flang/test/Semantics/OpenMP/pure-procedure.f90 b/flang/test/Semantics/OpenMP/pure-procedure.f90
index d942d1b193b8e..4c018559b3181 100644
--- a/flang/test/Semantics/OpenMP/pure-procedure.f90
+++ b/flang/test/Semantics/OpenMP/pure-procedure.f90
@@ -18,7 +18,8 @@ pure subroutine pure_ok(a, n)
     !$omp assume no_openmp
     !$omp end assume
     !$omp metadirective when(user={condition(.true.)}: nothing)
-    !$omp error at(execution) severity(warning) message("ok")
+    !WARNING: ok
+    !$omp error at(compilation) severity(warning) message("ok")
     !$omp tile sizes(4)
     do i = 1, n
       a(i) = a(i) + 1
@@ -95,5 +96,8 @@ pure subroutine pure_bad(a, n, r)
     !ERROR: The OpenMP directive 'TASK' is not allowed in a PURE procedure
     !$omp task
     !$omp end task
+    ! ERROR is only pure when its action-time is compilation.
+    !ERROR: The OpenMP directive 'ERROR' is not allowed in a PURE procedure
+    !$omp error at(execution) severity(warning) message("bad")
   end subroutine
 end module

>From aa1e64e29a6570d825c89d17c1b35190192f4e0e Mon Sep 17 00:00:00 2001
From: Shashwathi N <shashwathinavada at gmail.com>
Date: Tue, 1 Sep 2026 12:52:14 -0500
Subject: [PATCH 6/6] Formats

---
 flang/include/flang/Semantics/openmp-utils.h | 3 ++-
 flang/lib/Semantics/check-omp-structure.cpp  | 5 ++---
 flang/lib/Semantics/openmp-utils.cpp         | 3 ++-
 3 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/flang/include/flang/Semantics/openmp-utils.h b/flang/include/flang/Semantics/openmp-utils.h
index 0082da87f1310..2c7d95ae9e06d 100644
--- a/flang/include/flang/Semantics/openmp-utils.h
+++ b/flang/include/flang/Semantics/openmp-utils.h
@@ -295,7 +295,8 @@ struct OmpErrorArgs {
 
 /// Scan the clause list of an `!$omp error` directive for its AT, SEVERITY, and
 /// MESSAGE clause values.
-OmpErrorArgs GetErrorDirectiveArgs(const parser::OmpDirectiveSpecification &spec);
+OmpErrorArgs GetErrorDirectiveArgs(
+    const parser::OmpDirectiveSpecification &spec);
 OmpErrorArgs GetErrorDirectiveArgs(const parser::OmpErrorDirective &errDir);
 
 inline bool IsDoConcurrentLegal(unsigned version) {
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 00591e69b01d6..c2302fbb8a2cc 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -995,9 +995,8 @@ void OmpStructureChecker::CheckDirectiveInPureProcedure(
   CheckDirectivePureSince(source, id, "a PURE procedure", spec);
 }
 
-void OmpStructureChecker::CheckDirectiveInDoConcurrent(
-    parser::CharBlock source, llvm::omp::Directive id,
-    const parser::OmpDirectiveSpecification &spec) {
+void OmpStructureChecker::CheckDirectiveInDoConcurrent(parser::CharBlock source,
+    llvm::omp::Directive id, const parser::OmpDirectiveSpecification &spec) {
   // Look for any enclosing DO CONCURRENT, not just the nearest DO, since a
   // plain DO nested inside DO CONCURRENT is still part of its body.
   for (const LoopOrConstruct &c : llvm::reverse(constructStack_)) {
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index eff5beffd5760..a6963adb7d7f0 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -920,7 +920,8 @@ bool IsFullUnroll(const parser::OmpDirectiveSpecification &spec) {
   return false;
 }
 
-OmpErrorArgs GetErrorDirectiveArgs(const parser::OmpDirectiveSpecification &spec) {
+OmpErrorArgs GetErrorDirectiveArgs(
+    const parser::OmpDirectiveSpecification &spec) {
   OmpErrorArgs args;
   for (const parser::OmpClause &clause : spec.Clauses().v) {
     if (const auto *at{std::get_if<parser::OmpClause::At>(&clause.u)}) {



More information about the flang-commits mailing list