[flang] Enforce constraint C1128 for DO CONCURRENT locality-spec's
authorPeter Steinfeld <psteinfeld@nvidia.com>
Tue, 2 Jul 2019 19:10:09 +0000 (12:10 -0700)
committerPeter Steinfeld <psteinfeld@nvidia.com>
Wed, 3 Jul 2019 20:50:56 +0000 (13:50 -0700)
These changes implement most of the requirements for C1128, which says: "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.  A variable-name that is not
permitted to appear in a variable definition context shall not appear in a
LOCAL or LOCAL_INIT locality-spec."

The changes do not implement the checking required to determine whether a
variable can appear in a "variable definition context".

Here's a summary of the changes:
 - I created the function 'PassesLocalityChecks()' to enforce C1128 along with
   C1124, C1125, and C1126.
 - I cleaned up the code to check if a type or symbol is a coarray.
 - I added functions to tools.[h,cc] to test if a symbol is OPTIONAL, INTENT
   IN, finalizable, a coarray, or an assumed size array.  Should these be
   member functions of the type "Symbol"?
 - Since I changed one of the locality related error messages, I needed to
   change the test resolve35.f90.
 - I added the test resolve55.f90 to test all of the checks implemented in this
   update.

Original-commit: flang-compiler/f18@4ca5d090b9f9a82dd06cf46028586b1c7474f845
Reviewed-on: https://github.com/flang-compiler/f18/pull/542
Tree-same-pre-rewrite: false

flang/lib/semantics/check-allocate.cc
flang/lib/semantics/resolve-names.cc
flang/lib/semantics/tools.cc
flang/lib/semantics/tools.h
flang/test/semantics/CMakeLists.txt
flang/test/semantics/resolve35.f90
flang/test/semantics/resolve55.f90 [new file with mode: 0644]

index aa0d0da..ffc6304 100644 (file)
@@ -532,13 +532,6 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
   return RunCoarrayRelatedChecks(context);
 }
 
-static bool IsCoarray(const Symbol &symbol) {
-  if (const auto *objectDetails{symbol.detailsIf<ObjectEntityDetails>()}) {
-    return objectDetails->IsCoarray();
-  }
-  return false;
-}
-
 bool AllocationCheckerHelper::RunCoarrayRelatedChecks(
     SemanticsContext &context) const {
   if (symbol_ == nullptr) {
index e576e4f..5c71710 100644 (file)
@@ -434,7 +434,7 @@ public:
   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 &&);
@@ -830,6 +830,7 @@ private:
   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
@@ -1520,8 +1521,11 @@ void ScopeHandler::SayWithDecl(
   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(
@@ -3718,8 +3722,62 @@ bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction(
   }
 }
 
+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
@@ -3729,12 +3787,7 @@ Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) {
     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;
@@ -4018,21 +4071,20 @@ bool ConstructVisitor::Pre(const parser::LocalitySpec::LocalInit &x) {
 }
 
 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;
index b2b86b4..a86b478 100644 (file)
@@ -319,8 +319,6 @@ bool IsTeamType(const DerivedTypeSpec *derived) {
   return IsDerivedTypeFromModule(derived, "iso_fortran_env", "team_type");
 }
 
-bool IsCoarray(const Symbol &symbol) { return symbol.Corank() > 0; }
-
 const Symbol *HasCoarrayUltimateComponent(
     const DerivedTypeSpec &derivedTypeSpec) {
   return FindUltimateComponent(derivedTypeSpec, IsCoarray);
@@ -387,4 +385,33 @@ const Symbol *FindUltimateComponent(const DerivedTypeSpec &derivedTypeSpec,
   return nullptr;
 }
 
+bool IsFinalizable(const Symbol &symbol) {
+  const DeclTypeSpec *type{symbol.GetType()};
+  if (type) {
+    const DerivedTypeSpec *derived{type->AsDerived()};
+    if (derived) {
+      const Scope *scope{derived->scope()};
+      if (scope) {
+        for (auto &pair : *scope) {
+          Symbol &symbol{*pair.second};
+          if (symbol.has<FinalProcDetails>()) {
+            return true;
+          }
+        }
+      }
+    }
+  }
+  return false;
+}
+
+bool IsCoarray(const Symbol &symbol) {
+  const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
+  return details && details->IsCoarray();
+}
+
+bool IsAssumedSizeArray(const Symbol &symbol) {
+  const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
+  return details && details->IsAssumedSize();
+}
+
 }
index d934931..b4de448 100644 (file)
@@ -93,6 +93,15 @@ inline bool IsAllocatableOrPointer(const Symbol &symbol) {
 inline bool IsParameter(const Symbol &symbol) {
   return symbol.attrs().test(Attr::PARAMETER);
 }
+inline bool IsOptional(const Symbol &symbol) {
+  return symbol.attrs().test(Attr::OPTIONAL);
+}
+inline bool IsIntentIn(const Symbol &symbol) {
+  return symbol.attrs().test(Attr::INTENT_IN);
+}
+bool IsFinalizable(const Symbol &symbol);
+bool IsCoarray(const Symbol &symbol);
+bool IsAssumedSizeArray(const Symbol &symbol);
 
 // Determines whether an object might be visible outside a
 // PURE function (C1594); returns a non-null Symbol pointer for
index 462b77f..d3683c9 100644 (file)
@@ -91,6 +91,7 @@ set(ERROR_TESTS
   resolve52.f90
   resolve53.f90
   resolve54.f90
+  resolve55.f90
   stop01.f90
   structconst01.f90
   structconst02.f90
index 73432f6..d5433ab 100644 (file)
@@ -120,23 +120,23 @@ subroutine s10
   real, parameter :: bad2 = 1.0
   x = cos(0.)
   do concurrent(i=1:2) &
-    !ERROR: Locality attribute not allowed on 'bad1'
+    !ERROR: The name 'bad1' must be a variable to appear in a locality-spec
     local(bad1) &
-    !ERROR: Locality attribute not allowed on 'bad2'
+    !ERROR: The name 'bad2' must be a variable to appear in a locality-spec
     local(bad2) &
-    !ERROR: Locality attribute not allowed on 'bad3'
+    !ERROR: The name 'bad3' must be a variable to appear in a locality-spec
     local(bad3) &
-    !ERROR: Locality attribute not allowed on 'cos'
+    !ERROR: The name 'cos' must be a variable to appear in a locality-spec
     local(cos)
   end do
   do concurrent(i=1:2) &
-    !ERROR: Locality attribute not allowed on 'bad1'
+    !ERROR: The name 'bad1' must be a variable to appear in a locality-spec
     shared(bad1) &
-    !ERROR: Locality attribute not allowed on 'bad2'
+    !ERROR: The name 'bad2' must be a variable to appear in a locality-spec
     shared(bad2) &
-    !ERROR: Locality attribute not allowed on 'bad3'
+    !ERROR: The name 'bad3' must be a variable to appear in a locality-spec
     shared(bad3) &
-    !ERROR: Locality attribute not allowed on 'cos'
+    !ERROR: The name 'cos' must be a variable to appear in a locality-spec
     shared(cos)
   end do
 contains
diff --git a/flang/test/semantics/resolve55.f90 b/flang/test/semantics/resolve55.f90
new file mode 100644 (file)
index 0000000..a88cf20
--- /dev/null
@@ -0,0 +1,107 @@
+! 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