[flang] Prevent rewrite of shape inquiries to non constant explicit expr

[jeanPerier]

Summary

Shape analysis was building expressions using non constant explicit bounds.
This caused issues because shape analysis is actively used in front-end
expression rewrites, regardless of the context. When rewriting expressions
inside execution parts it is not guaranteed that non constant specification
expressions will evaluate to the same value they would inside the specification
parts.

Example:

fortran
subroutine foo(n)
  real :: x(n)
  n = n + 100
  print *, size(x, 1)
end subroutine

Was unparsed with f18 -funparse to the following program that is not
semantically equivalent:

fortran
SUBROUTINE foo (n)
 REAL x(n)
  n=n+100_4
 PRINT *, int(int(n,kind=8)-1_8+1_8,kind=4)
END SUBROUTINE

Currently, this impacted at least all rewrites of LBOUND, UBOUND, SIZE, SHAPE,
and SIZEOF.

This patch prevents usage of non constant explicit bounds in shape analysis
results, except when requested by the shape analysis user (in contexts where it
is known to be safe to use these). Otherwise, evaluate::DescriptorInquiry are
generated. The only place where keeping non constant explicit bounds in shape
analysis appeared to be needed so far was runtime type info generation (for
derived types).

I considered fixing it at the folding level (by discarding non constant results from
shape analysis), but it seemed less solid (more places to secure, hard to enforce all
usages of shape analysis do not end-up used somewhere else now or in the future). Also,
Being able to rewrite size(x+y) where y is an array to size(y) is safe and still an
improvement, and naively discarding non constant shape analysis results in folding was
preventing that from happening.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/include/flang/Evaluate/shape.h

69

Typo, should be "contexts" rather than "context".

[jeanPerier]

Fix typo in comments.

[klausler]

Are there any clients of these APIs that should have the new flag arguments set to "true"?

[jeanPerier]

In D105500#2862295, @klausler wrote:

Are there any clients of these APIs that should have the new flag arguments set to "true"?

Yes, the derived type info generation needs to be able to access length type parameters symbols in the returned expressions. runtime-type-info.cpp changes are setting the useNonConstantExplicitExpr to true.

[klausler]

It may be the case that shape analysis could always create expressions containing descriptor inquiry operations for non-constant bounds (&c.), and the decision whether to rewrite those inquiries (or not) be moved into folding and controlled by the FoldingContext instead. Shape analysis, per se, shouldn't be the part of the code that cares about specification vs. executable parts.

[jeanPerier]

A better approach is being worked on by @klausler.

flang/include/flang/Evaluate/shape.h

 
 Shape Fold(FoldingContext &, Shape &&);
 std::optional<Shape> Fold(FoldingContext &, std::optional<Shape> &&);
 
 template <typename A>
 std::optional<Shape> GetShape(FoldingContext &, const A &);
 template <typename A> std::optional<Shape> GetShape(const A &);
 
