[flang] Cleanup some cruft and tweaks per review comments.

Added a negative test, to check that semantics are not applied bogusly
to loops that are not DO CONCURRENT.

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

flang/lib/semantics/check-do-concurrent.cc

@@ -20,7 +20,7 @@ namespace Fortran::semantics {
 
 using namespace parser::literals;
 
-// 11.1.7.5
+// 11.1.7.5 - enforce semantics constraints on a DO CONCURRENT loop body
 class DoConcurrentEnforcement {
 public:
   DoConcurrentEnforcement(parser::Messages &messages) : messages_{messages} {}
@@ -85,8 +85,11 @@ public:
   }
   // C1141
   void Post(const parser::ProcedureDesignator &procedureDesignator) {
-    if (auto *name = std::get_if<parser::Name>(&procedureDesignator.u)) {
+#if 0
+    if (auto *name{std::get_if<parser::Name>(&procedureDesignator.u)}) {
       auto upperName{parser::ToUpperCaseLetters(name->ToString())};
+      // FIXME: These names need to resolve to symbols imported from the
+      // intrinsic module IEEE_EXCEPTIONS. Do some symbol lookup here?
       if (upperName == "IEEE_GET_FLAG"s) {
         messages_.Say(charBlock_,
             parser::MessageFormattedText{
@@ -101,14 +104,15 @@ public:
                                          " in DO CONCURRENT"_err_en_US});
       }
     }
+#endif
   }
 
   // C1138: extended ranges in DOs should be errors, not warnings
 
   // 11.1.7.5
   void Post(const parser::IoControlSpec &ioControlSpec) {
-    if (auto *charExpr =
+    if (auto *charExpr{
-            std::get_if<parser::IoControlSpec::CharExpr>(&ioControlSpec.u)) {
+            std::get_if<parser::IoControlSpec::CharExpr>(&ioControlSpec.u)}) {
       if (std::get<parser::IoControlSpec::CharExpr::Kind>(charExpr->t) ==
           parser::IoControlSpec::CharExpr::Kind::Advance) {
         messages_.Say(charBlock_,
@@ -119,87 +123,49 @@ public:
   }
 
 private:
-  bool ObjectIsCoarray() { return false; } // placeholder
+  bool ObjectIsCoarray() { return false; }  // placeholder
-  bool EndTDeallocatesCoarray() { return false; } // placeholder
+  bool EndTDeallocatesCoarray() { return false; }  // placeholder
 
   parser::CharBlock charBlock_;
   parser::Messages &messages_;
 };
 
-class DoConcurrentCollection {
+// Find a canonical DO CONCURRENT and enforce semantics checks on its body
+class FindDoConcurrentLoops {
 public:
-  DoConcurrentCollection(parser::Messages &messages) : messages_{messages} {}
+  FindDoConcurrentLoops(parser::Messages &messages) : messages_{messages} {}
   template<typename T> constexpr bool Pre(const T &) { return true; }
   template<typename T> constexpr void Post(const T &) {}
-  bool Pre(const parser::ExecutionPart &executionPart) {
+  template<typename T> constexpr bool Pre(const parser::Statement<T> &) {
-    const auto &cend{executionPart.v.cend()};
+    return false;
-    for (auto iter{executionPart.v.cbegin()}; iter != cend; ++iter) {
+  }
-      CheckDoConcurrent(iter);
+  bool Pre(const parser::DoConstruct &doConstruct) {
-      currentIter_ = iter;
+    if (std::get<std::optional<parser::LoopControl>>(
+            std::get<parser::Statement<parser::NonLabelDoStmt>>(doConstruct.t)
+                .statement.t)
+            .has_value() &&
+        std::holds_alternative<parser::LoopControl::Concurrent>(
+            std::get<std::optional<parser::LoopControl>>(
+                std::get<parser::Statement<parser::NonLabelDoStmt>>(
+                    doConstruct.t)
+                    .statement.t)
+                ->u)) {
+      DoConcurrentEnforcement doConcurrentEnforcement{messages_};
+      parser::Walk(
+          std::get<parser::Block>(doConstruct.t), doConcurrentEnforcement);
     }
     return true;
   }
-  template<typename T> void Post(const parser::Statement<T> &statement) {
-    if (!labels_.empty() && statement.label.has_value() &&
-        labels_.back() == *statement.label) {
-      CheckConstraints(++labelDoIters_.back(), currentIter_);
-      labels_.pop_back();
-      labelDoIters_.pop_back();
-    }
-  }
 
 private:
-  void CheckConstraints(const parser::Block::const_iterator &begin,
-      const parser::Block::const_iterator &end) {
-    DoConcurrentEnforcement doConcurrentEnforcement{messages_};
-    for (auto iter = begin; iter != end; ++iter) {
-      Walk(*iter, doConcurrentEnforcement);
-    }
-  }
-  void CheckDoConcurrent(
-      const std::list<parser::ExecutionPartConstruct>::const_iterator &iter) {
-    const parser::ExecutionPartConstruct &executionPartConstruct{*iter};
-    if (auto *executableConstruct = std::get_if<parser::ExecutableConstruct>(
-            &executionPartConstruct.u)) {
-      if (auto *doConstruct =
-              std::get_if<common::Indirection<parser::DoConstruct>>(
-                  &executableConstruct->u)) {
-        if (std::get<std::optional<parser::LoopControl>>(
-                std::get<parser::Statement<parser::NonLabelDoStmt>>(
-                    (*doConstruct)->t)
-                    .statement.t)
-                .has_value()) {
-          CheckConstraints(std::get<parser::Block>((*doConstruct)->t).cbegin(),
-              std::get<parser::Block>((*doConstruct)->t).cend());
-        }
-      } else if (auto *labelDoLoop = std::get_if<parser::Statement<
-                     common::Indirection<parser::LabelDoStmt>>>(
-                     &executableConstruct->u)) {
-        if (std::get<std::optional<parser::LoopControl>>(
-                labelDoLoop->statement->t)
-                .has_value() &&
-            std::holds_alternative<parser::LoopControl::Concurrent>(
-                std::get<std::optional<parser::LoopControl>>(
-                    labelDoLoop->statement->t)
-                    ->u)) {
-          labelDoIters_.push_back(iter);
-          labels_.push_back(std::get<parser::Label>(labelDoLoop->statement->t));
-        }
-      }
-    }
-  }
-
   parser::Messages &messages_;
-  std::vector<std::list<parser::ExecutionPartConstruct>::const_iterator>
-      labelDoIters_;
-  std::list<parser::ExecutionPartConstruct>::const_iterator currentIter_;
-  std::vector<parser::Label> labels_;
 };
 
+// DO loops must be canonicalized prior to calling
 void CheckDoConcurrentConstraints(
     parser::Messages &messages, const parser::Program &program) {
-  DoConcurrentCollection doConcurrentCollection{messages};
+  FindDoConcurrentLoops findDoConcurrentLoops{messages};
-  Walk(program, doConcurrentCollection);
+  Walk(program, findDoConcurrentLoops);
 }
 
 }  // namespace Fortran::semantics

flang/test/semantics/doconcurrent01.f90

@@ -15,7 +15,7 @@
 ! RUN: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
 ! CHECK: image control statement not allowed in DO CONCURRENT
 ! CHECK: RETURN not allowed in DO CONCURRENT
-! CHECK: IEEE_GET_FLAG not allowed in DO CONCURRENT
+! XXXCHECK: IEEE_GET_FLAG not allowed in DO CONCURRENT
 ! CHECK: ADVANCE specifier not allowed in DO CONCURRENT
 ! CHECK: SYNC ALL
 ! CHECK: SYNC IMAGES
@@ -31,6 +31,7 @@ subroutine do_concurrent_test1(i,n)
 end subroutine do_concurrent_test1
 
 subroutine do_concurrent_test2(i,j,n,flag)
+  !use ieee_exceptions
   implicit none
   integer :: i, j, n, flag, flag2
   do concurrent (i = 1:n)

flang/test/semantics/doconcurrent02.f90

@@ -0,0 +1,46 @@
+! Copyright (c) 2018, 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.
+
+! negative tests: we don't want DO CONCURRENT semantics constraints checked
+! when the loops are not DO CONCURRENT
+
+! RUN: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
+! CHECK-NOT: image control statement not allowed in DO CONCURRENT
+! CHECK-NOT: RETURN not allowed in DO CONCURRENT
+! XXXCHECK-NOT: IEEE_GET_FLAG not allowed in DO CONCURRENT
+! CHECK-NOT: ADVANCE specifier not allowed in DO CONCURRENT
+! CHECK-NOT: SYNC ALL
+! CHECK-NOT: SYNC IMAGES
+
+subroutine do_concurrent_test1(i,n)
+  implicit none
+  integer :: i, n
+  do 10 i = 1,n
+     SYNC ALL
+     SYNC IMAGES (*)
+     return
+10 continue
+end subroutine do_concurrent_test1
+
+subroutine do_concurrent_test2(i,j,n,flag)
+  !use ieee_exceptions
+  implicit none
+  integer :: i, j, n, flag, flag2
+  do i = 1,n
+    change team (j)
+      call ieee_get_flag(flag, flag2)
+    end team
+    write(*,'(a35)',advance='no')
+  end do
+end subroutine do_concurrent_test2