[flang][OpenMP] Don't allow DO CONCURRENT inside of a loop nest (#144506)

I don't think DO CONCURRENT fits the definition of a Canonical Loop Nest (OpenMP 6.0 section 6.4.1). It is however explicitly allowed for the LOOP construct (6.0 section 13.8). There's some obscure language in OpenMP 6.0 for the LOOP construct: > If the collapsed loop is a DO CONCURRENT loop, neither the > data-sharing attribute clauses nor the collapse clause may be specified. From the surrounding context, I think "collapsed loop" just means the loop that the LOOP construct applies to. So I will interpret this to mean that DO CONCURRENT can only be used with the LOOP construct if it does not contain the COLLAPSE clause. This also fixes a bug where the associated clause was never cleared after it was set. Fixes #144178

Author: tblah

flang/lib/Semantics/resolve-directives.cpp

@@ -23,6 +23,7 @@
 #include "flang/Semantics/openmp-modifiers.h"
 #include "flang/Semantics/symbol.h"
 #include "flang/Semantics/tools.h"
+#include "llvm/Frontend/OpenMP/OMP.h.inc"
 #include "llvm/Support/Debug.h"
 #include <list>
 #include <map>
@@ -740,9 +741,7 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
  }
 
  const parser::OmpClause *associatedClause{nullptr};
- void SetAssociatedClause(const parser::OmpClause &c) {
- associatedClause = &c;
- }
+ void SetAssociatedClause(const parser::OmpClause *c) { associatedClause = c; }
  const parser::OmpClause *GetAssociatedClause() { return associatedClause; }
 
 private:
@@ -1919,12 +1918,17 @@ std::int64_t OmpAttributeVisitor::GetAssociatedLoopLevelFromClauses(
  }
 
  if (orderedLevel && (!collapseLevel || orderedLevel >= collapseLevel)) {
- SetAssociatedClause(*ordClause);
+ SetAssociatedClause(ordClause);
  return orderedLevel;
  } else if (!orderedLevel && collapseLevel) {
- SetAssociatedClause(*collClause);
+ SetAssociatedClause(collClause);
  return collapseLevel;
- } // orderedLevel < collapseLevel is an error handled in structural checks
+ } else {
+ SetAssociatedClause(nullptr);
+ }
+ // orderedLevel < collapseLevel is an error handled in structural
+ // checks
+
  return 1; // default is outermost loop
 }
 
@@ -1952,9 +1956,31 @@ void OmpAttributeVisitor::PrivatizeAssociatedLoopIndexAndCheckLoopLevel(
  ivDSA = Symbol::Flag::OmpLastPrivate;
  }
 
+ bool isLoopConstruct{
+ GetContext().directive == llvm::omp::Directive::OMPD_loop};
+ const parser::OmpClause *clause{GetAssociatedClause()};
+ bool hasCollapseClause{
+ clause ? (clause->Id() == llvm::omp::OMPC_collapse) : false};
+
  const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};
  if (outer.has_value()) {
  for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) {
+ if (loop->IsDoConcurrent()) {
+ // DO CONCURRENT is explicitly allowed for the LOOP construct so long as
+ // there isn't a COLLAPSE clause
+ if (isLoopConstruct) {
+ if (hasCollapseClause) {
+ // hasCollapseClause implies clause != nullptr
+ context_.Say(clause->source,
+ "DO CONCURRENT loops cannot be used with the COLLAPSE clause."_err_en_US);
+ }
+ } else {
+ auto &stmt =
+ std::get<parser::Statement<parser::NonLabelDoStmt>>(loop->t);
+ context_.Say(stmt.source,
+ "DO CONCURRENT loops cannot form part of a loop nest."_err_en_US);
+ }
+ }
  // go through all the nested do-loops and resolve index variables
  const parser::Name *iv{GetLoopIndex(*loop)};
  if (iv) {

flang/test/Lower/OpenMP/Todo/omp-doconcurrent.f90

@@ -0,0 +1,39 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp
+
+integer :: i, j
+!$omp parallel do collapse(2)
+do i = 1, 1
+ ! ERROR: DO CONCURRENT loops cannot form part of a loop nest.
+ do concurrent (j = 1:2)
+ print *, j
+ end do
+end do
+
+!$omp parallel do
+do i = 1, 1
+ ! This should not lead to an error because it is not part of a loop nest:
+ do concurrent (j = 1:2)
+ print *, j
+ end do
+end do
+
+!$omp parallel do
+! ERROR: DO CONCURRENT loops cannot form part of a loop nest.
+do concurrent (j = 1:2)
+ print *, j
+end do
+
+!$omp loop
+! Do concurrent is explicitly allowed inside of omp loop
+do concurrent (j = 1:2)
+ print *, j
+end do
+
+! ERROR: DO CONCURRENT loops cannot be used with the COLLAPSE clause.
+!$omp loop collapse(2)
+do i = 1, 1
+ do concurrent (j = 1:2)
+ print *, j
+ end do
+end do
+end