[flang][OpenMP] Reject END DO on construct that crosses label-DO (llvm#169714)

In a label-DO construct where two or more loops share the same
teminator, an OpenMP construct must enclose all the loops if an
end-directive is present. E.g.

```
  do 100 i = 1,10
!$omp do
    do 100 j = 1,10
    100 continue
!$omp end do    ! Error, but ok if this line is removed
```

Fixes llvm#169536.

Author: kparzysz

flang/include/flang/Parser/parse-tree.h

@@ -4982,7 +4982,7 @@ struct OmpClauseList {
 // --- Directives and constructs
 
 struct OmpDirectiveSpecification {
-  ENUM_CLASS(Flag, DeprecatedSyntax)
+  ENUM_CLASS(Flag, DeprecatedSyntax, CrossesLabelDo)
   using Flags = common::EnumSet<Flag, Flag_enumSize>;
 
   TUPLE_CLASS_BOILERPLATE(OmpDirectiveSpecification);

flang/lib/Semantics/canonicalize-do.cpp

@@ -92,8 +92,12 @@ class CanonicalizationOfDoLoops {
                 [&](common::Indirection<OpenMPConstruct> &construct) {
                   // If the body of the OpenMP construct ends with a label,
                   // treat the label as ending the construct itself.
-                  CanonicalizeIfMatch(
-                      block, stack, i, omp::GetFinalLabel(construct.value()));
+                  OpenMPConstruct &omp{construct.value()};
+                  if (CanonicalizeIfMatch(
+                          block, stack, i, omp::GetFinalLabel(omp))) {
+                    MarkOpenMPConstruct(
+                        omp, OmpDirectiveSpecification::Flag::CrossesLabelDo);
+                  }
                 },
             },
             executableConstruct->u);
@@ -103,12 +107,12 @@ class CanonicalizationOfDoLoops {
 
 private:
   template <typename T>
-  void CanonicalizeIfMatch(Block &originalBlock, std::vector<LabelInfo> &stack,
+  bool CanonicalizeIfMatch(Block &originalBlock, std::vector<LabelInfo> &stack,
       Block::iterator &i, Statement<T> &statement) {
-    CanonicalizeIfMatch(originalBlock, stack, i, statement.label);
+    return CanonicalizeIfMatch(originalBlock, stack, i, statement.label);
   }
 
-  void CanonicalizeIfMatch(Block &originalBlock, std::vector<LabelInfo> &stack,
+  bool CanonicalizeIfMatch(Block &originalBlock, std::vector<LabelInfo> &stack,
       Block::iterator &i, std::optional<Label> label) {
     if (!stack.empty() && label && stack.back().label == *label) {
       auto currentLabel{stack.back().label};
@@ -141,8 +145,27 @@ class CanonicalizationOfDoLoops {
         stack.pop_back();
       } while (!stack.empty() && stack.back().label == currentLabel);
       i = --next;
+      return true;
+    } else {
+      return false;
     }
   }
+
+  void MarkOpenMPConstruct(
+      OpenMPConstruct &omp, OmpDirectiveSpecification::Flag flag) {
+    common::visit(
+        [&](const auto &s) {
+          using S = std::decay_t<decltype(s)>;
+          if constexpr (std::is_base_of_v<OmpBlockConstruct, S> ||
+              std::is_same_v<OpenMPLoopConstruct, S>) {
+            const OmpDirectiveSpecification &beginSpec{s.BeginDir()};
+            auto &flags{
+                std::get<OmpDirectiveSpecification::Flags>(beginSpec.t)};
+            const_cast<OmpDirectiveSpecification::Flags &>(flags).set(flag);
+          }
+        },
+        omp.u);
+  }
 };
 
 bool CanonicalizeDo(Program &program) {

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

@@ -290,6 +290,25 @@ void OmpStructureChecker::CheckNestedConstruct(
     const parser::OpenMPLoopConstruct &x) {
   size_t nestedCount{0};
 
+  // End-directive is not allowed in such cases:
+  //   do 100 i = ...
+  //     !$omp do
+  //     do 100 j = ...
+  //   100 continue
+  //   !$omp end do    ! error
+  const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()};
+  auto &flags{std::get<parser::OmpDirectiveSpecification::Flags>(beginSpec.t)};
+  if (flags.test(parser::OmpDirectiveSpecification::Flag::CrossesLabelDo)) {
+    if (auto &endSpec{x.EndDir()}) {
+      parser::CharBlock beginSource{beginSpec.DirName().source};
+      context_
+          .Say(endSpec->DirName().source,
+              "END %s directive is not allowed when the construct does not contain all loops that share a loop-terminating statement"_err_en_US,
+              parser::ToUpperCaseLetters(beginSource.ToString()))
+          .Attach(beginSource, "The construct starts here"_en_US);
+    }
+  }
+
   auto &body{std::get<parser::Block>(x.t)};
   if (body.empty()) {
     context_.Say(x.source,

flang/test/Parser/OpenMP/atomic-label-do.f90

@@ -29,7 +29,7 @@ subroutine f
 !PARSE-TREE: | | | OmpBeginDirective
 !PARSE-TREE: | | | | OmpDirectiveName -> llvm::omp::Directive = atomic
 !PARSE-TREE: | | | | OmpClauseList -> OmpClause -> Write
-!PARSE-TREE: | | | | Flags = {}
+!PARSE-TREE: | | | | Flags = {CrossesLabelDo}
 !PARSE-TREE: | | | Block
 !PARSE-TREE: | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'x=i'
 !PARSE-TREE: | | | | | Variable = 'x'

flang/test/Parser/OpenMP/cross-label-do.f90

@@ -32,7 +32,7 @@ subroutine f00
 !PARSE-TREE: | | | OmpBeginLoopDirective
 !PARSE-TREE: | | | | OmpDirectiveName -> llvm::omp::Directive = do
 !PARSE-TREE: | | | | OmpClauseList ->
-!PARSE-TREE: | | | | Flags = {}
+!PARSE-TREE: | | | | Flags = {CrossesLabelDo}
 !PARSE-TREE: | | | Block
 !PARSE-TREE: | | | | ExecutionPartConstruct -> ExecutableConstruct -> DoConstruct
 !PARSE-TREE: | | | | | NonLabelDoStmt

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

@@ -64,6 +64,7 @@
      do 100 j=1, N
         a = 3.14
 100     continue
+    !ERROR: END DO directive is not allowed when the construct does not contain all loops that share a loop-terminating statement
     !$omp enddo
 
   !ERROR: Non-THREADPRIVATE object 'a' in COPYIN clause