[flang][OpenMP] Tolerate compiler directives in loop constructs

flang/lib/Lower/OpenMP/Utils.cpp

@@ -796,6 +796,28 @@ static void processTileSizesFromOpenMPConstruct(
   }
 }
 
+static pft::Evaluation *getNestedDoConstruct(pft::Evaluation &eval) {
+  for (pft::Evaluation &nested : eval.getNestedEvaluations()) {
+    // In an OpenMPConstruct there can be compiler directives:
+    // 1 <<OpenMPConstruct>>
+    //     2 CompilerDirective: !unroll
+    //     <<DoConstruct>> -> 8
+    if (nested.getIf<parser::CompilerDirective>())
+      continue;
+    // Within a DoConstruct, there can be compiler directives, plus
+    // there is a DoStmt before the body:
+    // <<DoConstruct>> -> 8
+    //     3 NonLabelDoStmt -> 7: do i = 1, n
+    //     <<DoConstruct>> -> 7
+    if (nested.getIf<parser::NonLabelDoStmt>())
+      continue;
+    assert(nested.getIf<parser::DoConstruct>() &&
+           "Unexpected construct in the nested evaluations");
+    return &nested;
+  }
+  llvm_unreachable("Expected do loop to be in the nested evaluations");
+}
+
 /// Populates the sizes vector with values if the given OpenMPConstruct
 /// contains a loop construct with an inner tiling construct.
 void collectTileSizesFromOpenMPConstruct(
@@ -818,7 +840,7 @@ int64_t collectLoopRelatedInfo(
   int64_t numCollapse = 1;
 
   // Collect the loops to collapse.
-  lower::pft::Evaluation *doConstructEval = &eval.getFirstNestedEvaluation();
+  lower::pft::Evaluation *doConstructEval = getNestedDoConstruct(eval);
   if (doConstructEval->getIf<parser::DoConstruct>()->IsDoConcurrent()) {
     TODO(currentLocation, "Do Concurrent in Worksharing loop construct");
   }
@@ -844,7 +866,7 @@ void collectLoopRelatedInfo(
   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
 
   // Collect the loops to collapse.
-  lower::pft::Evaluation *doConstructEval = &eval.getFirstNestedEvaluation();
+  lower::pft::Evaluation *doConstructEval = getNestedDoConstruct(eval);
   if (doConstructEval->getIf<parser::DoConstruct>()->IsDoConcurrent()) {
     TODO(currentLocation, "Do Concurrent in Worksharing loop construct");
   }
@@ -885,9 +907,8 @@ void collectLoopRelatedInfo(
     iv.push_back(bounds->name.thing.symbol);
     loopVarTypeSize = std::max(loopVarTypeSize,
                                bounds->name.thing.symbol->GetUltimate().size());
-    collapseValue--;
-    doConstructEval =
-        &*std::next(doConstructEval->getNestedEvaluations().begin());
+    if (--collapseValue)
+      doConstructEval = getNestedDoConstruct(*doConstructEval);
   } while (collapseValue > 0);
 
   convertLoopBounds(converter, currentLocation, result, loopVarTypeSize);

flang/lib/Semantics/check-omp-loop.cpp

@@ -267,7 +267,7 @@ void OmpStructureChecker::CheckNestedBlock(const parser::OpenMPLoopConstruct &x,
   for (auto &stmt : body) {
     if (auto *dir{parser::Unwrap<parser::CompilerDirective>(stmt)}) {
       context_.Say(dir->source,
-          "Compiler directives are not allowed inside OpenMP loop constructs"_err_en_US);
+          "Compiler directives are not allowed inside OpenMP loop constructs"_warn_en_US);
     } else if (parser::Unwrap<parser::DoConstruct>(stmt)) {
       ++nestedCount;
     } else if (auto *omp{parser::Unwrap<parser::OpenMPLoopConstruct>(stmt)}) {

flang/lib/Semantics/resolve-directives.cpp

@@ -2419,13 +2419,6 @@ void OmpAttributeVisitor::PrivatizeAssociatedLoopIndexAndCheckLoopLevel(
         }
       }
       CheckAssocLoopLevel(level, GetAssociatedClause());
-    } else {
-      unsigned version{context_.langOptions().OpenMPVersion};
-      context_.Say(GetContext().directiveSource,
-          "A DO loop must follow the %s directive"_err_en_US,
-          parser::ToUpperCaseLetters(
-              llvm::omp::getOpenMPDirectiveName(GetContext().directive, version)
-                  .str()));
     }
   }
 }

flang/test/Semantics/OpenMP/compiler-directives-loop.f90

@@ -0,0 +1,21 @@
+!RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=60 %s -o - | FileCheck %s
+
+! Check that this compiles successfully, but not rely on any specific output.
+
+!CHECK: omp.parallel
+
+program omp_cdir_crash
+  implicit none
+  integer, parameter :: n = 10
+  real :: a(n)
+  integer :: i
+
+!$omp parallel do
+!dir$ unroll
+  do i = 1, n
+    a(i) = real(i)
+  end do
+!$omp end parallel do
+
+  print *, 'a(1)=', a(1), ' a(n)=', a(n)
+end program omp_cdir_crash

flang/test/Semantics/OpenMP/loop-association.f90

@@ -33,10 +33,9 @@
   END DO outer
 
   ! Accept directives between parallel do and actual loop.
-  !ERROR: A DO loop must follow the PARALLEL DO directive
   !$OMP PARALLEL DO
   !WARNING: Unrecognized compiler directive was ignored [-Wignored-directive]
-  !ERROR: Compiler directives are not allowed inside OpenMP loop constructs
+  !WARNING: Compiler directives are not allowed inside OpenMP loop constructs
   !DIR$ VECTOR ALIGNED
   DO 20 i=1,N
      a = a + 0.5