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 };
}
}
+ // 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));
}
}
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(
"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) {
}
}
}
+
+ 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_;
--- /dev/null
+! 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