[flang-commits] [flang] ca47447 - [flang] Don't reference non-invariant symbols in shape expressions

Peter Klausler via flang-commits flang-commits at lists.llvm.org
Mon Nov 8 12:48:54 PST 2021


Author: Peter Klausler
Date: 2021-11-08T12:48:47-08:00
New Revision: ca47447952f1f8b0de11aac75b45f83f88579b80

URL: https://github.com/llvm/llvm-project/commit/ca47447952f1f8b0de11aac75b45f83f88579b80
DIFF: https://github.com/llvm/llvm-project/commit/ca47447952f1f8b0de11aac75b45f83f88579b80.diff

LOG: [flang] Don't reference non-invariant symbols in shape expressions

When an array's shape involves references to symbols that are not
invariant in a scope -- the classic example being a dummy array
with an explicit shape involving other dummy arguments -- the
compiler was creating shape expressions that referenced those
symbols.  This might be valid if those symbols are somehow
captured and copied at each entry point to a subprogram, and
the copies referenced in the shapes instead, but that's not
the case.

This patch introduces a new expression predicate IsScopeInvariantExpr(),
which defines a class of expressions that contains constant expressions
(in the sense that the standard uses that term) as well as references
to items that may be safely accessed in a context-free way throughout
their scopes.   This includes dummy arguments that are INTENT(IN)
and not VALUE, descriptor inquiries into descriptors that cannot
change, and bare LEN type parameters within the definitions of
derived types.  The new predicate is then used in shape analysis
to winnow out results that would have otherwise been contextual.

Differential Revision: https://reviews.llvm.org/D113309

Added: 
    

Modified: 
    flang/include/flang/Evaluate/check-expression.h
    flang/lib/Evaluate/check-expression.cpp
    flang/lib/Evaluate/shape.cpp
    flang/test/Semantics/modfile33.f90
    flang/test/Semantics/offsets01.f90

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h
index f1aab7b579476..21f48be0f7d34 100644
--- a/flang/include/flang/Evaluate/check-expression.h
+++ b/flang/include/flang/Evaluate/check-expression.h
@@ -34,6 +34,15 @@ extern template bool IsConstantExpr(const Expr<SomeInteger> &);
 extern template bool IsConstantExpr(const Expr<SubscriptInteger> &);
 extern template bool IsConstantExpr(const StructureConstructor &);
 
+// Predicate: true when an expression is a constant expression (in the
+// strict sense of the Fortran standard) or a dummy argument with
+// INTENT(IN) and no VALUE.  This is useful for representing explicit
+// shapes of other dummy arguments.
+template <typename A> bool IsScopeInvariantExpr(const A &);
+extern template bool IsScopeInvariantExpr(const Expr<SomeType> &);
+extern template bool IsScopeInvariantExpr(const Expr<SomeInteger> &);
+extern template bool IsScopeInvariantExpr(const Expr<SubscriptInteger> &);
+
 // Predicate: true when an expression actually is a typed Constant<T>,
 // perhaps with parentheses and wrapping around it.  False for all typeless
 // expressions, including BOZ literals.

