[flang] Catch branching into FORALL/WHERE constructs

Enforce constraints C1034 & C1038, which disallow the use
of otherwise valid statements as branch targets when they
appear in FORALL &/or WHERE constructs.  (And make the
diagnostic message somewhat more user-friendly.)

Differential Revision: https://reviews.llvm.org/D109936

Author: klausler

flang/lib/Semantics/resolve-labels.cpp

@@ -60,7 +60,7 @@ constexpr Legality IsLegalDoTerm(const parser::Statement<A> &) {
       std::is_same_v<A, parser::EndWhereStmt>) {
     // Executable construct end statements are also supported as
     // an extension but they need special care because the associated
-    // construct create there own scope.
+    // construct create their own scope.
     return Legality::formerly;
   } else {
     return Legality::never;
@@ -224,10 +224,10 @@ class ParseTreeAnalyzer {
         parser::BlockStmt, parser::ChangeTeamStmt, parser::CriticalStmt,
         parser::IfThenStmt, parser::NonLabelDoStmt, parser::SelectCaseStmt,
         parser::SelectRankStmt, parser::SelectTypeStmt>;
-    using LabeledConstructEndStmts =
-        std::tuple<parser::EndAssociateStmt, parser::EndBlockStmt,
-            parser::EndChangeTeamStmt, parser::EndCriticalStmt,
-            parser::EndDoStmt, parser::EndIfStmt, parser::EndSelectStmt>;
+    using LabeledConstructEndStmts = std::tuple<parser::EndAssociateStmt,
+        parser::EndBlockStmt, parser::EndChangeTeamStmt,
+        parser::EndCriticalStmt, parser::EndDoStmt, parser::EndForallStmt,
+        parser::EndIfStmt, parser::EndSelectStmt, parser::EndWhereStmt>;
     using LabeledProgramUnitEndStmts =
         std::tuple<parser::EndFunctionStmt, parser::EndMpSubprogramStmt,
             parser::EndProgramStmt, parser::EndSubroutineStmt>;
@@ -294,10 +294,10 @@ class ParseTreeAnalyzer {
     return SwitchToNewScope();
   }
   bool Pre(const parser::WhereConstruct &whereConstruct) {
-    return PushConstructNameWithoutBlock(whereConstruct);
+    return PushConstructName(whereConstruct);
   }
   bool Pre(const parser::ForallConstruct &forallConstruct) {
-    return PushConstructNameWithoutBlock(forallConstruct);
+    return PushConstructName(forallConstruct);
   }
 
   void Post(const parser::AssociateConstruct &associateConstruct) {
@@ -327,12 +327,11 @@ class ParseTreeAnalyzer {
   void Post(const parser::SelectTypeConstruct &selectTypeConstruct) {
     PopConstructName(selectTypeConstruct);
   }
-
   void Post(const parser::WhereConstruct &whereConstruct) {
-    PopConstructNameWithoutBlock(whereConstruct);
+    PopConstructName(whereConstruct);
   }
   void Post(const parser::ForallConstruct &forallConstruct) {
-    PopConstructNameWithoutBlock(forallConstruct);
+    PopConstructName(forallConstruct);
   }
 
   // Checks for missing or mismatching names on various constructs (e.g., IF)
@@ -570,18 +569,6 @@ class ParseTreeAnalyzer {
     }
     return PushSubscope();
   }
-  template <typename A> bool PushConstructNameWithoutBlock(const A &a) {
-    const auto &optionalName{std::get<0>(std::get<0>(a.t).statement.t)};
-    if (optionalName) {
-      constructNames_.emplace_back(optionalName->ToString());
-    }
-    return true;
-  }
-
-  template <typename A> void PopConstructNameWithoutBlock(const A &a) {
-    CheckName(a);
-    PopConstructNameIfPresent(a);
-  }
   template <typename A> void PopConstructNameIfPresent(const A &a) {
     const auto &optionalName{std::get<0>(std::get<0>(a.t).statement.t)};
     if (optionalName) {
@@ -962,12 +949,15 @@ void CheckScopeConstraints(const SourceStmtList &stmts,
     } else if (!InInclusiveScope(scopes, scope, target.proxyForScope)) {
       // Clause 11.1.2.1 prohibits transfer of control to the interior of a
       // block from outside the block, but this does not apply to formats.
+      // C1038 and C1034 forbid statements in FORALL and WHERE constructs
+      // (resp.) from being branch targets.
       if (target.labeledStmtClassificationSet.test(
               TargetStatementEnum::Format)) {
         continue;
       }
-      context.Say(
-          position, "Label '%u' is not in scope"_en_US, SayLabel(label));
+      context.Say(position,
+          "Label '%u' is in a construct that prevents its use as a branch target here"_en_US,
+          SayLabel(label));
     }
   }
 }

flang/test/Semantics/label05.f90

@@ -1,9 +1,12 @@
-
 ! RUN: not %flang_fc1 -fdebug-unparse-with-symbols %s 2>&1 | FileCheck %s
 ! CHECK: Label '50' was not found
-! CHECK: Label '55' is not in scope
+! CHECK: Label '55' is in a construct that prevents its use as a branch target here
 ! CHECK: Label '70' is not a branch target
 ! CHECK: Control flow use of '70'
+! CHECK: Label '80' is in a construct that prevents its use as a branch target here
+! CHECK: Label '90' is in a construct that prevents its use as a branch target here
+! CHECK: Label '91' is in a construct that prevents its use as a branch target here
+! CHECK: Label '92' is in a construct that prevents its use as a branch target here
 
 subroutine sub00(a,b,n,m)
   real a(n,m)
@@ -35,3 +38,23 @@ subroutine sub02(a,b,n,m)
   end if
 70 FORMAT (1x,i6)
 end subroutine sub02
+
+subroutine sub03(a,n)
+  real a(n)
+  forall (j=1:n)
+80  a(n) = j
+  end forall
+  go to 80
+end subroutine sub03
+
+subroutine sub04(a,n)
+  real a(n)
+  where (a > 0)
+90  a = 1
+  elsewhere (a < 0)
+91  a = 2
+  elsewhere
+92  a = 3
+  end where
+  if (n - 3) 90, 91, 92
+end subroutine sub04

flang/test/Semantics/label06.f90

@@ -1,11 +1,10 @@
-
 ! RUN: not %flang_fc1 -fdebug-unparse-with-symbols %s 2>&1 | FileCheck %s
-! CHECK: Label '10' is not in scope
+! CHECK: Label '10' is in a construct that prevents its use as a branch target here
 ! CHECK: Label '20' was not found
 ! CHECK: Label '30' is not a branch target
 ! CHECK: Control flow use of '30'
-! CHECK: Label '40' is not in scope
-! CHECK: Label '50' is not in scope
+! CHECK: Label '40' is in a construct that prevents its use as a branch target here
+! CHECK: Label '50' is in a construct that prevents its use as a branch target here
 
 subroutine sub00(n)
   GOTO (10,20,30) n

flang/test/Semantics/label07.f90

@@ -1,8 +1,7 @@
-
 ! RUN: not %flang_fc1 -fdebug-unparse-with-symbols %s 2>&1 | FileCheck %s
 ! CHECK: Label '30' is not a branch target
 ! CHECK: Control flow use of '30'
-! CHECK: Label '10' is not in scope
+! CHECK: Label '10' is in a construct that prevents its use as a branch target here
 ! CHECK: Label '20' was not found
 ! CHECK: Label '60' was not found
 

flang/test/Semantics/label14.f90

@@ -3,7 +3,7 @@
 !            Block Construct
 
 ! RUN: %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
-! CHECK: Label '20' is not in scope
+! CHECK: Label '20' is in a construct that prevents its use as a branch target here
 
 subroutine s1
   block