[flang] Changes to enforce constraint C1130.
authorPeter Steinfeld <psteinfeld@nvidia.com>
Wed, 31 Jul 2019 21:01:31 +0000 (14:01 -0700)
committerPeter Steinfeld <psteinfeld@nvidia.com>
Mon, 5 Aug 2019 20:37:03 +0000 (13:37 -0700)
The constraint states that "If the locality-spec DEFAULT ( NONE ) appears in a DO CONCURRENT statement; a variable that is a local or construct entity of a scope containing the DO CONCURRENT construct; and that appears in the block of the construct; shall have its locality explicitly specified by that statement."

Here's a summary of the changes:
 - In check-do.cc: Implemented the function
   CheckDefaultNoneImpliesExplicitLocality() to do the checking.  This involved
   adding the class DoConcurrentVariableEnforce to walk the DO loop's block
   looking for variable names.  I also cleaned up the code a little in
   CheckDoExpression() and EnforceConcurrentLoopControl().
 - Added the test dosemantics05.f90

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

flang/lib/semantics/check-do.cc
flang/test/semantics/CMakeLists.txt
flang/test/semantics/dosemantics05.f90 [new file with mode: 0644]

index 17d669f..d37dcd5 100644 (file)
@@ -319,14 +319,42 @@ private:
   parser::CharBlock doConcurrentSourcePosition_{nullptr};
 };  // class DoConcurrentLabelEnforce
 
-using CS = std::vector<const Symbol *>;
+// Class for enforcing C1130
+class DoConcurrentVariableEnforce {
+public:
+  DoConcurrentVariableEnforce(
+      SemanticsContext &context, parser::CharBlock doConcurrentSourcePosition)
+    : context_{context}, doConcurrentSourcePosition_{
+                             doConcurrentSourcePosition} {}
 
-struct GatherSymbols {
-  CS symbols;
-  template<typename T> constexpr bool Pre(const T &) { return true; }
-  template<typename T> constexpr void Post(const T &) {}
-  void Post(const parser::Name &name) { symbols.push_back(name.symbol); }
-};
+  template<typename T> bool Pre(const T &) { return true; }
+  template<typename T> void Post(const T &) {}
+
+  // Check to see if the name is a variable from an enclosing scope
+  void Post(const parser::Name &name) {
+    if (const Symbol * symbol{name.symbol}) {
+      if (IsVariableName(*symbol)) {
+        const Scope &variableScope{symbol->owner()};
+        if (DoesScopeContain(&variableScope, GetBlockScope())) {
+          context_.Say(name.source,
+              "Variable '%s' from enclosing scope in a DEFAULT(NONE) DO "
+              "CONCURRENT, must appear in a locality-spec"_err_en_US,
+              name.source);
+        }
+      }
+    }
+  }
+
+private:
+  const Scope &GetBlockScope() {
+    return context_.FindScope(doConcurrentSourcePosition_);
+  }
+
+  SemanticsContext &context_;
+  parser::CharBlock doConcurrentSourcePosition_;
+};  // class DoConcurrentVariableEnforce
+
+using CS = std::vector<const Symbol *>;
 
 enum GatherWhichVariables { All, NotShared, Local };
 
@@ -435,16 +463,14 @@ private:
     }
   }
 
+  // Semantic checks for the limit and step expressions
   void CheckDoExpression(const parser::ScalarExpr &scalarExpression) {
-    const evaluate::Expr<evaluate::SomeType> *expr{GetExpr(scalarExpression)};
-    const parser::CharBlock &sourceLocation{
-        scalarExpression.thing.value().source};
-    if (expr) {
-      if (ExprHasTypeCategory(*expr, TypeCategory::Integer)) {
-        return;  // No warnings or errors for INTEGER
+    if (const SomeExpr * expr{GetExpr(scalarExpression)}) {
+      if (!ExprHasTypeCategory(*expr, TypeCategory::Integer)) {
+        // No warnings or errors for type INTEGER
+        const parser::CharBlock &loc{scalarExpression.thing.value().source};
+        CheckDoControl(loc, ExprHasTypeCategory(*expr, TypeCategory::Real));
       }
-      CheckDoControl(
-          sourceLocation, ExprHasTypeCategory(*expr, TypeCategory::Real));
     }
   }
 
@@ -463,22 +489,21 @@ private:
   void CheckDoConcurrent(const parser::DoConstruct &doConstruct) {
     auto &doStmt{
         std::get<parser::Statement<parser::NonLabelDoStmt>>(doConstruct.t)};
-    auto &loopControl{
-        std::get<std::optional<parser::LoopControl>>(doStmt.statement.t)};
     currentStatementSourcePosition_ = doStmt.source;
 
+    const parser::Block &block{std::get<parser::Block>(doConstruct.t)};
     DoConcurrentEnforcement doConcurrentEnforcement{context_};
-    parser::Walk(
-        std::get<parser::Block>(doConstruct.t), doConcurrentEnforcement);
+    parser::Walk(block, doConcurrentEnforcement);
 
     DoConcurrentLabelEnforce doConcurrentLabelEnforce{context_,
         doConcurrentEnforcement.labels(), doConcurrentEnforcement.names(),
         currentStatementSourcePosition_};
-    parser::Walk(
-        std::get<parser::Block>(doConstruct.t), doConcurrentLabelEnforce);
+    parser::Walk(block, doConcurrentLabelEnforce);
 
+    auto &loopControl{
+        std::get<std::optional<parser::LoopControl>>(doStmt.statement.t)};
     auto &concurrent{std::get<parser::LoopControl::Concurrent>(loopControl->u)};
-    EnforceConcurrentLoopControl(concurrent);
+    EnforceConcurrentLoopControl(concurrent, block);
   }
 
   void CheckZeroOrOneDefaultNone(
@@ -539,24 +564,30 @@ private:
         "concurrent-header mask-expr references name '%s'"
         " in locality-spec"_err_en_US);
   }
-  void CheckLocalAndLocalInitAttributes(const CS &symbols) const {
-    // C1128
-    // TODO - implement
-  }
   void CheckDefaultNoneImpliesExplicitLocality(
-      const std::list<parser::LocalitySpec> &localitySpecs) const {
+      const std::list<parser::LocalitySpec> &localitySpecs,
+      const parser::Block &block) const {
     // C1130
-    // TODO - implement
+    bool hasDefaultNone{false};
+    for (auto &ls : localitySpecs) {
+      if (std::holds_alternative<parser::LocalitySpec::DefaultNone>(ls.u)) {
+        hasDefaultNone = true;
+        break;
+      }
+    }
+    if (hasDefaultNone) {
+      DoConcurrentVariableEnforce doConcurrentVariableEnforce{
+          context_, currentStatementSourcePosition_};
+      parser::Walk(block, doConcurrentVariableEnforce);
+    }
   }
 
   // check constraints [C1121 .. C1130]
   void EnforceConcurrentLoopControl(
-      const parser::LoopControl::Concurrent &concurrent) const {
+      const parser::LoopControl::Concurrent &concurrent,
+      const parser::Block &block) const {
+
     auto &header{std::get<parser::ConcurrentHeader>(concurrent.t)};
-    auto &mask{std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)};
-    if (mask.has_value()) {
-      CheckMaskIsPure(*mask);
-    }
     auto &controls{std::get<std::list<parser::ConcurrentControl>>(header.t)};
     CS indexNames;
     for (auto &c : controls) {
@@ -576,21 +607,21 @@ private:
         }
       }
     }
