[flang] Semantic checks for critical construct

The commit includes the following, -> The name field in DoConcurrent*Enforce classes are not used anymore. Removing the field and its collection and retrieval from DoConcurrentBodyEnforce and its usage in DoConcurrentLabelEnforce. -> DoConcurrentLabelEnforce is useful for checking that there are no branches escaping from other constructs also. For enabling use in other constructs (like critical) moving this to tools.h and renaming it as LabelEnforce. -> Checks for the constraints. -> Tests for the constaints. Original-commit: flang-compiler/f18@4b7a007 Reviewed-on: flang-compiler/f18#897
llvm · Jan 4, 2020 · 582b932 · 582b932
1 parent c3192a1
commit 582b932
Show file tree

Hide file tree

Showing 10 changed files with 381 additions and 127 deletions.
diff --git a/flang/lib/semantics/check-coarray.cc b/flang/lib/semantics/check-coarray.cc
@@ -17,6 +17,51 @@
 
 namespace Fortran::semantics {
 
+class CriticalBodyEnforce {
+public:
+  CriticalBodyEnforce(
+      SemanticsContext &context, parser::CharBlock criticalSourcePosition)
+    : context_{context}, criticalSourcePosition_{criticalSourcePosition} {}
+  std::set<parser::Label> labels() { return labels_; }
+  template<typename T> bool Pre(const T &) { return true; }
+  template<typename T> void Post(const T &) {}
+
+  template<typename T> bool Pre(const parser::Statement<T> &statement) {
+    currentStatementSourcePosition_ = statement.source;
+    if (statement.label.has_value()) {
+      labels_.insert(*statement.label);
+    }
+    return true;
+  }
+
+  // C1118
+  void Post(const parser::ReturnStmt &) {
+    context_
+        .Say(currentStatementSourcePosition_,
+            "RETURN statement is not allowed in a CRITICAL construct"_err_en_US)
+        .Attach(criticalSourcePosition_, GetEnclosingMsg());
+  }
+  void Post(const parser::ExecutableConstruct &construct) {
+    if (IsImageControlStmt(construct)) {
+      context_
+          .Say(currentStatementSourcePosition_,
+              "An image control statement is not allowed in a CRITICAL"
+              " construct"_err_en_US)
+          .Attach(criticalSourcePosition_, GetEnclosingMsg());
+    }
+  }
+
+private:
+  parser::MessageFixedText GetEnclosingMsg() {
+    return "Enclosing CRITICAL statement"_en_US;
+  }
+
+  SemanticsContext &context_;
+  std::set<parser::Label> labels_;
+  parser::CharBlock currentStatementSourcePosition_;
+  parser::CharBlock criticalSourcePosition_;
+};
+
 template<typename T>
 static void CheckTeamType(SemanticsContext &context, const T &x) {
   if (const auto *expr{GetExpr(x)}) {
@@ -46,6 +91,19 @@ void CoarrayChecker::Leave(const parser::FormTeamStmt &x) {
   CheckTeamType(context_, std::get<parser::TeamVariable>(x.t));
 }
 
+void CoarrayChecker::Enter(const parser::CriticalConstruct &x) {
+  auto &criticalStmt{std::get<parser::Statement<parser::CriticalStmt>>(x.t)};
+
+  const parser::Block &block{std::get<parser::Block>(x.t)};
+  CriticalBodyEnforce criticalBodyEnforce{context_, criticalStmt.source};
+  parser::Walk(block, criticalBodyEnforce);
+
+  // C1119
+  LabelEnforce criticalLabelEnforce{
+      context_, criticalBodyEnforce.labels(), criticalStmt.source, "CRITICAL"};
+  parser::Walk(block, criticalLabelEnforce);
+}
+
 // Check that coarray names and selector names are all distinct.
 void CoarrayChecker::CheckNamesAreDistinct(
     const std::list<parser::CoarrayAssociation> &list) {
@@ -85,5 +143,4 @@ void CoarrayChecker::Say2(const parser::CharBlock &name1,
   context_.Say(name1, std::move(msg1), name1)
       .Attach(name2, std::move(msg2), name2);
 }
-
 }
diff --git a/flang/lib/semantics/check-coarray.h b/flang/lib/semantics/check-coarray.h
@@ -33,13 +33,14 @@ class CoarrayChecker : public virtual BaseChecker {
   void Leave(const parser::ImageSelectorSpec &);
   void Leave(const parser::FormTeamStmt &);
 
+  void Enter(const parser::CriticalConstruct &);
+
 private:
   SemanticsContext &context_;
 
   void CheckNamesAreDistinct(const std::list<parser::CoarrayAssociation> &);
   void Say2(const parser::CharBlock &, parser::MessageFixedText &&,
       const parser::CharBlock &, parser::MessageFixedText &&);
 };
-
 }
 #endif  // FORTRAN_SEMANTICS_CHECK_COARRAY_H_
diff --git a/flang/lib/semantics/check-do.cc b/flang/lib/semantics/check-do.cc
@@ -75,7 +75,6 @@ class DoConcurrentBodyEnforce {
     : context_{context}, doConcurrentSourcePosition_{
                              doConcurrentSourcePosition} {}
   std::set<parser::Label> labels() { return labels_; }
-  std::set<SourceName> names() { return names_; }
   template<typename T> bool Pre(const T &) { return true; }
   template<typename T> void Post(const T &) {}
 
@@ -213,57 +212,6 @@ class DoConcurrentBodyEnforce {
     }
   }
 
-  // C1167 -- EXIT statements can't exit a DO CONCURRENT
-  bool Pre(const parser::WhereConstruct &s) {
-    AddName(MaybeGetConstructName(s));
-    return true;
-  }
-
-  bool Pre(const parser::ForallConstruct &s) {
-    AddName(MaybeGetConstructName(s));
-    return true;
-  }
-
-  bool Pre(const parser::ChangeTeamConstruct &s) {
-    AddName(MaybeGetConstructName(s));
-    return true;
-  }
-
-  bool Pre(const parser::CriticalConstruct &s) {
-    AddName(MaybeGetConstructName(s));
-    return true;
-  }
-
-  bool Pre(const parser::LabelDoStmt &s) {
-    AddName(MaybeGetStmtName(s));
-    return true;
-  }
-
-  bool Pre(const parser::NonLabelDoStmt &s) {
-    AddName(MaybeGetStmtName(s));
-    return true;
-  }
-
-  bool Pre(const parser::IfThenStmt &s) {
-    AddName(MaybeGetStmtName(s));
-    return true;
-  }
-
-  bool Pre(const parser::SelectCaseStmt &s) {
-    AddName(MaybeGetStmtName(s));
-    return true;
-  }
-
-  bool Pre(const parser::SelectRankStmt &s) {
-    AddName(MaybeGetStmtName(s));
-    return true;
-  }
-
-  bool Pre(const parser::SelectTypeStmt &s) {
-    AddName(MaybeGetStmtName(s));
-    return true;
-  }
-
   // C1136 -- No RETURN statements in a DO CONCURRENT
   void Post(const parser::ReturnStmt &) {
     context_
@@ -334,81 +282,12 @@ class DoConcurrentBodyEnforce {
     return false;
   }
 
-  void AddName(const parser::Name *nm) {
-    if (nm) {
-      names_.insert(nm->source);
-    }
-  }
-
-  std::set<parser::CharBlock> names_;
   std::set<parser::Label> labels_;
   parser::CharBlock currentStatementSourcePosition_;
   SemanticsContext &context_;
   parser::CharBlock doConcurrentSourcePosition_;
 };  // class DoConcurrentBodyEnforce
 
-class DoConcurrentLabelEnforce {
-public:
-  DoConcurrentLabelEnforce(SemanticsContext &context,
-      std::set<parser::Label> &&labels, std::set<parser::CharBlock> &&names,
-      parser::CharBlock doConcurrentSourcePosition)
-    : context_{context}, labels_{labels}, names_{names},
-      doConcurrentSourcePosition_{doConcurrentSourcePosition} {}
-  template<typename T> bool Pre(const T &) { return true; }
-  template<typename T> bool Pre(const parser::Statement<T> &statement) {
-    currentStatementSourcePosition_ = statement.source;
-    return true;
-  }
-
-  template<typename T> void Post(const T &) {}
-
-  void Post(const parser::GotoStmt &gotoStmt) { checkLabelUse(gotoStmt.v); }
-  void Post(const parser::ComputedGotoStmt &computedGotoStmt) {
-    for (auto &i : std::get<std::list<parser::Label>>(computedGotoStmt.t)) {
-      checkLabelUse(i);
-    }
-  }
-
-  void Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) {
-    checkLabelUse(std::get<1>(arithmeticIfStmt.t));
-    checkLabelUse(std::get<2>(arithmeticIfStmt.t));
-    checkLabelUse(std::get<3>(arithmeticIfStmt.t));
-  }
-
-  void Post(const parser::AssignStmt &assignStmt) {
-    checkLabelUse(std::get<parser::Label>(assignStmt.t));
-  }
-
-  void Post(const parser::AssignedGotoStmt &assignedGotoStmt) {
-    for (auto &i : std::get<std::list<parser::Label>>(assignedGotoStmt.t)) {
-      checkLabelUse(i);
-    }
-  }
-
-  void Post(const parser::AltReturnSpec &altReturnSpec) {
-    checkLabelUse(altReturnSpec.v);
-  }
-
-  void Post(const parser::ErrLabel &errLabel) { checkLabelUse(errLabel.v); }
-  void Post(const parser::EndLabel &endLabel) { checkLabelUse(endLabel.v); }
-  void Post(const parser::EorLabel &eorLabel) { checkLabelUse(eorLabel.v); }
-
-  void checkLabelUse(const parser::Label &labelUsed) {
-    if (labels_.find(labelUsed) == labels_.end()) {
-      SayWithDo(context_, currentStatementSourcePosition_,
-          "Control flow escapes from DO CONCURRENT"_err_en_US,
-          doConcurrentSourcePosition_);
-    }
-  }
-
-private:
-  SemanticsContext &context_;
-  std::set<parser::Label> labels_;
-  std::set<parser::CharBlock> names_;
-  parser::CharBlock currentStatementSourcePosition_{nullptr};
-  parser::CharBlock doConcurrentSourcePosition_{nullptr};
-};  // class DoConcurrentLabelEnforce
-
 // Class for enforcing C1130 -- in a DO CONCURRENT with DEFAULT(NONE),
 // variables from enclosing scopes must have their locality specified
 class DoConcurrentVariableEnforce {
@@ -566,9 +445,9 @@ class DoContext {
     DoConcurrentBodyEnforce doConcurrentBodyEnforce{context_, doStmt.source};
     parser::Walk(block, doConcurrentBodyEnforce);
 
-    DoConcurrentLabelEnforce doConcurrentLabelEnforce{context_,
-        doConcurrentBodyEnforce.labels(), doConcurrentBodyEnforce.names(),
-        currentStatementSourcePosition_};
+    LabelEnforce doConcurrentLabelEnforce{context_,
+        doConcurrentBodyEnforce.labels(), currentStatementSourcePosition_,
+        "DO CONCURRENT"};
     parser::Walk(block, doConcurrentLabelEnforce);
 
     const auto &loopControl{

diff --git a/flang/lib/semantics/tools.cc b/flang/lib/semantics/tools.cc
@@ -1185,4 +1185,64 @@ bool IsFunctionResultWithSameNameAsFunction(const Symbol &symbol) {
   }
   return false;
 }
+
+void LabelEnforce::Post(const parser::GotoStmt &gotoStmt) {
+  checkLabelUse(gotoStmt.v);
+}
+void LabelEnforce::Post(const parser::ComputedGotoStmt &computedGotoStmt) {
+  for (auto &i : std::get<std::list<parser::Label>>(computedGotoStmt.t)) {
+    checkLabelUse(i);
+  }
+}
+
+void LabelEnforce::Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) {
+  checkLabelUse(std::get<1>(arithmeticIfStmt.t));
+  checkLabelUse(std::get<2>(arithmeticIfStmt.t));
+  checkLabelUse(std::get<3>(arithmeticIfStmt.t));
+}
+
+void LabelEnforce::Post(const parser::AssignStmt &assignStmt) {
+  checkLabelUse(std::get<parser::Label>(assignStmt.t));
+}
+
+void LabelEnforce::Post(const parser::AssignedGotoStmt &assignedGotoStmt) {
+  for (auto &i : std::get<std::list<parser::Label>>(assignedGotoStmt.t)) {
+    checkLabelUse(i);
+  }
+}
+
+void LabelEnforce::Post(const parser::AltReturnSpec &altReturnSpec) {
+  checkLabelUse(altReturnSpec.v);
+}
+
+void LabelEnforce::Post(const parser::ErrLabel &errLabel) {
+  checkLabelUse(errLabel.v);
+}
+void LabelEnforce::Post(const parser::EndLabel &endLabel) {
+  checkLabelUse(endLabel.v);
+}
+void LabelEnforce::Post(const parser::EorLabel &eorLabel) {
+  checkLabelUse(eorLabel.v);
+}
+
+void LabelEnforce::checkLabelUse(const parser::Label &labelUsed) {
+  if (labels_.find(labelUsed) == labels_.end()) {
+    SayWithConstruct(context_, currentStatementSourcePosition_,
+        parser::MessageFormattedText{
+            "Control flow escapes from %s"_err_en_US, construct_},
+        constructSourcePosition_);
+  }
+}
+
+parser::MessageFormattedText LabelEnforce::GetEnclosingConstructMsg() {
+  return {"Enclosing %s statement"_en_US, construct_};
+}
+
+void LabelEnforce::SayWithConstruct(SemanticsContext &context,
+    parser::CharBlock stmtLocation, parser::MessageFormattedText &&message,
+    parser::CharBlock constructLocation) {
+  context.Say(stmtLocation, message)
+      .Attach(constructLocation, GetEnclosingConstructMsg());
+}
+
 }
diff --git a/flang/lib/semantics/tools.h b/flang/lib/semantics/tools.h
@@ -471,5 +471,45 @@ FindPolymorphicAllocatableUltimateComponent(const DerivedTypeSpec &);
 UltimateComponentIterator::const_iterator
 FindPolymorphicAllocatableNonCoarrayUltimateComponent(const DerivedTypeSpec &);
 
+// The LabelEnforce class (given a set of labels) provides an error message if
+// there is a branch to a label which is not in the given set.
+class LabelEnforce {
+public:
+  LabelEnforce(SemanticsContext &context, std::set<parser::Label> &&labels,
+      parser::CharBlock constructSourcePosition, const char *construct)
+    : context_{context}, labels_{labels},
+      constructSourcePosition_{constructSourcePosition}, construct_{construct} {
+  }
+  template<typename T> bool Pre(const T &) { return true; }
+  template<typename T> bool Pre(const parser::Statement<T> &statement) {
+    currentStatementSourcePosition_ = statement.source;
+    return true;
+  }
+
+  template<typename T> void Post(const T &) {}
+
+  void Post(const parser::GotoStmt &gotoStmt);
+  void Post(const parser::ComputedGotoStmt &computedGotoStmt);
+  void Post(const parser::ArithmeticIfStmt &arithmeticIfStmt);
+  void Post(const parser::AssignStmt &assignStmt);
+  void Post(const parser::AssignedGotoStmt &assignedGotoStmt);
+  void Post(const parser::AltReturnSpec &altReturnSpec);
+  void Post(const parser::ErrLabel &errLabel);
+  void Post(const parser::EndLabel &endLabel);
+  void Post(const parser::EorLabel &eorLabel);
+  void checkLabelUse(const parser::Label &labelUsed);
+
+private:
+  SemanticsContext &context_;
+  std::set<parser::Label> labels_;
+  parser::CharBlock currentStatementSourcePosition_{nullptr};
+  parser::CharBlock constructSourcePosition_{nullptr};
+  const char *construct_{nullptr};
+
+  parser::MessageFormattedText GetEnclosingConstructMsg();
+  void SayWithConstruct(SemanticsContext &context,
+      parser::CharBlock stmtLocation, parser::MessageFormattedText &&message,
+      parser::CharBlock constructLocation);
+};
 }
 #endif  // FORTRAN_SEMANTICS_TOOLS_H_
diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt
@@ -194,6 +194,9 @@ set(ERROR_TESTS
   bindings01.f90
   bad-forward-type.f90
   c_f_pointer.f90
+  critical01.f90
+  critical02.f90
+  critical03.f90
 )
 
 # These test files have expected symbols in the source
@@ -279,6 +282,10 @@ set(CANONDO_TESTS
   canondo*.[Ff]90
 )
 
+set(CRITICAL_TESTS
+  critical04.f90
+)
+
 set(GETSYMBOLS_TESTS
   getsymbols01.f90
   getsymbols02-*.f90
@@ -313,7 +320,7 @@ foreach(test ${MODFILE_TESTS})
 endforeach()
 
 foreach(test ${LABEL_TESTS} ${CANONDO_TESTS} ${DOCONCURRENT_TESTS}
-             ${GETSYMBOLS_TESTS} ${GETDEFINITION_TESTS})
+             ${CRITICAL_TESTS} ${GETSYMBOLS_TESTS} ${GETDEFINITION_TESTS})
   add_test(NAME ${test}
     COMMAND ${CMAKE_CURRENT_SOURCE_DIR}/test_any.sh ${test} ${F18})
 endforeach()