[flang] Changes to implement constraint C1129
authorPeter Steinfeld <psteinfeld@nvidia.com>
Wed, 14 Aug 2019 19:57:09 +0000 (12:57 -0700)
committerPeter Steinfeld <psteinfeld@nvidia.com>
Tue, 20 Aug 2019 22:18:37 +0000 (15:18 -0700)
"C1129 A variable that is referenced by the scalar-mask-expr of a concurrent-header or by any concurrent-limit or concurrent-step in that concurrent-header shall not appear in a LOCAL locality-spec in the same DO CONCURRENT statement."

In the process of implementing these checks, I found and fixed some other problems.  I also cleaned up some of the code in check-do.cc.  I ran into two notable difficulties in implementing these checks.  First, the symbols associated with the names in a locality spec get created when the locality specs are process during name resolution.  Thus, they're different from the symbols associated with names that appear in the control expressions.  At Tim's suggestion, I dealt with this by looking up the symbols from the names in the locality spec starting with the closest enclosing scope containing the DO construct.  Second, the symbols can be hidden behind host- use- and construct-associations.

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

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

index de3877b..6257ee4 100644 (file)
@@ -29,9 +29,9 @@ namespace Fortran::semantics {
 using namespace parser::literals;
 
 // 11.1.7.5 - enforce semantics constraints on a DO CONCURRENT loop body
-class DoConcurrentEnforcement {
+class DoConcurrentBodyEnforce {
 public:
-  DoConcurrentEnforcement(SemanticsContext &context) : context_{context} {}
+  DoConcurrentBodyEnforce(SemanticsContext &context) : context_{context} {}
   std::set<parser::Label> labels() { return labels_; }
   std::set<parser::CharBlock> names() { return names_; }
   template<typename T> bool Pre(const T &) { return true; }
@@ -222,7 +222,7 @@ private:
   std::set<parser::Label> labels_;
   parser::CharBlock currentStatementSourcePosition_;
   SemanticsContext &context_;
-};  // class DoConcurrentEnforcement
+};  // class DoConcurrentBodyEnforce
 
 class DoConcurrentLabelEnforce {
 public:
@@ -372,8 +372,8 @@ private:
     context_.Say(sourceLocation, "DO controls should be INTEGER"_err_en_US);
   }
 
-  void CheckDoControl(parser::CharBlock sourceLocation, bool isReal) {
-    bool warn{context_.warnOnNonstandardUsage() ||
+  void CheckDoControl(const parser::CharBlock &sourceLocation, bool isReal) {
+    const bool warn{context_.warnOnNonstandardUsage() ||
         context_.ShouldWarn(parser::LanguageFeature::RealDoControls)};
     if (isReal && !warn) {
       // No messages for the default case
@@ -387,8 +387,7 @@ private:
 
   void CheckDoVariable(const parser::ScalarName &scalarName) {
     const parser::CharBlock &sourceLocation{scalarName.thing.source};
-    const Symbol *symbol{scalarName.thing.symbol};
-    if (symbol) {
+    if (const Symbol * symbol{scalarName.thing.symbol}) {
       if (!IsVariableName(*symbol)) {
         context_.Say(
             sourceLocation, "DO control must be an INTEGER variable"_err_en_US);
@@ -435,77 +434,58 @@ private:
     currentStatementSourcePosition_ = doStmt.source;
 
     const parser::Block &block{std::get<parser::Block>(doConstruct.t)};
-    DoConcurrentEnforcement doConcurrentEnforcement{context_};
-    parser::Walk(block, doConcurrentEnforcement);
+    DoConcurrentBodyEnforce doConcurrentBodyEnforce{context_};
+    parser::Walk(block, doConcurrentBodyEnforce);
 
     DoConcurrentLabelEnforce doConcurrentLabelEnforce{context_,
-        doConcurrentEnforcement.labels(), doConcurrentEnforcement.names(),
+        doConcurrentBodyEnforce.labels(), doConcurrentBodyEnforce.names(),
         currentStatementSourcePosition_};
     parser::Walk(block, doConcurrentLabelEnforce);
 
-    auto &loopControl{
+    const auto &loopControl{
         std::get<std::optional<parser::LoopControl>>(doStmt.statement.t)};
-    auto &concurrent{std::get<parser::LoopControl::Concurrent>(loopControl->u)};
-    EnforceConcurrentLoopControl(concurrent, block);
-  }
-
-  void CheckZeroOrOneDefaultNone(
-      const std::list<parser::LocalitySpec> &localitySpecs) const {
-    // C1127
-    int count{0};
-    for (auto &ls : localitySpecs) {
-      if (std::holds_alternative<parser::LocalitySpec::DefaultNone>(ls.u)) {
-        ++count;
-        if (count > 1) {
-          context_.Say(currentStatementSourcePosition_,
-              "only one DEFAULT(NONE) may appear"_en_US);
-          return;
-        }
-      }
-    }
+    const auto &concurrent{
+        std::get<parser::LoopControl::Concurrent>(loopControl->u)};
+    CheckConcurrentLoopControl(concurrent, block);
   }
 
   using SymbolSet = std::set<const Symbol *>;
 
-  enum GatherWhichVariables { All, NotShared, Local };
-
-  static SymbolSet GatherVariables(
-      const std::list<parser::LocalitySpec> &localitySpecs,
-      GatherWhichVariables which) {
+  // Return a set of symbols whose names are in a Local locality-spec.  Look
+  // the names up in the scope that encloses the DO construct to avoid getting
+  // the local versions of them.  Then follow the host-, use-, and
+  // construct-associations to get the root symbols
+  SymbolSet GatherLocals(
+      const std::list<parser::LocalitySpec> &localitySpecs) const {
     SymbolSet symbols;
-    for (auto &ls : localitySpecs) {
-      auto names{std::visit(
-          [=](const auto &x) {
-            using T = std::decay_t<decltype(x)>;
-            using namespace parser;
-            if constexpr (!std::is_same_v<T, LocalitySpec::DefaultNone>) {
-              if (which == GatherWhichVariables::All ||
-                  (which == GatherWhichVariables::NotShared &&
-                      !std::is_same_v<T, LocalitySpec::Shared>) ||
-                  (which == GatherWhichVariables::Local &&
-                      std::is_same_v<T, LocalitySpec::Local>)) {
-                return x.v;
-              }
+    const Scope &scope{
+        context_.FindScope(currentStatementSourcePosition_).parent()};
+    // Loop through the LocalitySpec::Local locality-specs
+    for (const auto &ls : localitySpecs) {
+      if (const auto *names{std::get_if<parser::LocalitySpec::Local>(&ls.u)}) {
+        // Loop through the names in the Local locality-spec getting their
+        // symbols
+        for (const parser::Name &name : names->v) {
+          if (const Symbol * symbol{scope.FindSymbol(name.source)}) {
+            if (const Symbol * root{GetAssociationRoot(*symbol)}) {
+              symbols.insert(root);
             }
-            return std::list<parser::Name>{};
-          },
-          ls.u)};
-      for (const auto &name : names) {
-        if (name.symbol) {
-          symbols.insert(name.symbol);
+          }
         }
       }
     }
     return symbols;
   }
 
-  static SymbolSet GatherReferencesFromExpression(
-      const parser::Expr &expression) {
+  static SymbolSet GatherSymbolsFromExpression(const parser::Expr &expression) {
     if (const auto *expr{GetExpr(expression)}) {
-      struct CollectSymbols
-        : public virtual evaluate::VisitorBase<SymbolSet> {
+      struct CollectSymbols : public virtual evaluate::VisitorBase<SymbolSet> {
         explicit CollectSymbols(int) {}
-        void Handle(const Symbol *symbol) { result().insert(symbol); }
+        void Handle(const Symbol *symbol) {
+          if (const Symbol * root{GetAssociationRoot(*symbol)}) {
+            result().insert(root);
+          }
+        }
       };
       return evaluate::Visitor<CollectSymbols>{0}.Traverse(*expr);
     } else {
@@ -513,57 +493,78 @@ private:
     }
   }
 
+  // C1121 - procedures in mask must be pure
   void CheckMaskIsPure(const parser::ScalarLogicalExpr &mask) const {
-    // C1121 - procedures in mask must be pure
-    // TODO - add the name of the impure procedure to the message
-    SymbolSet references{
-        GatherReferencesFromExpression(mask.thing.thing.value())};
+    SymbolSet references{GatherSymbolsFromExpression(mask.thing.thing.value())};
     for (const Symbol *ref : references) {
       if (IsProcedure(*ref) && !IsPureProcedure(*ref)) {
-        context_.Say(currentStatementSourcePosition_,
-            "concurrent-header mask expression cannot reference an impure"
-            " procedure"_err_en_US);
+        const parser::CharBlock &name{ref->name()};
+        context_
+            .Say(currentStatementSourcePosition_,
+                "concurrent-header mask expression cannot reference an impure"
+                " procedure"_err_en_US)
+            .Attach(name, "Declaration of impure procedure '%s'"_en_US, name);
         return;
       }
     }
   }
 
-  void CheckNoCollisions(const SymbolSet &refs,
-      const SymbolSet &defs,
-      const parser::MessageFixedText &errorMessage) const {
+  void CheckNoCollisions(const SymbolSet &refs, const SymbolSet &set,
+      const parser::MessageFixedText &errorMessage,
+      const parser::CharBlock &refPosition) const {
     for (const Symbol *ref : refs) {
-      if (defs.find(ref) != defs.end()) {
-        context_.Say(ref->name(), errorMessage, ref->name());
+      if (set.find(ref) != set.end()) {
+        const parser::CharBlock &name{ref->name()};
+        context_.Say(refPosition, errorMessage, name)
+            .Attach(name, "Declaration of '%s'"_en_US, name);
         return;
       }
     }
   }
 
-  void HasNoReferences(const SymbolSet &indexNames,
-      const parser::ScalarIntExpr &expression) const {
-    const SymbolSet references{
-        GatherReferencesFromExpression(expression.thing.thing.value())};
-    CheckNoCollisions(references, indexNames,
-        "concurrent-control expression references index-name '%s'"_err_en_US);
+  void HasNoReferences(
+      const SymbolSet &indexNames, const parser::ScalarIntExpr &expr) const {
+    CheckNoCollisions(GatherSymbolsFromExpression(expr.thing.thing.value()),
+        indexNames,
+        "concurrent-control expression references index-name '%s'"_err_en_US,
+        expr.thing.thing.value().source);
   }
 
-  void CheckMaskDoesNotReferenceLocal(const parser::ScalarLogicalExpr &mask,
-      const SymbolSet &symbols) const {
-    // C1129
-    CheckNoCollisions(GatherReferencesFromExpression(mask.thing.thing.value()),
-        symbols,
-        "concurrent-header mask-expr references name '%s'"
-        " in locality-spec"_err_en_US);
+  // C1129, names in local locality-specs can't be in limit or step expressions
+  void CheckMaskDoesNotReferenceLocal(
+      const parser::ScalarLogicalExpr &mask, const SymbolSet &localVars) const {
+    CheckNoCollisions(GatherSymbolsFromExpression(mask.thing.thing.value()),
+        localVars,
+        "concurrent-header mask-expr references variable '%s'"
+        " in locality-spec"_err_en_US,
+        mask.thing.thing.value().source);
   }
+
+  // C1129, names in local locality-specs can't be in limit or step expressions
+  void CheckExprDoesNotReferenceLocal(
+      const parser::ScalarIntExpr &expr, const SymbolSet &localVars) const {
+    CheckNoCollisions(GatherSymbolsFromExpression(expr.thing.thing.value()),
+        localVars,
+        "concurrent-header expression references variable '%s'"
+        " in locality-spec"_err_en_US,
+        expr.thing.thing.value().source);
+  }
+
+  // C1130, default(none) locality requires names to be in locality-specs to be
+  // used in the body of the DO loop
   void CheckDefaultNoneImpliesExplicitLocality(
       const std::list<parser::LocalitySpec> &localitySpecs,
       const parser::Block &block) const {
-    // C1130
     bool hasDefaultNone{false};
     for (auto &ls : localitySpecs) {
       if (std::holds_alternative<parser::LocalitySpec::DefaultNone>(ls.u)) {
+        if (hasDefaultNone) {
+          // C1127, you can only have one DEFAULT(NONE)
+          context_.Say(currentStatementSourcePosition_,
+              "only one DEFAULT(NONE) may appear"_en_US);
+          break;
+        }
         hasDefaultNone = true;
-        break;
       }
     }
     if (hasDefaultNone) {
@@ -573,48 +574,68 @@ private:
     }
   }
 
-  // check constraints [C1121 .. C1130]
-  void EnforceConcurrentLoopControl(
-      const parser::LoopControl::Concurrent &concurrent,
-      const parser::Block &block) const {
-
-    auto &header{std::get<parser::ConcurrentHeader>(concurrent.t)};
+  // C1123, concurrent limit or step expressions can't reference index-names
+  void CheckConcurrentHeader(const parser::ConcurrentHeader &header) const {
     auto &controls{std::get<std::list<parser::ConcurrentControl>>(header.t)};
     SymbolSet indexNames;
-    for (auto &c : controls) {
-      auto &indexName{std::get<parser::Name>(c.t)};
+    for (const auto &c : controls) {
+      const auto &indexName{std::get<parser::Name>(c.t)};
       if (indexName.symbol) {
         indexNames.insert(indexName.symbol);
       }
     }
     if (!indexNames.empty()) {
-      for (auto &c : controls) {
-        // C1123
+      for (const auto &c : controls) {
         HasNoReferences(indexNames, std::get<1>(c.t));
         HasNoReferences(indexNames, std::get<2>(c.t));
-        if (auto &expression{
+        if (const auto &expr{
                 std::get<std::optional<parser::ScalarIntExpr>>(c.t)}) {
-          HasNoReferences(indexNames, *expression);
+          HasNoReferences(indexNames, *expr);
         }
       }
     }
+  }
 
-    auto &mask{std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)};
-    if (mask.has_value()) {
-      CheckMaskIsPure(*mask);
-    }
-    auto &localitySpecs{
+  void CheckLocalitySpecs(const parser::LoopControl::Concurrent &concurrent,
+      const parser::Block &block) const {
+    const auto &header{std::get<parser::ConcurrentHeader>(concurrent.t)};
+    const auto &controls{
+        std::get<std::list<parser::ConcurrentControl>>(header.t)};
+    const auto &localitySpecs{
         std::get<std::list<parser::LocalitySpec>>(concurrent.t)};
     if (!localitySpecs.empty()) {
-      CheckZeroOrOneDefaultNone(localitySpecs);
-      if (mask) {
-        CheckMaskDoesNotReferenceLocal(
-            *mask, GatherVariables(localitySpecs, GatherWhichVariables::Local));
+      const SymbolSet &localVars{GatherLocals(localitySpecs)};
+      for (const auto &c : controls) {
+        CheckExprDoesNotReferenceLocal(std::get<1>(c.t), localVars);
+        CheckExprDoesNotReferenceLocal(std::get<2>(c.t), localVars);
+        if (const auto &expr{
+                std::get<std::optional<parser::ScalarIntExpr>>(c.t)}) {
+          CheckExprDoesNotReferenceLocal(*expr, localVars);
+        }
+      }
+      if (const auto &mask{
+              std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)}) {
+        CheckMaskDoesNotReferenceLocal(*mask, localVars);
       }
       CheckDefaultNoneImpliesExplicitLocality(localitySpecs, block);
     }
   }
 
+  // check constraints [C1121 .. C1130]
+  void CheckConcurrentLoopControl(
+      const parser::LoopControl::Concurrent &concurrent,
+      const parser::Block &block) const {
+
+    const auto &header{std::get<parser::ConcurrentHeader>(concurrent.t)};
+    const auto &mask{
+        std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)};
+    if (mask.has_value()) {
+      CheckMaskIsPure(*mask);
+    }
+    CheckConcurrentHeader(header);
+    CheckLocalitySpecs(concurrent, block);
+  }
+
   SemanticsContext &context_;
   parser::CharBlock currentStatementSourcePosition_;
 };  // class DoContext
index c783d1a..e8345f8 100644 (file)
@@ -143,6 +143,7 @@ set(ERROR_TESTS
   dosemantics06.f90
   dosemantics07.f90
   dosemantics08.f90
+  dosemantics09.f90
   expr-errors01.f90
   null01.f90
   omp-clause-validity01.f90
index f8c269f..fda51a8 100644 (file)
@@ -18,11 +18,12 @@ PROGRAM dosemantics04
   IMPLICIT NONE
   INTEGER :: a, i, j, k, n
 
-! No problems here
+!ERROR: concurrent-header mask-expr references variable 'n' in locality-spec
   DO CONCURRENT (INTEGER *2 :: i = 1:10, i < j + n) LOCAL(n)
     PRINT *, "hello"
   END DO
 
+!ERROR: concurrent-header mask-expr references variable 'a' in locality-spec
   DO 30 CONCURRENT (i = 1:n:1, j=1:n:2, k=1:n:3, a<3) LOCAL (a)
     PRINT *, "hello"
 30 END DO
diff --git a/flang/test/semantics/dosemantics09.f90 b/flang/test/semantics/dosemantics09.f90
new file mode 100644 (file)
index 0000000..0f38e8f
--- /dev/null
@@ -0,0 +1,125 @@
+! 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.
+
+!C1129 
+!A variable that is referenced by the scalar-mask-expr of a
+!concurrent-header or by any concurrent-limit or concurrent-step in that
+!concurrent-header shall not appear in a LOCAL locality-spec in the same DO
+!CONCURRENT statement.
+
+subroutine s1()
+
+!ERROR: 'i' is already declared in this scoping unit
+  do concurrent (i=1:10) local(i)
+  end do
+end subroutine s1
+
+subroutine s2()
+!ERROR: 'i' is already declared in this scoping unit
+  do concurrent (i=1:10) local_init(i)
+  end do
+end subroutine s2
+
+subroutine s3()
+!ERROR: 'i' is already declared in this scoping unit
+  do concurrent (i=i:10) shared(i)
+  end do
+end subroutine s3
+
+subroutine s4()
+!ERROR: concurrent-header expression references variable 'i' in locality-spec
+  do concurrent (j=i:10) local(i)
+  end do
+end subroutine s4
+
+subroutine s5()
+  !OK because the locality-spec is local_init
+  do concurrent (j=i:10) local_init(i)
+  end do
+end subroutine s5
+
+subroutine s6()
+  !OK because the locality-spec is shared
+  do concurrent (j=i:10) shared(i)
+  end do
+end subroutine s6
+
+subroutine s7()
+!ERROR: concurrent-header expression references variable 'i' in locality-spec
+  do concurrent (j=1:i) local(i)
+  end do
+end subroutine s7
+
+subroutine s8()
+  !OK because the locality-spec is local_init
+  do concurrent (j=1:i) local_init(i)
+  end do
+end subroutine s8
+
+subroutine s9()
+  !OK because the locality-spec is shared
+  do concurrent (j=1:i) shared(i)
+  end do
+end subroutine s9
+
+subroutine s10()
+!ERROR: concurrent-header expression references variable 'i' in locality-spec
+  do concurrent (j=1:10:i) local(i)
+  end do
+end subroutine s10
+
+subroutine s11()
+  !OK because the locality-spec is local_init
+  do concurrent (j=1:10:i) local_init(i)
+  end do
+end subroutine s11
+
+subroutine s12()
+  !OK because the locality-spec is shared
+  do concurrent (j=1:10:i) shared(i)
+  end do
+end subroutine s12
+
+subroutine s13()
+  ! Test construct-association, in this case, established by the "shared"
+  integer :: ivar
+  associate (avar => ivar)
+!ERROR: concurrent-header expression references variable 'ivar' in locality-spec
+    do concurrent (j=1:10:avar) local(avar)
+    end do
+  end associate
+end subroutine s13
+
+module m1
+  integer :: mvar
+end module m1
+subroutine s14()
+  ! Test use-association, in this case, established by the "shared"
+  use m1
+
+!ERROR: concurrent-header expression references variable 'mvar' in locality-spec
+  do concurrent (k=mvar:10) local(mvar)
+  end do
+end subroutine s14
+
+subroutine s15()
+  ! Test host-association, in this case, established by the "shared"
+  ! locality-spec
+  ivar = 3
+  do concurrent (j=ivar:10) shared(ivar)
+!ERROR: concurrent-header expression references variable 'ivar' in locality-spec
+    do concurrent (k=ivar:10) local(ivar)
+    end do
+  end do
+end subroutine s15