From 6b8a1e8248b7069975554efe47a41e0f8a9f307f Mon Sep 17 00:00:00 2001 From: Peter Steinfeld Date: Wed, 14 Aug 2019 12:57:09 -0700 Subject: [PATCH] [flang] Changes to implement constraint C1129 "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 | 233 ++++++++++++++++++--------------- flang/test/semantics/CMakeLists.txt | 1 + flang/test/semantics/dosemantics04.f90 | 3 +- flang/test/semantics/dosemantics09.f90 | 125 ++++++++++++++++++ 4 files changed, 255 insertions(+), 107 deletions(-) create mode 100644 flang/test/semantics/dosemantics09.f90 diff --git a/flang/lib/semantics/check-do.cc b/flang/lib/semantics/check-do.cc index de3877b..6257ee4 100644 --- a/flang/lib/semantics/check-do.cc +++ b/flang/lib/semantics/check-do.cc @@ -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 labels() { return labels_; } std::set names() { return names_; } template bool Pre(const T &) { return true; } @@ -222,7 +222,7 @@ private: std::set 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(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>(doStmt.statement.t)}; - auto &concurrent{std::get(loopControl->u)}; - EnforceConcurrentLoopControl(concurrent, block); - } - - void CheckZeroOrOneDefaultNone( - const std::list &localitySpecs) const { - // C1127 - int count{0}; - for (auto &ls : localitySpecs) { - if (std::holds_alternative(ls.u)) { - ++count; - if (count > 1) { - context_.Say(currentStatementSourcePosition_, - "only one DEFAULT(NONE) may appear"_en_US); - return; - } - } - } + const auto &concurrent{ + std::get(loopControl->u)}; + CheckConcurrentLoopControl(concurrent, block); } using SymbolSet = std::set; - enum GatherWhichVariables { All, NotShared, Local }; - - static SymbolSet GatherVariables( - const std::list &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 &localitySpecs) const { SymbolSet symbols; - for (auto &ls : localitySpecs) { - auto names{std::visit( - [=](const auto &x) { - using T = std::decay_t; - using namespace parser; - if constexpr (!std::is_same_v) { - if (which == GatherWhichVariables::All || - (which == GatherWhichVariables::NotShared && - !std::is_same_v) || - (which == GatherWhichVariables::Local && - std::is_same_v)) { - 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(&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{}; - }, - 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 { + struct CollectSymbols : public virtual evaluate::VisitorBase { 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{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 &localitySpecs, const parser::Block &block) const { - // C1130 bool hasDefaultNone{false}; for (auto &ls : localitySpecs) { if (std::holds_alternative(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(concurrent.t)}; + // C1123, concurrent limit or step expressions can't reference index-names + void CheckConcurrentHeader(const parser::ConcurrentHeader &header) const { auto &controls{std::get>(header.t)}; SymbolSet indexNames; - for (auto &c : controls) { - auto &indexName{std::get(c.t)}; + for (const auto &c : controls) { + const auto &indexName{std::get(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>(c.t)}) { - HasNoReferences(indexNames, *expression); + HasNoReferences(indexNames, *expr); } } } + } - auto &mask{std::get>(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(concurrent.t)}; + const auto &controls{ + std::get>(header.t)}; + const auto &localitySpecs{ std::get>(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>(c.t)}) { + CheckExprDoesNotReferenceLocal(*expr, localVars); + } + } + if (const auto &mask{ + std::get>(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(concurrent.t)}; + const auto &mask{ + std::get>(header.t)}; + if (mask.has_value()) { + CheckMaskIsPure(*mask); + } + CheckConcurrentHeader(header); + CheckLocalitySpecs(concurrent, block); + } + SemanticsContext &context_; parser::CharBlock currentStatementSourcePosition_; }; // class DoContext diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt index c783d1a..e8345f8 100644 --- a/flang/test/semantics/CMakeLists.txt +++ b/flang/test/semantics/CMakeLists.txt @@ -143,6 +143,7 @@ set(ERROR_TESTS dosemantics06.f90 dosemantics07.f90 dosemantics08.f90 + dosemantics09.f90 expr-errors01.f90 null01.f90 omp-clause-validity01.f90 diff --git a/flang/test/semantics/dosemantics04.f90 b/flang/test/semantics/dosemantics04.f90 index f8c269f..fda51a8 100644 --- a/flang/test/semantics/dosemantics04.f90 +++ b/flang/test/semantics/dosemantics04.f90 @@ -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 index 0000000..0f38e8f --- /dev/null +++ b/flang/test/semantics/dosemantics09.f90 @@ -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 -- 2.7.4