Allow do concurrent with LOOP construct

There's some obscure language in OpenMP 6.0:

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

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>
@@ -737,9 +738,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:
@@ -1916,12 +1915,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
 }
 
@@ -1949,14 +1953,30 @@ 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()) {
-        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);
+        // 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)};

flang/test/Semantics/OpenMP/do-concurrent-collapse.f90

@@ -16,4 +16,24 @@
     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