[flang] Fix issues 518 and 546

- Only allow out-of-scope label target for label-do-stmt
  when the label is on an end-stmt of a scope directly nested
  into the one of the label-do-stmt.
- Also transform label-do-stmt into non-label-do constructs
  so that later phases do not have to handle label-do-stmt.

Original-commit: flang-compiler/f18@91cff2f296
Reviewed-on: https://github.com/flang-compiler/f18/pull/552
Tree-same-pre-rewrite: false

flang/lib/semantics/canonicalize-do.cc

@@ -33,6 +33,30 @@ public:
         std::visit(
             common::visitors{
                 [](auto &) {},
+                // Labels on end-stmt of constructs are accepted by f18 for
+                // compatibility purposes, even-though they are technically
+                // not in the same scope as the label-do-stmt.
+                [&](common::Indirection<IfConstruct> &ifConstruct) {
+                  CanonicalizeIfMatch(block, stack, i,
+                      std::get<Statement<EndIfStmt>>(ifConstruct.value().t));
+                },
+                [&](common::Indirection<DoConstruct> &doConstruct) {
+                  CanonicalizeIfMatch(block, stack, i,
+                      std::get<Statement<EndDoStmt>>(doConstruct.value().t));
+                },
+                [&](common::Indirection<CaseConstruct> &caseConstruct) {
+                  CanonicalizeIfMatch(block, stack, i,
+                      std::get<Statement<EndSelectStmt>>(
+                          caseConstruct.value().t));
+                },
+                [&](common::Indirection<SelectRankConstruct> &selectRank) {
+                  CanonicalizeIfMatch(block, stack, i,
+                      std::get<Statement<EndSelectStmt>>(selectRank.value().t));
+                },
+                [&](common::Indirection<SelectTypeConstruct> &selectType) {
+                  CanonicalizeIfMatch(block, stack, i,
+                      std::get<Statement<EndSelectStmt>>(selectType.value().t));
+                },
                 [&](Statement<common::Indirection<LabelDoStmt>> &labelDoStmt) {
                   auto &label{std::get<Label>(labelDoStmt.statement.value().t)};
                   stack.push_back(LabelInfo{i, label});

flang/lib/semantics/resolve-labels.cc

@@ -38,6 +38,7 @@ struct LabeledStatementInfoTuplePOD {
   ProxyForScope proxyForScope;
   parser::CharBlock parserCharBlock;
   LabeledStmtClassificationSet labeledStmtClassificationSet;
+  bool legacyAcceptedInDirectSubscope;
 };
 using TargetStmtMap = std::map<parser::Label, LabeledStatementInfoTuplePOD>;
 struct SourceStatementInfoTuplePOD {
@@ -209,6 +210,14 @@ const parser::CharBlock *GetStmtName(const parser::Statement<A> &stmt) {
   return nullptr;
 }
 
+template<typename A>
+static constexpr bool LabelDoTargetAcceptedInDirectSubscopeOn(
+    const parser::Statement<A> &statement) {
+  return (std::is_same_v<A, parser::EndIfStmt> ||
+      std::is_same_v<A, parser::EndDoStmt> ||
+      std::is_same_v<A, parser::EndSelectStmt>);
+}
+
 class ParseTreeAnalyzer {
 public:
   ParseTreeAnalyzer(ParseTreeAnalyzer &&that) = default;
@@ -223,6 +232,7 @@ public:
     if (statement.label.has_value()) {
       auto label{statement.label.value()};
       auto targetFlags{ConstructBranchTargetFlags(statement)};
+      bool canBeParentLabel{LabelDoTargetAcceptedInDirectSubscopeOn(statement)};
       if constexpr (std::is_same_v<A, parser::AssociateStmt> ||
           std::is_same_v<A, parser::BlockStmt> ||
           std::is_same_v<A, parser::ChangeTeamStmt> ||
@@ -233,10 +243,12 @@ public:
           std::is_same_v<A, parser::SelectRankStmt> ||
           std::is_same_v<A, parser::SelectTypeStmt>) {
         constexpr bool useParent{true};
-        AddTargetLabelDefinition(useParent, label, targetFlags);
+        AddTargetLabelDefinition(
+            useParent, label, targetFlags, canBeParentLabel);
       } else {
         constexpr bool useParent{false};
-        AddTargetLabelDefinition(useParent, label, targetFlags);
+        AddTargetLabelDefinition(
+            useParent, label, targetFlags, canBeParentLabel);
       }
     }
     return true;
@@ -737,12 +749,13 @@ private:
 
   // 6.2.5., paragraph 2
   void AddTargetLabelDefinition(bool useParent, parser::Label label,
-      LabeledStmtClassificationSet labeledStmtClassificationSet) {
+      LabeledStmtClassificationSet labeledStmtClassificationSet,
+      bool legacyAcceptedInDirectSubscope) {
     CheckLabelInRange(label);
     const auto pair{programUnits_.back().targetStmts.emplace(label,
         LabeledStatementInfoTuplePOD{
             (useParent ? ParentScope() : currentScope_), currentPosition_,
-            labeledStmtClassificationSet})};
+            labeledStmtClassificationSet, legacyAcceptedInDirectSubscope})};
     if (!pair.second) {
       errorHandler_.Say(currentPosition_,
           parser::MessageFormattedText{
@@ -812,7 +825,7 @@ LabeledStatementInfoTuplePOD GetLabel(
     const TargetStmtMap &labels, const parser::Label &label) {
   const auto iter{labels.find(label)};
   if (iter == labels.cend()) {
-    return {0u, nullptr, LabeledStmtClassificationSet{}};
+    return {0u, nullptr, LabeledStmtClassificationSet{}, false};
   } else {
     return iter->second;
   }
@@ -867,6 +880,11 @@ parser::CharBlock SkipLabel(const parser::CharBlock &position) {
   return position;
 }
 
+ProxyForScope ParentScope(
+    const std::vector<ProxyForScope> &scopes, ProxyForScope scope) {
+  return scopes[scope];
+}
+
 void CheckLabelDoConstraints(const SourceStmtList &dos,
     const SourceStmtList &branches, const TargetStmtMap &labels,
     const std::vector<ProxyForScope> &scopes, parser::Messages &errorHandler) {
@@ -889,9 +907,16 @@ void CheckLabelDoConstraints(const SourceStmtList &dos,
               SayLabel(label)});
     } else if (!InInclusiveScope(scopes, scope, doTarget.proxyForScope)) {
       // C1133
-      errorHandler.Say(position,
+      if (doTarget.legacyAcceptedInDirectSubscope &&
-          parser::MessageFormattedText{
+          ParentScope(scopes, doTarget.proxyForScope) == scope) {
-              "label '%u' is not in scope"_en_US, SayLabel(label)});
+        errorHandler.Say(doTarget.parserCharBlock,
+            parser::MessageFormattedText{
+                "A DO loop should terminate with an END DO or CONTINUE inside its scope"_en_US});
+      } else {
+        errorHandler.Say(position,
+            parser::MessageFormattedText{
+                "label '%u' is not in scope"_err_en_US, SayLabel(label)});
+      }
     } else if (!doTarget.labeledStmtClassificationSet.test(
                    TargetStatementEnum::Do)) {
       if (!doTarget.labeledStmtClassificationSet.test(

flang/test/semantics/label14.f90

@@ -0,0 +1,34 @@
+! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+! RUN: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
+! CHECK: A DO loop should terminate with an END DO or CONTINUE inside its scope
+! CHECK: A DO loop should terminate with an END DO or CONTINUE inside its scope
+! CHECK: A DO loop should terminate with an END DO or CONTINUE inside its scope
+
+  do 1 j=1,2
+    if (.true.) then
+1   end if
+  do 2 k=1,2
+    do i=3,4
+      print*, i+k
+2    end do
+  do 3 l=1,2
+    select case (l)
+    case default
+      print*, "default"
+    case (1)
+      print*, "start"
+3    end select
+  end