[flang] Responses to review comments and team meeting

The most significant change is that I replaced the stack of
ExecutableConstruct's with a stack composed of ConstructNode's, each of which
is a variant of the constructs that made up the type ExecutableConstruct.  This
change allows the nodes of the stack to be extended to include the types needed
for OMP semantic checking.

I also extended the existing test to include some correct DO loops with CYCLE
and EXIT statements to test the code more completely.

Original-commit: flang-compiler/f18@d26f34e
Reviewed-on: flang-compiler/f18#686
Tree-same-pre-rewrite: false

flang/lib/semantics/check-do.cc

@@ -647,21 +647,20 @@ void DoChecker::Leave(const parser::DoConstruct &x) {
   doContext.Check(x);
 }
 
-void DoChecker::CheckLoneStmt(const char *stmtString) const {
-  for (auto &executable : context_.executables()) {
-    if (std::holds_alternative<common::Indirection<parser::DoConstruct>>(
-            executable->u)) {
-      return;
-    }
+// C1134
+void DoChecker::Enter(const parser::CycleStmt &) {
+  if (!context_.InsideDoConstruct()) {
+    context_.Say(
+        *context_.location(), "CYCLE must be within a DO construct"_err_en_US);
   }
-  context_.Say(*context_.location(),
-      "%s must be within a DO construct"_err_en_US, stmtString);
 }
 
-// C1134
-void DoChecker::Enter(const parser::CycleStmt &) { CheckLoneStmt("CYCLE"); }
-
 // C1166
-void DoChecker::Enter(const parser::ExitStmt &) { CheckLoneStmt("EXIT"); }
+void DoChecker::Enter(const parser::ExitStmt &) {
+  if (!context_.InsideDoConstruct()) {
+    context_.Say(
+        *context_.location(), "EXIT must be within a DO construct"_err_en_US);
+  }
+}
 
 }  // namespace Fortran::semantics

flang/lib/semantics/check-do.h

@@ -19,6 +19,8 @@
 
 namespace Fortran::parser {
 struct DoConstruct;
+struct CycleStmt;
+struct ExitStmt;
 }
 
 namespace Fortran::semantics {
@@ -31,8 +33,6 @@ class DoChecker : public virtual BaseChecker {
   void Enter(const parser::ExitStmt &);
 
 private:
-  void CheckLoneStmt(const char *const) const;
-
   SemanticsContext &context_;
 };
 }

flang/lib/semantics/semantics.cc

@@ -81,15 +81,125 @@ template<typename... C> class SemanticsVisitor : public virtual C... {
     context_.set_location(std::nullopt);
   }
 
-  bool Pre(const parser::ExecutableConstruct &executable) {
-    context_.PushExecutable(executable);
-    Enter(executable);
+  bool Pre(const parser::AssociateConstruct &associateConstruct) {
+    context_.PushConstruct(&associateConstruct);
+    Enter(associateConstruct);
     return true;
   }
 
-  void Post(const parser::ExecutableConstruct &executable) {
-    Leave(executable);
-    context_.PopExecutable();
+  bool Pre(const parser::BlockConstruct &blockConstruct) {
+    context_.PushConstruct(&blockConstruct);
+    Enter(blockConstruct);
+    return true;
+  }
+
+  bool Pre(const parser::CaseConstruct &caseConstruct) {
+    context_.PushConstruct(&caseConstruct);
+    Enter(caseConstruct);
+    return true;
+  }
+
+  bool Pre(const parser::DoConstruct &doConstruct) {
+    context_.PushConstruct(&doConstruct);
+    Enter(doConstruct);
+    return true;
+  }
+
+  bool Pre(const parser::CriticalConstruct &criticalConstruct) {
+    context_.PushConstruct(&criticalConstruct);
+    Enter(criticalConstruct);
+    return true;
+  }
+
+  bool Pre(const parser::ChangeTeamConstruct &changeTeamConstruct) {
+    context_.PushConstruct(&changeTeamConstruct);
+    Enter(changeTeamConstruct);
+    return true;
+  }
+
+  bool Pre(const parser::ForAllConstruct &forAllConstruct) {
+    context_.PushConstruct(&forAllConstruct);
+    Enter(forAllConstruct);
+    return true;
+  }
+
+  bool Pre(const parser::IfConstruct &ifConstruct) {
+    context_.PushConstruct(&ifConstruct);
+    Enter(ifConstruct);
+    return true;
+  }
+
+  bool Pre(const parser::SelectRankConstruct &selectRankConstruct) {
+    context_.PushConstruct(&selectRankConstruct);
+    Enter(selectRankConstruct);
+    return true;
+  }
+
+  bool Pre(const parser::SelectTypeConstruct &selectTypeConstruct) {
+    context_.PushConstruct(&selectTypeConstruct);
+    Enter(selectTypeConstruct);
+    return true;
+  }
+
+  bool Pre(const parser::WhereConstruct &whereConstruct) {
+    context_.PushConstruct(&whereConstruct);
+    Enter(whereConstruct);
+    return true;
+  }
+
+  void Post(const parser::AssociateConstruct &associateConstruct) {
+    Leave(associateConstruct);
+    context_.PopConstruct();
+  }
+
+  void Post(const parser::BlockConstruct &blockConstruct) {
+    Leave(blockConstruct);
+    context_.PopConstruct();
+  }
+
+  void Post(const parser::CaseConstruct &caseConstruct) {
+    Leave(caseConstruct);
+    context_.PopConstruct();
+  }
+
+  void Post(const parser::DoConstruct &doConstruct) {
+    Leave(doConstruct);
+    context_.PopConstruct();
+  }
+
+  void Post(const parser::CriticalConstruct &criticalConstruct) {
+    Leave(criticalConstruct);
+    context_.PopConstruct();
+  }
+
+  void Post(const parser::ChangeTeamConstruct &changeTeamConstruct) {
+    Leave(changeTeamConstruct);
+    context_.PopConstruct();
+  }
+
+  void Post(const parser::ForAllConstruct &forAllConstruct) {
+    Leave(forAllConstruct);
+    context_.PopConstruct();
+  }
+
+  void Post(const parser::IfConstruct &ifConstruct) {
+    Leave(ifConstruct);
+    context_.PopConstruct();
+  }
+
+  void Post(const parser::SelectRankConstruct &selectRankConstruct) {
+    Leave(selectRankConstruct);
+    context_.PopConstruct();
+  }
+
+  void Post(const parser::SelectTypeConstruct &selectTypeConstruct) {
+    Leave(selectTypeConstruct);
+    context_.PopConstruct();
+  }
+
+  void Post(const parser::WhereConstruct &whereConstruct) {
+    Leave(whereConstruct);
+    context_.PopConstruct();
   }
 
   bool Walk(const parser::Program &program) {
@@ -188,14 +298,22 @@ Scope &SemanticsContext::FindScope(parser::CharBlock source) {
   }
 }
 
-void SemanticsContext::PushExecutable(
-    const parser::ExecutableConstruct &executable) {
-  executables_.push_back(&executable);
+void SemanticsContext::PushConstruct(const ConstructNode &construct) {
+  constructStack_.emplace_back(construct);
+}
+
+void SemanticsContext::PopConstruct() {
+  CHECK(!constructStack_.empty());
+  constructStack_.pop_back();
 }
 
-void SemanticsContext::PopExecutable() {
-  CHECK(executables_.size() > 0);
-  executables_.pop_back();
+bool SemanticsContext::InsideDoConstruct() const {
+  for (const ConstructNode construct : constructStack_) {
+    if (std::holds_alternative<const parser::DoConstruct *>(construct)) {
+      return true;
+    }
+  }
+  return false;
 }
 
 bool Semantics::Perform() {

flang/lib/semantics/semantics.h

@@ -20,7 +20,6 @@
 #include "../evaluate/intrinsics.h"
 #include "../parser/features.h"
 #include "../parser/message.h"
-#include "../parser/parse-tree.h"
 #include <iosfwd>
 #include <string>
 #include <vector>
@@ -33,12 +32,31 @@ namespace Fortran::parser {
 struct Name;
 struct Program;
 class CookedSource;
+struct AssociateConstruct;
+struct BlockConstruct;
+struct CaseConstruct;
+struct DoConstruct;
+struct CriticalConstruct;
+struct ChangeTeamConstruct;
+struct ForAllConstruct;
+struct IfConstruct;
+struct SelectRankConstruct;
+struct SelectTypeConstruct;
+struct WhereConstruct;
 }
 
 namespace Fortran::semantics {
 
 class Symbol;
 
+using ConstructNode = std::variant<const parser::AssociateConstruct *,
+    const parser::BlockConstruct *, const parser::CaseConstruct *,
+    const parser::ChangeTeamConstruct *, const parser::CriticalConstruct *,
+    const parser::DoConstruct *, const parser::ForAllConstruct *,
+    const parser::IfConstruct *, const parser::SelectRankConstruct *,
+    const parser::SelectTypeConstruct *, const parser::WhereConstruct *>;
+using ConstructStack = std::vector<ConstructNode>;
+
 class SemanticsContext {
 public:
   SemanticsContext(const common::IntrinsicTypeDefaultKinds &,
@@ -121,11 +139,10 @@ class SemanticsContext {
   const Scope &FindScope(parser::CharBlock) const;
   Scope &FindScope(parser::CharBlock);
 
-  const std::vector<const parser::ExecutableConstruct *> executables() const {
-    return executables_;
-  }
-  void PushExecutable(const parser::ExecutableConstruct &executable);
-  void PopExecutable();
+  const ConstructStack &constructStack() const { return constructStack_; }
+  void PushConstruct(const ConstructNode &construct);
+  void PopConstruct();
+  bool InsideDoConstruct() const;
 
 private:
   const common::IntrinsicTypeDefaultKinds &defaultKinds_;
@@ -143,7 +160,7 @@ class SemanticsContext {
   evaluate::FoldingContext foldingContext_{defaultKinds_};
 
   bool CheckError(bool);
-  std::vector<const parser::ExecutableConstruct *> executables_;
+  ConstructStack constructStack_;
 };
 
 class Semantics {

flang/test/semantics/dosemantics10.f90

@@ -17,6 +17,25 @@
 ! C1166 An EXIT statement must be within a DO construct
 
 subroutine s1()
+! this one's OK
+  do i = 1,10
+    cycle
+  end do
+
+! this one's OK
+  do i = 1,10
+    exit
+  end do
+
+! all of these are OK
+  outer: do i = 1,10
+    cycle
+    inner: do j = 1,10
+      cycle
+    end do inner
+    cycle
+  end do outer
+
 !ERROR: CYCLE must be within a DO construct
   cycle