diff  --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index aaed4c33b1e1f..53c93354c2393 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -18,13 +18,18 @@
 
 namespace Fortran::evaluate {
 
-// Constant expression predicate IsConstantExpr().
+// Constant expression predicates IsConstantExpr() & IsScopeInvariantExpr().
 // This code determines whether an expression is a "constant expression"
 // in the sense of section 10.1.12.  This is not the same thing as being
 // able to fold it (yet) into a known constant value; specifically,
 // the expression may reference derived type kind parameters whose values
 // are not yet known.
-class IsConstantExprHelper : public AllTraverse<IsConstantExprHelper, true> {
+//
+// The variant form (IsScopeInvariantExpr()) also accepts symbols that are
+// INTENT(IN) dummy arguments without the VALUE attribute.
+template <bool INVARIANT>
+class IsConstantExprHelper
+    : public AllTraverse<IsConstantExprHelper<INVARIANT>, true> {
 public:
   using Base = AllTraverse<IsConstantExprHelper, true>;
   IsConstantExprHelper() : Base{*this} {}
@@ -36,12 +41,15 @@ class IsConstantExprHelper : public AllTraverse<IsConstantExprHelper, true> {
   }
 
   bool operator()(const TypeParamInquiry &inq) const {
-    return semantics::IsKindTypeParameter(inq.parameter());
+    return INVARIANT || semantics::IsKindTypeParameter(inq.parameter());
   }
   bool operator()(const semantics::Symbol &symbol) const {
     const auto &ultimate{GetAssociationRoot(symbol)};
     return IsNamedConstant(ultimate) || IsImpliedDoIndex(ultimate) ||
-        IsInitialProcedureTarget(ultimate);
+        IsInitialProcedureTarget(ultimate) ||
+        ultimate.has<semantics::TypeParamDetails>() ||
+        (INVARIANT && IsIntentIn(symbol) &&
+            !symbol.attrs().test(semantics::Attr::VALUE));
   }
   bool operator()(const CoarrayRef &) const { return false; }
   bool operator()(const semantics::ParamValue &param) const {
@@ -72,7 +80,12 @@ class IsConstantExprHelper : public AllTraverse<IsConstantExprHelper, true> {
   }
 
   bool operator()(const Constant<SomeDerived> &) const { return true; }
-  bool operator()(const DescriptorInquiry &) const { return false; }
+  bool operator()(const DescriptorInquiry &x) const {
+    const Symbol &sym{x.base().GetLastSymbol()};
+    return INVARIANT && !IsAllocatable(sym) &&
+        (!IsDummy(sym) ||
+            (IsIntentIn(sym) && !sym.attrs().test(semantics::Attr::VALUE)));
+  }
 
 private:
   bool IsConstantStructureConstructorComponent(
@@ -80,7 +93,8 @@ class IsConstantExprHelper : public AllTraverse<IsConstantExprHelper, true> {
   bool IsConstantExprShape(const Shape &) const;
 };
 
-bool IsConstantExprHelper::IsConstantStructureConstructorComponent(
+template <bool INVARIANT>
+bool IsConstantExprHelper<INVARIANT>::IsConstantStructureConstructorComponent(
     const Symbol &component, const Expr<SomeType> &expr) const {
   if (IsAllocatable(component)) {
     return IsNullPointer(expr);
@@ -92,7 +106,9 @@ bool IsConstantExprHelper::IsConstantStructureConstructorComponent(
   }
 }
 
-bool IsConstantExprHelper::operator()(const ProcedureRef &call) const {
+template <bool INVARIANT>
+bool IsConstantExprHelper<INVARIANT>::operator()(
+    const ProcedureRef &call) const {
   // LBOUND, UBOUND, and SIZE with DIM= arguments will have been rewritten
   // into DescriptorInquiry operations.
   if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&call.proc().u)}) {
@@ -122,7 +138,9 @@ bool IsConstantExprHelper::operator()(const ProcedureRef &call) const {
   return false;
 }
 
-bool IsConstantExprHelper::IsConstantExprShape(const Shape &shape) const {
+template <bool INVARIANT>
+bool IsConstantExprHelper<INVARIANT>::IsConstantExprShape(
+    const Shape &shape) const {
   for (const auto &extent : shape) {
     if (!(*this)(extent)) {
       return false;
@@ -132,13 +150,21 @@ bool IsConstantExprHelper::IsConstantExprShape(const Shape &shape) const {
 }
 
 template <typename A> bool IsConstantExpr(const A &x) {
-  return IsConstantExprHelper{}(x);
+  return IsConstantExprHelper<false>{}(x);
 }
 template bool IsConstantExpr(const Expr<SomeType> &);
 template bool IsConstantExpr(const Expr<SomeInteger> &);
 template bool IsConstantExpr(const Expr<SubscriptInteger> &);
 template bool IsConstantExpr(const StructureConstructor &);
 
+// IsScopeInvariantExpr()
+template <typename A> bool IsScopeInvariantExpr(const A &x) {
+  return IsConstantExprHelper<true>{}(x);
+}
+template bool IsScopeInvariantExpr(const Expr<SomeType> &);
+template bool IsScopeInvariantExpr(const Expr<SomeInteger> &);
+template bool IsScopeInvariantExpr(const Expr<SubscriptInteger> &);
+
 // IsActuallyConstant()
 struct IsActuallyConstantHelper {
   template <typename A> bool operator()(const A &) { return false; }

diff  --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index a387845625f2f..96a99c823f192 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -10,6 +10,7 @@
 #include "flang/Common/idioms.h"
 #include "flang/Common/template.h"
 #include "flang/Evaluate/characteristics.h"
+#include "flang/Evaluate/check-expression.h"
 #include "flang/Evaluate/fold.h"
 #include "flang/Evaluate/intrinsics.h"
 #include "flang/Evaluate/tools.h"
@@ -249,7 +250,8 @@ auto GetLowerBoundHelper::operator()(const Symbol &symbol0) -> Result {
     int j{0};
     for (const auto &shapeSpec : details->shape()) {
       if (j++ == dimension_) {
-        if (const auto &bound{shapeSpec.lbound().GetExplicit()}) {
+        const auto &bound{shapeSpec.lbound().GetExplicit()};
+        if (bound && IsScopeInvariantExpr(*bound)) {
           return *bound;
         } else if (IsDescriptor(symbol)) {
           return ExtentExpr{DescriptorInquiry{NamedEntity{symbol0},
@@ -282,7 +284,8 @@ auto GetLowerBoundHelper::operator()(const Component &component) -> Result {
       int j{0};
       for (const auto &shapeSpec : details->shape()) {
         if (j++ == dimension_) {
-          if (const auto &bound{shapeSpec.lbound().GetExplicit()}) {
+          const auto &bound{shapeSpec.lbound().GetExplicit()};
+          if (bound && IsScopeInvariantExpr(*bound)) {
             return *bound;
           } else if (IsDescriptor(symbol)) {
             return ExtentExpr{
@@ -340,9 +343,21 @@ static MaybeExtentExpr GetNonNegativeExtent(
     } else {
       return ExtentExpr{*uval - *lval + 1};
     }
+  } else if (lbound && ubound && IsScopeInvariantExpr(*lbound) &&
+      IsScopeInvariantExpr(*ubound)) {
+    // Apply effective IDIM (MAX calculation with 0) so thet the
+    // result is never negative
+    if (lval.value_or(0) == 1) {
+      return ExtentExpr{Extremum<SubscriptInteger>{
+          Ordering::Greater, ExtentExpr{0}, common::Clone(*ubound)}};
+    } else {
+      return ExtentExpr{
+          Extremum<SubscriptInteger>{Ordering::Greater, ExtentExpr{0},
+              common::Clone(*ubound) - common::Clone(*lbound) + ExtentExpr{1}}};
+    }
+  } else {
+    return std::nullopt;
   }
-  return common::Clone(ubound.value()) - common::Clone(lbound.value()) +
-      ExtentExpr{1};
 }
 
 MaybeExtentExpr GetExtent(const NamedEntity &base, int dimension) {
@@ -372,21 +387,15 @@ MaybeExtentExpr GetExtent(const NamedEntity &base, int dimension) {
       int j{0};
       for (const auto &shapeSpec : details->shape()) {
         if (j++ == dimension) {
-          if (const auto &ubound{shapeSpec.ubound().GetExplicit()}) {
-            if (shapeSpec.ubound().GetExplicit()) {
-              // 8.5.8.2, paragraph 3.  If the upper bound is less than the
-              // lower bound, the extent is zero.
-              if (shapeSpec.lbound().GetExplicit()) {
-                return GetNonNegativeExtent(shapeSpec);
-              } else {
-                return ubound.value();
-              }
-            }
+          if (auto extent{GetNonNegativeExtent(shapeSpec)}) {
+            return extent;
           } else if (details->IsAssumedSize() && j == symbol.Rank()) {
             return std::nullopt;
           } else if (semantics::IsDescriptor(symbol)) {
             return ExtentExpr{DescriptorInquiry{NamedEntity{base},
                 DescriptorInquiry::Field::Extent, dimension}};
+          } else {
+            break;
           }
         }
       }
@@ -437,7 +446,11 @@ MaybeExtentExpr GetExtent(FoldingContext &context, const Subscript &subscript,
 MaybeExtentExpr ComputeUpperBound(
     ExtentExpr &&lower, MaybeExtentExpr &&extent) {
   if (extent) {
-    return std::move(*extent) + std::move(lower) - ExtentExpr{1};
+    if (ToInt64(lower).value_or(0) == 1) {
+      return std::move(*extent);
+    } else {
+      return std::move(*extent) + std::move(lower) - ExtentExpr{1};
+    }
   } else {
     return std::nullopt;
   }
@@ -454,7 +467,8 @@ MaybeExtentExpr GetUpperBound(const NamedEntity &base, int dimension) {
     int j{0};
     for (const auto &shapeSpec : details->shape()) {
       if (j++ == dimension) {
-        if (const auto &bound{shapeSpec.ubound().GetExplicit()}) {
+        const auto &bound{shapeSpec.ubound().GetExplicit()};
+        if (bound && IsScopeInvariantExpr(*bound)) {
           return *bound;
         } else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) {
           break;
@@ -487,10 +501,10 @@ Shape GetUpperBounds(const NamedEntity &base) {
     Shape result;
     int dim{0};
     for (const auto &shapeSpec : details->shape()) {
-      if (const auto &bound{shapeSpec.ubound().GetExplicit()}) {
+      const auto &bound{shapeSpec.ubound().GetExplicit()};
+      if (bound && IsScopeInvariantExpr(*bound)) {
         result.push_back(*bound);
-      } else if (details->IsAssumedSize()) {
-        CHECK(dim + 1 == base.Rank());
+      } else if (details->IsAssumedSize() && dim + 1 == base.Rank()) {
         result.emplace_back(std::nullopt); // UBOUND folding replaces with -1
       } else {
         result.emplace_back(

diff  --git a/flang/test/Semantics/modfile33.f90 b/flang/test/Semantics/modfile33.f90
index a348e2b5db712..5eae92a8a7f99 100644
--- a/flang/test/Semantics/modfile33.f90
+++ b/flang/test/Semantics/modfile33.f90
@@ -572,7 +572,7 @@ subroutine s1(n, x, y, z, a, b)
 !  real(4) :: x
 !  real(4) :: y(1_8:4_8, 1_8:n)
 !  real(4) :: z(1_8:2_8, 1_8:2_8, 1_8:2_8)
-!  real(4) :: a(1_8:int(int(4_8*(n-1_8+1_8),kind=4),kind=8))
+!  real(4) :: a(1_8:int(int(4_8*size(y,dim=2),kind=4),kind=8))
 !  real(4) :: b(1_8:add(y, z))
 ! end
 !end

diff  --git a/flang/test/Semantics/offsets01.f90 b/flang/test/Semantics/offsets01.f90
index c3d66a5bc94ab..ccd70769bcee6 100644
--- a/flang/test/Semantics/offsets01.f90
+++ b/flang/test/Semantics/offsets01.f90
@@ -38,14 +38,14 @@ subroutine s4
 ! Descriptors with length parameters
 subroutine s5(n)
   integer :: n
-  type :: t1(l)
-    integer, len :: l
-    real :: a(l)
+  type :: t1(n)
+    integer, len :: n
+    real :: a(n)
   end type
-  type :: t2(l1, l2)
-    integer, len :: l1
-    integer, len :: l2
-    real :: b(l1, l2)
+  type :: t2(n1, n2)
+    integer, len :: n1
+    integer, len :: n2
+    real :: b(n1, n2)
   end type
   type(t1(n))   :: x1 !CHECK: x1 size=40 offset=
   type(t2(n,n)) :: x2 !CHECK: x2 size=48 offset=


        


More information about the flang-commits mailing list