-// The dimension argument to these inquiries is zero-based,
-// unlike the DIM= arguments to many intrinsics.
-ExtentExpr GetLowerBound(const NamedEntity &, int dimension);
-ExtentExpr GetLowerBound(FoldingContext &, const NamedEntity &, int dimension);
-MaybeExtentExpr GetUpperBound(const NamedEntity &, int dimension);
-MaybeExtentExpr GetUpperBound(
-    FoldingContext &, const NamedEntity &, int dimension);
+// Notes about GetLowerBound and GetUpperBound:
+// - The dimension argument to these inquiries is zero-based,
+//   unlike the DIM= arguments to many intrinsics.
+// - Shape analysis results might be used outside of the specification part,
+//   in which case it is not possible to inject a non constant specification
+//   expression because it may evaluate to a different value than it did in
+//   the specification part. In contexts where it is known to be possible to
+//   use such non constant specification expressions, the flag
+//   useNonConstantExplicitBounds can be set to true. Otherwise,
+//   evaluate::DescriptorInquiry will be returned for non constant explicit
+//   bounds.
+ExtentExpr GetLowerBound(const NamedEntity &, int dimension,
+    bool useNonConstantExplicitBounds = false);
+ExtentExpr GetLowerBound(FoldingContext &, const NamedEntity &, int dimension,
+    bool useNonConstantExplicitBounds = false);
+MaybeExtentExpr GetUpperBound(const NamedEntity &, int dimension,
+    bool useNonConstantExplicitBounds = false);
+MaybeExtentExpr GetUpperBound(FoldingContext &, const NamedEntity &,
+    int dimension, bool useNonConstantExplicitBounds = false);
 MaybeExtentExpr ComputeUpperBound(ExtentExpr &&lower, MaybeExtentExpr &&extent);
 MaybeExtentExpr ComputeUpperBound(
     FoldingContext &, ExtentExpr &&lower, MaybeExtentExpr &&extent);
 Shape GetLowerBounds(const NamedEntity &);
 Shape GetLowerBounds(FoldingContext &, const NamedEntity &);
 Shape GetUpperBounds(const NamedEntity &);
 Shape GetUpperBounds(FoldingContext &, const NamedEntity &);
 MaybeExtentExpr GetExtent(const NamedEntity &, int dimension);

flang/lib/Evaluate/shape.cpp

 //===-- lib/Evaluate/shape.cpp --------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Evaluate/shape.h"
 #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"
 #include "flang/Evaluate/type.h"
 #include "flang/Parser/message.h"
 #include "flang/Semantics/symbol.h"
 #include <functional>
 

 // Determines lower bound on a dimension.  This can be other than 1 only
 // for a reference to a whole array object or component. (See LBOUND, 16.9.109).
 // ASSOCIATE construct entities may require tranversal of their referents.
 class GetLowerBoundHelper : public Traverse<GetLowerBoundHelper, ExtentExpr> {
 public:
   using Result = ExtentExpr;
   using Base = Traverse<GetLowerBoundHelper, ExtentExpr>;
   using Base::operator();
-  explicit GetLowerBoundHelper(int d) : Base{*this}, dimension_{d} {}
+  explicit GetLowerBoundHelper(int d, bool b)
+      : Base{*this}, dimension_{d}, useNonConstantExplicitBounds_{b} {}
   static ExtentExpr Default() { return ExtentExpr{1}; }
   static ExtentExpr Combine(Result &&, Result &&) { return Default(); }
   ExtentExpr operator()(const Symbol &);
   ExtentExpr operator()(const Component &);
 
 private:
   int dimension_;
+  bool useNonConstantExplicitBounds_;
 };
 
