void SayAlreadyDeclared(const SourceName &, Symbol &);
void SayAlreadyDeclared(const parser::Name &, Symbol &);
void SayWithDecl(const parser::Name &, Symbol &, MessageFixedText &&);
- void SayBadLocality(const parser::Name &, Symbol &);
+ void SayLocalMustBeVariable(const parser::Name &, Symbol &);
void SayDerivedType(const SourceName &, MessageFixedText &&, const Scope &);
void Say2(const SourceName &, MessageFixedText &&, const SourceName &,
MessageFixedText &&);
void CheckInitialDataTarget(const Symbol &, const SomeExpr &, SourceName);
void Initialization(const parser::Name &, const parser::Initialization &,
bool inComponentDecl);
+ bool PassesLocalityChecks(const parser::Name &name, Symbol &symbol);
// Declare an object or procedure entity.
// T is one of: EntityDetails, ObjectEntityDetails, ProcEntityDetails
context().SetError(symbol, msg.isFatal());
}
-void ScopeHandler::SayBadLocality(const parser::Name &name, Symbol &symbol) {
- SayWithDecl(name, symbol, "Locality attribute not allowed on '%s'"_err_en_US);
+void ScopeHandler::SayLocalMustBeVariable(
+ const parser::Name &name, Symbol &symbol) {
+ SayWithDecl(name, symbol,
+ "The name '%s' must be a variable to appear"
+ " in a locality-spec"_err_en_US);
}
void ScopeHandler::SayDerivedType(
}
}
+bool DeclarationVisitor::PassesLocalityChecks(
+ const parser::Name &name, Symbol &symbol) {
+ if (!IsVariableName(symbol)) {
+ SayLocalMustBeVariable(name, symbol); // C1124
+ return false;
+ }
+ if (IsAllocatable(symbol)) { // C1128
+ SayWithDecl(name, symbol,
+ "ALLOCATABLE variable '%s' not allowed in a locality-spec"_err_en_US);
+ return false;
+ }
+ if (IsOptional(symbol)) { // C1128
+ SayWithDecl(name, symbol,
+ "OPTIONAL argument '%s' not allowed in a locality-spec"_err_en_US);
+ return false;
+ }
+ if (IsIntentIn(symbol)) { // C1128
+ SayWithDecl(name, symbol,
+ "INTENT IN argument '%s' not allowed in a locality-spec"_err_en_US);
+ return false;
+ }
+ if (IsFinalizable(symbol)) { // C1128
+ SayWithDecl(name, symbol,
+ "Finalizable variable '%s' not allowed in a locality-spec"_err_en_US);
+ return false;
+ }
+ if (IsCoarray(symbol)) { // C1128
+ SayWithDecl(
+ name, symbol, "Coarray '%s' not allowed in a locality-spec"_err_en_US);
+ return false;
+ }
+ const DeclTypeSpec *type{symbol.GetType()};
+ if (type) {
+ if (type->IsPolymorphic() && symbol.IsDummy() &&
+ (!IsPointer(symbol))) { // C1128
+ SayWithDecl(name, symbol,
+ "Nonpointer polymorphic argument '%s' not allowed in a "
+ "locality-spec"_err_en_US);
+ return false;
+ }
+ }
+ if (IsAssumedSizeArray(symbol)) { // C1128
+ SayWithDecl(name, symbol,
+ "Assumed size array '%s' not allowed in a locality-spec"_err_en_US);
+ return false;
+ }
+ if (symbol.owner() == currScope()) { // C1125 and C1126
+ SayAlreadyDeclared(name, symbol);
+ return false;
+ }
+ // TODO: Check to see if the name can appear in a variable definition context
+ return true;
+}
+
Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) {
- auto *prev{FindSymbol(name)};
+ Symbol *prev{FindSymbol(name)};
bool implicit{false};
if (prev == nullptr) {
// Declare the name as an object in the enclosing scope so that
ApplyImplicitRules(*prev);
implicit = true;
}
- if (!ConvertToObjectEntity(*prev) || prev->attrs().test(Attr::PARAMETER)) {
- SayBadLocality(name, *prev); // C1124
- return nullptr;
- }
- if (prev->owner() == currScope()) { // C1125 and C1126
- SayAlreadyDeclared(name, *prev);
+ if (!PassesLocalityChecks(name, *prev)) {
return nullptr;
}
name.symbol = nullptr;
}
bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) {
- for (auto &name : x.v) {
- if (auto *prev{FindSymbol(name)}) {
- if (prev->owner() == currScope()) {
- SayAlreadyDeclared(name, *prev); // C1125 & C1126
- } else if (!IsVariableName(*prev)) {
- SayBadLocality(name, *prev); // C1124
- } else {
- auto &symbol{MakeSymbol(name, HostAssocDetails{*prev})};
- symbol.set(Symbol::Flag::LocalityShared);
- name.symbol = &symbol; // override resolution to parent
- }
- } else {
+ for (const auto &name : x.v) {
+ Symbol *prev{FindSymbol(name)};
+ if (!prev) {
Say(name, "Variable '%s' not found"_err_en_US);
context().SetError(
MakeSymbol(name, ObjectEntityDetails{EntityDetails{}}));
+ } else if (prev->owner() == currScope()) {
+ SayAlreadyDeclared(name, *prev); // C1125 and C1126
+ } else if (!IsVariableName(*prev)) {
+ SayLocalMustBeVariable(name, *prev); // C1124
+ } else {
+ auto &symbol{MakeSymbol(name, HostAssocDetails{*prev})};
+ symbol.set(Symbol::Flag::LocalityShared);
+ name.symbol = &symbol; // override resolution to parent
}
}
return false;
--- /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.
+
+! Tests for C1128:
+! A variable-name that appears in a LOCAL or LOCAL_INIT locality-spec shall not
+! have the ALLOCATABLE; INTENT (IN); or OPTIONAL attribute; shall not be of
+! finalizable type; shall not be a nonpointer polymorphic dummy argument; and
+! shall not be a coarray or an assumed-size array.
+
+subroutine s1()
+! Cannot have ALLOCATABLE variable in a locality spec
+ integer, allocatable :: k
+!ERROR: ALLOCATABLE variable 'k' not allowed in a locality-spec
+ do concurrent(i=1:5) local(k)
+ end do
+end subroutine s1
+
+subroutine s2(arg)
+! Cannot have a dummy OPTIONAL in a locality spec
+ integer, optional :: arg
+!ERROR: OPTIONAL argument 'arg' not allowed in a locality-spec
+ do concurrent(i=1:5) local(arg)
+ end do
+end subroutine s2
+
+subroutine s3(arg)
+! This is OK
+ real :: arg
+ do concurrent(i=1:5) local(arg)
+ end do
+end subroutine s3
+
+subroutine s4(arg)
+! Cannot have a dummy INTENT(IN) in a locality spec
+ real, intent(in) :: arg
+!ERROR: INTENT IN argument 'arg' not allowed in a locality-spec
+ do concurrent(i=1:5) local(arg)
+ end do
+end subroutine s4
+
+subroutine s5()
+! Cannot have a variable of a finalizable type in a locality spec
+ type t1
+ integer :: i
+ contains
+ final :: f
+ end type t1
+
+ type(t1) :: var
+
+!ERROR: Finalizable variable 'var' not allowed in a locality-spec
+ do concurrent(i=1:5) local(var)
+ end do
+
+contains
+ subroutine f(x)
+ type(t1) :: x
+ end subroutine f
+end subroutine s5
+
+subroutine s6
+! Cannot have a nonpointer polymorphic dummy argument in a locality spec
+ type :: t
+ integer :: field
+ end type t
+contains
+ subroutine s(x, y)
+ class(t), pointer :: x
+ class(t) :: y
+
+! This is allowed
+ do concurrent(i=1:5) local(x)
+ end do
+
+! This is not allowed
+!ERROR: Nonpointer polymorphic argument 'y' not allowed in a locality-spec
+ do concurrent(i=1:5) local(y)
+ end do
+ end subroutine s
+end subroutine s6
+
+subroutine s7()
+! Cannot have a coarray
+ integer, codimension[*] :: coarray_var
+!ERROR: Coarray 'coarray_var' not allowed in a locality-spec
+ do concurrent(i=1:5) local(coarray_var)
+ end do
+end subroutine s7
+
+subroutine s8(arg)
+! Cannot have an assumed size array
+ integer, dimension(*) :: arg
+!ERROR: Assumed size array 'arg' not allowed in a locality-spec
+ do concurrent(i=1:5) local(arg)
+ end do
+end subroutine s8