+
+    auto &mask{std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)};
+    if (mask.has_value()) {
+      CheckMaskIsPure(*mask);
+    }
     auto &localitySpecs{
         std::get<std::list<parser::LocalitySpec>>(concurrent.t)};
-    if (localitySpecs.empty()) {
-      return;
-    }
-    auto variableNames{
-        GatherVariables(localitySpecs, GatherWhichVariables::All)};
-    CheckZeroOrOneDefaultNone(localitySpecs);
-    CheckLocalAndLocalInitAttributes(
-        GatherVariables(localitySpecs, GatherWhichVariables::NotShared));
-    if (mask) {
-      CheckMaskDoesNotReferenceLocal(
-          *mask, GatherVariables(localitySpecs, GatherWhichVariables::Local));
+    if (!localitySpecs.empty()) {
+      CheckZeroOrOneDefaultNone(localitySpecs);
+      if (mask) {
+        CheckMaskDoesNotReferenceLocal(
+            *mask, GatherVariables(localitySpecs, GatherWhichVariables::Local));
+      }
+      CheckDefaultNoneImpliesExplicitLocality(localitySpecs, block);
     }
-    CheckDefaultNoneImpliesExplicitLocality(localitySpecs);
   }
 
   SemanticsContext &context_;
index b9a153f..9bc173e 100644 (file)
@@ -136,6 +136,7 @@ set(ERROR_TESTS
   dosemantics02.f90
   dosemantics03.f90
   dosemantics04.f90
+  dosemantics05.f90
   expr-errors01.f90
   null01.f90
   omp-clause-validity01.f90
diff --git a/flang/test/semantics/dosemantics05.f90 b/flang/test/semantics/dosemantics05.f90
new file mode 100644 (file)
index 0000000..b15f108
--- /dev/null
@@ -0,0 +1,67 @@
+! Copyright (c) 2019, 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.
+
+! Test DO loop semantics for constraint C1130 --
+! "The constraint states that "If the locality-spec DEFAULT ( NONE ) appears in
+! a DO CONCURRENT statement; a variable that is a local or construct entity of a
+! scope containing the DO CONCURRENT construct; and that appears in the block of
+! the construct; shall have its locality explicitly specified by that
+! statement."
+
+module m
+  real :: mvar
+end module m
+
+subroutine s1()
+  use m
+  integer :: i, ivar, jvar, kvar
+  real :: x
+
+  jvar = 5
+  
+  ! References in this DO CONCURRENT are OK since there's no DEFAULT(NONE)
+  ! locality-spec
+  do concurrent (i = 1:2:0) shared(jvar)
+    ivar = 3
+    ivar = ivar + i
+    block
+      real :: bvar
+      x = 3.5
+      bvar = 3.5 + i
+    end block
+    jvar = 5
+    mvar = 3.5
+  end do
+  
+  do concurrent (i = 1:2:0) default(none) shared(jvar) local(kvar)
+!ERROR: Variable 'ivar' from enclosing scope in a DEFAULT(NONE) DO CONCURRENT, must appear in a locality-spec
+    ivar =  &
+!ERROR: Variable 'ivar' from enclosing scope in a DEFAULT(NONE) DO CONCURRENT, must appear in a locality-spec
+      ivar + i
+    block
+      real :: bvar
+!ERROR: Variable 'x' from enclosing scope in a DEFAULT(NONE) DO CONCURRENT, must appear in a locality-spec
+      x = 3.5
+      bvar = 3.5 + i ! OK, bvar's scope is within the DO CONCURRENT
+    end block
+    jvar = 5 ! OK, jvar appears in a locality spec
+    kvar = 5 ! OK, kvar appears in a locality spec
+
+!ERROR: Variable 'mvar' from enclosing scope in a DEFAULT(NONE) DO CONCURRENT, must appear in a locality-spec
+    mvar = 3.5
+  end do
+
+  x = 5.0  ! OK, we're not in a DO CONCURRENT
+  
+end subroutine s1