[flang] Responses to review comments.

 - dosemantics05.f90: Added tests for ASSOCIATE, BLOCK and SELECT TYPE statements and changed the error messages.
 - check-do.cc: Changed things so that FindScope() is only called once when DoConcurrentVariableEnforce is instantiated.  I changed the error message.  I changed the type and name of CS to be an std::set and be called SymbolContainer.
 - resolve-names.cc: I changed the Pre() function for parser::Statement to add the source range of a statement to both the current scope and all of its parents.  This fixed a problem with finding the current scope based on the source position.

Original-commit: flang-compiler/f18@085b2c18f3b6393a25beaa760a9d88a8ebd483f5
Reviewed-on: https://github.com/flang-compiler/f18/pull/612

diff --git a/flang/lib/semantics/check-do.cc b/flang/lib/semantics/check-do.cc
index d37dcd5..16d9168 100644 (file)
--- a/flang/lib/semantics/check-do.cc
+++ b/flang/lib/semantics/check-do.cc
@@ -324,8 +324,9 @@ class DoConcurrentVariableEnforce {
 public:
   DoConcurrentVariableEnforce(
       SemanticsContext &context, parser::CharBlock doConcurrentSourcePosition)
-    : context_{context}, doConcurrentSourcePosition_{
-                             doConcurrentSourcePosition} {}
+    : context_{context},
+      doConcurrentSourcePosition_{doConcurrentSourcePosition},
+      blockScope_{context.FindScope(doConcurrentSourcePosition_)} {}
 
   template<typename T> bool Pre(const T &) { return true; }
   template<typename T> void Post(const T &) {}
@@ -335,10 +336,11 @@ public:
     if (const Symbol * symbol{name.symbol}) {
       if (IsVariableName(*symbol)) {
         const Scope &variableScope{symbol->owner()};
-        if (DoesScopeContain(&variableScope, GetBlockScope())) {
+        if (DoesScopeContain(&variableScope, blockScope_)) {
           context_.Say(name.source,
-              "Variable '%s' from enclosing scope in a DEFAULT(NONE) DO "
-              "CONCURRENT, must appear in a locality-spec"_err_en_US,
+              "Variable '%s' from an enclosing scope referenced in a DO "
+              "CONCURRENT with DEFAULT(NONE) must appear in a "
+              "locality-spec"_err_en_US,
               name.source);
         }
       }
@@ -346,21 +348,19 @@ public:
   }
 
 private:
-  const Scope &GetBlockScope() {
-    return context_.FindScope(doConcurrentSourcePosition_);
-  }
-
   SemanticsContext &context_;
   parser::CharBlock doConcurrentSourcePosition_;
+  const Scope &blockScope_;
 };  // class DoConcurrentVariableEnforce
 
-using CS = std::vector<const Symbol *>;
+using SymbolContainer = std::set<const Symbol *>;
 
 enum GatherWhichVariables { All, NotShared, Local };
 
-static CS GatherVariables(const std::list<parser::LocalitySpec> &localitySpecs,
+static SymbolContainer GatherVariables(
+    const std::list<parser::LocalitySpec> &localitySpecs,
     GatherWhichVariables which) {
-  CS symbols;
+  SymbolContainer symbols;
   for (auto &ls : localitySpecs) {
     auto names{std::visit(
         [=](const auto &x) {
@@ -380,19 +380,20 @@ static CS GatherVariables(const std::list<parser::LocalitySpec> &localitySpecs,
         ls.u)};
     for (const auto &name : names) {
       if (name.symbol) {
-        symbols.push_back(name.symbol);
+        symbols.insert(name.symbol);
       }
     }
   }
   return symbols;
 }
 
-static CS GatherReferencesFromExpression(const parser::Expr &expression) {
+static SymbolContainer GatherReferencesFromExpression(
+    const parser::Expr &expression) {
   if (const auto *expr{GetExpr(expression)}) {
-    struct CollectSymbols : public virtual evaluate::VisitorBase<CS> {
-      using Result = CS;
+    struct CollectSymbols
+      : public virtual evaluate::VisitorBase<SymbolContainer> {
       explicit CollectSymbols(int) {}
-      void Handle(const Symbol *symbol) { result().push_back(symbol); }
+      void Handle(const Symbol *symbol) { result().insert(symbol); }
     };
     return evaluate::Visitor<CollectSymbols>{0}.Traverse(*expr);
   } else {
@@ -525,7 +526,8 @@ private:
   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
-    CS references{GatherReferencesFromExpression(mask.thing.thing.value())};
+    SymbolContainer references{
+        GatherReferencesFromExpression(mask.thing.thing.value())};
     for (auto *r : references) {
       if (isProcedure(r->flags()) && !isPure(r->attrs())) {
         context_.Say(currentStatementSourcePosition_,
@@ -536,28 +538,27 @@ private:
     }
   }
 
-  void CheckNoCollisions(const CS &refs, const CS &defs,
+  void CheckNoCollisions(const SymbolContainer &refs,
+      const SymbolContainer &defs,
       const parser::MessageFixedText &errorMessage) const {
     for (const Symbol *ref : refs) {
-      for (const Symbol *def : defs) {
-        if (ref == def) {
-          context_.Say(ref->name(), errorMessage, ref->name());
-          return;
-        }
+      if (defs.find(ref) != defs.end()) {
+        context_.Say(ref->name(), errorMessage, ref->name());
+        return;
       }
     }
   }
 
-  void HasNoReferences(
-      const CS &indexNames, const parser::ScalarIntExpr &expression) const {
-    const CS references{
+  void HasNoReferences(const SymbolContainer &indexNames,
+      const parser::ScalarIntExpr &expression) const {
+    const SymbolContainer references{
         GatherReferencesFromExpression(expression.thing.thing.value())};
     CheckNoCollisions(references, indexNames,
         "concurrent-control expression references index-name '%s'"_err_en_US);
   }
 
-  void CheckMaskDoesNotReferenceLocal(
-      const parser::ScalarLogicalExpr &mask, const CS &symbols) const {
+  void CheckMaskDoesNotReferenceLocal(const parser::ScalarLogicalExpr &mask,
+      const SymbolContainer &symbols) const {
     // C1129
     CheckNoCollisions(GatherReferencesFromExpression(mask.thing.thing.value()),
         symbols,
@@ -589,11 +590,11 @@ private:
 
     auto &header{std::get<parser::ConcurrentHeader>(concurrent.t)};
     auto &controls{std::get<std::list<parser::ConcurrentControl>>(header.t)};
-    CS indexNames;
+    SymbolContainer indexNames;
     for (auto &c : controls) {
       auto &indexName{std::get<parser::Name>(c.t)};
       if (indexName.symbol) {
-        indexNames.push_back(indexName.symbol);
+        indexNames.insert(indexName.symbol);
       }
     }
     if (!indexNames.empty()) {

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index bfda697..df89fba 100644 (file)
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -421,7 +421,12 @@ public:
 
   template<typename T> bool Pre(const parser::Statement<T> &x) {
     messageHandler().set_currStmtSource(&x.source);
-    currScope_->AddSourceRange(x.source);
+    for (auto *scope = currScope_; scope; scope = &scope->parent()) {
+      scope->AddSourceRange(x.source);
+      if (scope->IsGlobal()) {
+        break;
+      }
+    }
     return true;
   }
   template<typename T> void Post(const parser::Statement<T> &) {

diff --git a/flang/test/semantics/dosemantics05.f90 b/flang/test/semantics/dosemantics05.f90
index b15f108..5c5872e 100644 (file)
--- a/flang/test/semantics/dosemantics05.f90
+++ b/flang/test/semantics/dosemantics05.f90
@@ -13,8 +13,8 @@
 ! 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
+! 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."
@@ -28,39 +28,83 @@ subroutine s1()
   integer :: i, ivar, jvar, kvar
   real :: x
 
+  type point
+    real :: x, y
+  end type point
+
+  type, extends(point) :: color_point
+    integer :: color
+  end type color_point
+
+  type(point), target :: c
+  class(point), pointer :: p_or_c
+
+  p_or_c => c
+
   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
+  associate (avar => ivar)
+    do concurrent (i = 1:2:0) shared(jvar)
+      ivar = 3
+      ivar = ivar + i
+      block
+        real :: bvar
+        avar = 4
+        x = 3.5
+        bvar = 3.5 + i
+      end block
+      jvar = 5
+      mvar = 3.5
+    end do
+  end associate
   
-  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
+  associate (avar => ivar)
+    do concurrent (i = 1:2:0) default(none) shared(jvar) local(kvar)
+!ERROR: Variable 'ivar' from an enclosing scope referenced in a DO CONCURRENT with DEFAULT(NONE) must appear in a locality-spec
+      ivar =  &
+!ERROR: Variable 'ivar' from an enclosing scope referenced in a DO CONCURRENT with DEFAULT(NONE) must appear in a locality-spec
+        ivar + i
+      block
+        real :: bvar
+!ERROR: Variable 'avar' from an enclosing scope referenced in a DO CONCURRENT with DEFAULT(NONE) must appear in a locality-spec
+        avar = 4
+!ERROR: Variable 'x' from an enclosing scope referenced in a DO CONCURRENT with DEFAULT(NONE) 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 an enclosing scope referenced in a DO CONCURRENT with DEFAULT(NONE) must appear in a locality-spec
+      mvar = 3.5
+    end do
+  end associate
+
+  select type ( a => p_or_c )
+  type is ( point )
+    do concurrent (i=1:5) local(a)
+      ! C1130 This is OK because there's no DEFAULT(NONE) locality spec
+      a%x = 3.5
+    end do
+  end select
+
+  select type ( a => p_or_c )
+  type is ( point )
+    do concurrent (i=1:5) default (none)
+!ERROR: Variable 'a' from an enclosing scope referenced in a DO CONCURRENT with DEFAULT(NONE) must appear in a locality-spec
+      a%x = 3.5
+    end do
+  end select
 
-!ERROR: Variable 'mvar' from enclosing scope in a DEFAULT(NONE) DO CONCURRENT, must appear in a locality-spec
-    mvar = 3.5
-  end do
+  select type ( a => p_or_c )
+  type is ( point )
+    do concurrent (i=1:5) default (none) local(a)
+      ! C1130 This is OK because 'a' is in a locality-spec
+      a%x = 3.5
+    end do
+  end select
 
   x = 5.0  ! OK, we're not in a DO CONCURRENT