[flang] Disallow branches into SELECT TYPE/RANK cases

[klausler]

Ensure that a branch cannot be made into a case of a SELECT TYPE or SELECT RANK construct.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

Ensure that a branch cannot be made into a case of a SELECT TYPE or SELECT RANK construct.

---

Full diff: https://github.com/llvm/llvm-project/pull/93893.diff

2 Files Affected:

• (modified) flang/lib/Semantics/resolve-labels.cpp (+13-15)
• (modified) flang/test/Semantics/label05.f90 (+32)

diff --git a/flang/lib/Semantics/resolve-labels.cpp b/flang/lib/Semantics/resolve-labels.cpp
index 63fc2e1168b88..e5e96ec6327e2 100644
--- a/flang/lib/Semantics/resolve-labels.cpp
+++ b/flang/lib/Semantics/resolve-labels.cpp
@@ -282,7 +282,7 @@ class ParseTreeAnalyzer {
       constructNames_.emplace_back(optionalName->ToString());
     }
     // Allow FORTRAN '66 extended DO ranges
-    PushScope().isExteriorGotoFatal = false;
+    PushScope(false);
     // Process labels of the DO and END DO statements, but not the
     // statements themselves, so that a non-construct END DO
     // can be distinguished (below).
@@ -302,7 +302,7 @@ class ParseTreeAnalyzer {
   bool Pre(const parser::IfConstruct &ifConstruct) {
     return PushConstructName(ifConstruct);
   }
-  void Post(const parser::IfThenStmt &) { PushScope(); }
+  void Post(const parser::IfThenStmt &) { PushScope(false); }
   bool Pre(const parser::IfConstruct::ElseIfBlock &) {
     return SwitchToNewScope();
   }
@@ -316,19 +316,19 @@ class ParseTreeAnalyzer {
   bool Pre(const parser::CaseConstruct &caseConstruct) {
     return PushConstructName(caseConstruct);
   }
-  void Post(const parser::SelectCaseStmt &) { PushScope(); }
+  void Post(const parser::SelectCaseStmt &) { PushScope(false); }
   bool Pre(const parser::CaseConstruct::Case &) { return SwitchToNewScope(); }
   bool Pre(const parser::SelectRankConstruct &selectRankConstruct) {
     return PushConstructName(selectRankConstruct);
   }
-  void Post(const parser::SelectRankStmt &) { PushScope(); }
+  void Post(const parser::SelectRankStmt &) { PushScope(true); }
   bool Pre(const parser::SelectRankConstruct::RankCase &) {
     return SwitchToNewScope();
   }
   bool Pre(const parser::SelectTypeConstruct &selectTypeConstruct) {
     return PushConstructName(selectTypeConstruct);
   }
-  void Post(const parser::SelectTypeStmt &) { PushScope(); }
+  void Post(const parser::SelectTypeStmt &) { PushScope(true); }
   bool Pre(const parser::SelectTypeConstruct::TypeCase &) {
     return SwitchToNewScope();
   }
@@ -580,19 +580,20 @@ class ParseTreeAnalyzer {
   SemanticsContext &ErrorHandler() { return context_; }
 
 private:
-  ScopeInfo &PushScope() {
+  ScopeInfo &PushScope(bool isExteriorGotoFatal) {
     auto &model{programUnits_.back().scopeModel};
     int newDepth{model.empty() ? 1 : model[currentScope_].depth + 1};
     ScopeInfo &result{model.emplace_back()};
     result.parent = currentScope_;
     result.depth = newDepth;
+    result.isExteriorGotoFatal = isExteriorGotoFatal;
     currentScope_ = model.size() - 1;
     return result;
   }
   bool InitializeNewScopeContext() {
     programUnits_.emplace_back(UnitAnalysis{});
     currentScope_ = 0u;
-    PushScope();
+    PushScope(false);
     return true;
   }
   ScopeInfo &PopScope() {
@@ -604,9 +605,7 @@ class ParseTreeAnalyzer {
     return programUnits_.back().scopeModel[currentScope_].parent;
   }
   bool SwitchToNewScope() {
-    ScopeInfo &oldScope{PopScope()};
-    bool isExteriorGotoFatal{oldScope.isExteriorGotoFatal};
-    PushScope().isExteriorGotoFatal = isExteriorGotoFatal;
+    PushScope(PopScope().isExteriorGotoFatal);
     return true;
   }
 
@@ -617,10 +616,9 @@ class ParseTreeAnalyzer {
     }
     // Gotos into this construct from outside it are diagnosed, and
     // are fatal unless the construct is a DO, IF, or SELECT CASE.
-    PushScope().isExteriorGotoFatal =
-        !(std::is_same_v<A, parser::DoConstruct> ||
-            std::is_same_v<A, parser::IfConstruct> ||
-            std::is_same_v<A, parser::CaseConstruct>);
+    PushScope(!(std::is_same_v<A, parser::DoConstruct> ||
+        std::is_same_v<A, parser::IfConstruct> ||
+        std::is_same_v<A, parser::CaseConstruct>));
     return true;
   }
   bool PushConstructName(const parser::BlockConstruct &blockConstruct) {
@@ -630,7 +628,7 @@ class ParseTreeAnalyzer {
     if (optionalName) {
       constructNames_.emplace_back(optionalName->ToString());
     }
-    PushScope().isExteriorGotoFatal = true;
+    PushScope(true);
     return true;
   }
   template <typename A> void PopConstructNameIfPresent(const A &a) {
diff --git a/flang/test/Semantics/label05.f90 b/flang/test/Semantics/label05.f90
index 944bb438f28d6..7f5067e282f4c 100644
--- a/flang/test/Semantics/label05.f90
+++ b/flang/test/Semantics/label05.f90
@@ -7,6 +7,12 @@
 ! CHECK: error: Label '90' is in a construct that prevents its use as a branch target here
 ! CHECK: error: Label '91' is in a construct that prevents its use as a branch target here
 ! CHECK: error: Label '92' is in a construct that prevents its use as a branch target here
+! CHECK: error: Label '30' is in a construct that prevents its use as a branch target here
+! CHECK: error: Label '31' is in a construct that prevents its use as a branch target here
+! CHECK-NOT: error: Label '32' is in a construct that prevents its use as a branch target here
+! CHECK: error: Label '40' is in a construct that prevents its use as a branch target here
+! CHECK: error: Label '41' is in a construct that prevents its use as a branch target here
+! CHECK-NOT: error: Label '42' is in a construct that prevents its use as a branch target here
 
 subroutine sub00(a,b,n,m)
   real a(n,m)
@@ -58,3 +64,29 @@ subroutine sub04(a,n)
   end where
   if (n - 3) 90, 91, 92
 end subroutine sub04
+
+subroutine sub05(a)
+  real a(..)
+  select rank (a)
+  rank(1)
+31  goto 30
+  rank(2)
+    goto 32
+32  continue
+30  continue
+  end select
+  goto 31
+end
+
+subroutine sub06(a)
+  class(*) a
+  select type (a)
+  type is (integer)
+41  goto 40
+  type is (real)
+    goto 42
+42  continue
+40  continue
+  end select
+  goto 41
+end

[jeanPerier]

Thanks for the fast patch, that will make lowering safer!