+static const ExtentExpr *GetIfConstantExpr(
+    const semantics::Bound &bound, bool useNonConstantExplicitBounds = false) {
+  if (const auto &expr{bound.GetExplicit()}) {
+    if (useNonConstantExplicitBounds || IsConstantExpr(*expr)) {
+      return &*expr;
+    }
+  }
+  return nullptr;
+}
+
 auto GetLowerBoundHelper::operator()(const Symbol &symbol0) -> Result {
   const Symbol &symbol{symbol0.GetUltimate()};
   if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
     int j{0};
     for (const auto &shapeSpec : details->shape()) {
       if (j++ == dimension_) {
-        if (const auto &bound{shapeSpec.lbound().GetExplicit()}) {
+        if (const auto *bound{GetIfConstantExpr(
+                shapeSpec.lbound(), useNonConstantExplicitBounds_)}) {
           return *bound;
         } else if (IsDescriptor(symbol)) {
           return ExtentExpr{DescriptorInquiry{NamedEntity{symbol0},
               DescriptorInquiry::Field::LowerBound, dimension_}};
         } else {
           break;
         }
       }
     }
   } else if (const auto *assoc{
                  symbol.detailsIf<semantics::AssocEntityDetails>()}) {
     return (*this)(assoc->expr());
   }
   return Default();
 }
 
 auto GetLowerBoundHelper::operator()(const Component &component) -> Result {
   if (component.base().Rank() == 0) {
     const Symbol &symbol{component.GetLastSymbol().GetUltimate()};
     if (const auto *details{
             symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
       int j{0};
       for (const auto &shapeSpec : details->shape()) {
         if (j++ == dimension_) {
-          if (const auto &bound{shapeSpec.lbound().GetExplicit()}) {
+          if (const auto *bound{GetIfConstantExpr(
+                  shapeSpec.lbound(), useNonConstantExplicitBounds_)}) {
             return *bound;
           } else if (IsDescriptor(symbol)) {
             return ExtentExpr{
                 DescriptorInquiry{NamedEntity{common::Clone(component)},
                     DescriptorInquiry::Field::LowerBound, dimension_}};
           } else {
             break;
           }
         }
       }
     }
   }
   return Default();
 }
 
-ExtentExpr GetLowerBound(const NamedEntity &base, int dimension) {
-  return GetLowerBoundHelper{dimension}(base);
+ExtentExpr GetLowerBound(
+    const NamedEntity &base, int dimension, bool useNonConstantExplicitBounds) {
+  return GetLowerBoundHelper{dimension, useNonConstantExplicitBounds}(base);
 }
 
-ExtentExpr GetLowerBound(
-    FoldingContext &context, const NamedEntity &base, int dimension) {
-  return Fold(context, GetLowerBound(base, dimension));
+ExtentExpr GetLowerBound(FoldingContext &context, const NamedEntity &base,
+    int dimension, bool useNonConstantExplicitBounds) {
+  return Fold(
+      context, GetLowerBound(base, dimension, useNonConstantExplicitBounds));
 }
 
 Shape GetLowerBounds(const NamedEntity &base) {
   Shape result;
   int rank{base.Rank()};
   for (int dim{0}; dim < rank; ++dim) {
     result.emplace_back(GetLowerBound(base, dim));
   }
if (IsImpliedShape(symbol) && details->init()) {
         if (dimension < static_cast<int>(shape->size())) {
           return std::move(shape->at(dimension));
         }
       }
     } else {
       int j{0};
       for (const auto &shapeSpec : details->shape()) {
         if (j++ == dimension) {
-          if (shapeSpec.ubound().isExplicit()) {
-            if (const auto &ubound{shapeSpec.ubound().GetExplicit()}) {
-              if (const auto &lbound{shapeSpec.lbound().GetExplicit()}) {
-                return common::Clone(ubound.value()) -
-                    common::Clone(lbound.value()) + ExtentExpr{1};
-              } else {
-                return ubound.value();
-              }
-            }
+          const auto *ubound{GetIfConstantExpr(shapeSpec.ubound())};
+          const auto *lbound{GetIfConstantExpr(shapeSpec.lbound())};
+          if (ubound && lbound) {
+            return common::Clone(*ubound) - common::Clone(*lbound) +
+                ExtentExpr{1};
+          } else if (ubound && !shapeSpec.lbound().isExplicit()) {
+            return *ubound;
           } else if (details->IsAssumedSize() && j == symbol.Rank()) {
             return std::nullopt;
           } else if (semantics::IsDescriptor(symbol)) {
             return ExtentExpr{DescriptorInquiry{NamedEntity{base},
                 DescriptorInquiry::Field::Extent, dimension}};
           }
         }
       }
MaybeExtentExpr ComputeUpperBound(
   }
 }
 
 MaybeExtentExpr ComputeUpperBound(
     FoldingContext &context, ExtentExpr &&lower, MaybeExtentExpr &&extent) {
   return Fold(context, ComputeUpperBound(std::move(lower), std::move(extent)));
 }
 
-MaybeExtentExpr GetUpperBound(const NamedEntity &base, int dimension) {
+MaybeExtentExpr GetUpperBound(
+    const NamedEntity &base, int dimension, bool useNonConstantExplicitBounds) {
   const Symbol &symbol{ResolveAssociations(base.GetLastSymbol())};
   if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
     int j{0};
     for (const auto &shapeSpec : details->shape()) {
       if (j++ == dimension) {
-        if (const auto &bound{shapeSpec.ubound().GetExplicit()}) {
+        if (const auto *bound{GetIfConstantExpr(
+                shapeSpec.ubound(), useNonConstantExplicitBounds)}) {
           return *bound;
         } else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) {
           break;
         } else {
           return ComputeUpperBound(
               GetLowerBound(base, dimension), GetExtent(base, dimension));
         }
       }
     }
   } else if (const auto *assoc{
                  symbol.detailsIf<semantics::AssocEntityDetails>()}) {
     if (auto shape{GetShape(assoc->expr())}) {
       if (dimension < static_cast<int>(shape->size())) {
         return ComputeUpperBound(
             GetLowerBound(base, dimension), std::move(shape->at(dimension)));
       }
     }
   }
   return std::nullopt;
 }
 
-MaybeExtentExpr GetUpperBound(
-    FoldingContext &context, const NamedEntity &base, int dimension) {
-  return Fold(context, GetUpperBound(base, dimension));
+MaybeExtentExpr GetUpperBound(FoldingContext &context, const NamedEntity &base,
+    int dimension, bool useNonConstantExplicitBounds) {
+  return Fold(
+      context, GetUpperBound(base, dimension, useNonConstantExplicitBounds));
 }
 
 Shape GetUpperBounds(const NamedEntity &base) {
   const Symbol &symbol{ResolveAssociations(base.GetLastSymbol())};
   if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
     Shape result;
     int dim{0};
     for (const auto &shapeSpec : details->shape()) {
-      if (const auto &bound{shapeSpec.ubound().GetExplicit()}) {
+      if (const auto *bound{GetIfConstantExpr(shapeSpec.ubound())}) {
         result.push_back(*bound);
       } else if (details->IsAssumedSize()) {
         CHECK(dim + 1 == base.Rank());
         result.emplace_back(std::nullopt); // UBOUND folding replaces with -1
       } else {
         result.emplace_back(
             ComputeUpperBound(GetLowerBound(base, dim), GetExtent(base, dim)));
       }

flang/lib/Semantics/runtime-type-info.cpp

evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
   }
   // Shape information
   int rank{evaluate::GetRank(shape)};
   AddValue(values, componentSchema_, "rank"s, IntExpr<1>(rank));
   if (rank > 0 && !IsAllocatable(symbol) && !IsPointer(symbol)) {
     std::vector<evaluate::StructureConstructor> bounds;
     evaluate::NamedEntity entity{symbol};
     for (int j{0}; j < rank; ++j) {
-      bounds.emplace_back(GetValue(std::make_optional(evaluate::GetLowerBound(
-                                       foldingContext, entity, j)),
+      // Force usage of length parameters in bound expressions instead of
+      // replacing their appearances by evaluate::DescriptorInquiry.
+      // Bounds dependency on length parameters will be translated in
+      // the generated type-info.
+      const bool useNonConstantExplicitExpr{true};
+      bounds.emplace_back(
+          GetValue(std::make_optional(evaluate::GetLowerBound(
+                       foldingContext, entity, j, useNonConstantExplicitExpr)),
+              parameters));
+      bounds.emplace_back(GetValue(evaluate::GetUpperBound(foldingContext,
+                                       entity, j, useNonConstantExplicitExpr),
           parameters));
-      bounds.emplace_back(GetValue(
-          evaluate::GetUpperBound(foldingContext, entity, j), parameters));
     }
     AddValue(values, componentSchema_, "bounds"s,
         SaveDerivedPointerTarget(scope,
             SaveObjectName(
                 ".b."s + distinctName + "."s + symbol.name().ToString()),
             std::move(bounds), evaluate::ConstantSubscripts{2, rank}));
   } else {
     AddValue(

flang/test/Semantics/modfile33.f90

 !  end
 ! end interface
 !contains
 ! subroutine s1(n, x, y, z, a, b)
 !  integer(8) :: n
 !  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
 
 ! Parameterized derived type
 module m7
   type :: t(k)
     integer, kind :: k