[flang] Correct handling of non-default lower bounds in ASSOCIATE with named constants

[klausler]

Summary

Work through several issues with LBOUND() and UBOUND() of ASSOCIATE
construct entities that have been associated with named constants or
subobjects of named constants that are sporting non-default lower bounds.
Sometimes the non-default lower bounds matter, sometimes they don't.
Add a fairly exhaustive test to work through the possibilities.

[vzakhari]

LGTM. Thank you!

flang/include/flang/Evaluate/constant.h

 
 class ConstantBounds {
 public:
   ConstantBounds() = default;
   explicit ConstantBounds(const ConstantSubscripts &shape);
   explicit ConstantBounds(ConstantSubscripts &&shape);
   ~ConstantBounds();
   const ConstantSubscripts &shape() const { return shape_; }
+  int Rank() const { return GetRank(shape_); }
+  Constant<SubscriptInteger> SHAPE() const;
+
+  // It is possible in this representation for a constant array to have
+  // lower bounds other than 1, which is of course not expressible in
+  // Fortran.  This case arises only from definitions of named constant
+  // arrays with such bounds, as in:
+  //   REAL, PARAMETER :: NAMED(0:1) = [1.,2.]
+  // Bundling the lower bounds of the named constant with its
+  // constant value allows folding of subscripted array element
+  // references, LBOUND, and UBOUND without having to thread the named
+  // constant or its bounds throughout folding.
   const ConstantSubscripts &lbounds() const { return lbounds_; }
   ConstantSubscripts ComputeUbounds(std::optional<int> dim) const;
   void set_lbounds(ConstantSubscripts &&);
   void SetLowerBoundsToOne();
-  int Rank() const { return GetRank(shape_); }
-  Constant<SubscriptInteger> SHAPE() const;
+  bool HasNonDefaultLowerBound() const;
 
   // If no optional dimension order argument is passed, increments a vector of
   // subscripts in Fortran array order (first dimension varying most quickly).
   // Otherwise, increments the vector of subscripts according to the given
   // dimension order (dimension dimOrder[0] varying most quickly; dimension
   // indexing is zero based here). Returns false when last element was visited.
   bool IncrementSubscripts(
       ConstantSubscripts &, const std::vector<int> *dimOrder = nullptr) const;

flang/lib/Evaluate/constant.cpp

for (auto &n : lbounds_) {
     n = 1;
   }
 }
 
 Constant<SubscriptInteger> ConstantBounds::SHAPE() const {
   return AsConstantShape(shape_);
 }
 
+bool ConstantBounds::HasNonDefaultLowerBound() const {
+  for (auto n : lbounds_) {
+    if (n != 1) {
+      return true;
+    }
+  }
+  return false;
+}
+
 ConstantSubscript ConstantBounds::SubscriptsToOffset(
     const ConstantSubscripts &index) const {
   CHECK(GetRank(index) == GetRank(shape_));
   ConstantSubscript stride{1}, offset{0};
   int dim{0};
   for (auto j : index) {
     auto lb{lbounds_[dim]};
     auto extent{shape_[dim++]};

flang/lib/Evaluate/fold-implementation.h

 }
 
 template <typename T>
 std::optional<Constant<T>> Folder<T>::ApplyComponent(
     Constant<SomeDerived> &&structures, const Symbol &component,
     const std::vector<Constant<SubscriptInteger>> *subscripts) {
   if (auto scalar{structures.GetScalarValue()}) {
     if (std::optional<Expr<SomeType>> expr{scalar->Find(component)}) {
-      if (const Constant<T> *value{UnwrapConstantValue<T>(expr.value())}) {
-        if (!subscripts) {
-          return std::move(*value);
-        } else {
+      if (const Constant<T> *value{UnwrapConstantValue<T>(*expr)}) {
+        if (subscripts) {
           return ApplySubscripts(*value, *subscripts);
+        } else {
+          return *value;
         }
       }
     }
   } else {
     // A(:)%scalar_component & A(:)%array_component(subscripts)
     std::unique_ptr<ArrayConstructor<T>> array;
     if (structures.empty()) {
       return std::nullopt;

flang/lib/Evaluate/fold-integer.cpp

if (getLbound_) {
         }
       } else {
         return x.ComputeUbounds(dim_);
       }
     }
   }
 
   template <typename T> ConstantSubscripts Get(const Parentheses<T> &x) {
-    // Cause of temp variable inside parentheses - return [1, ... 1] for lower
+    // Case of temp variable inside parentheses - return [1, ... 1] for lower
     // bounds and shape for upper bounds
     if (getLbound_) {
       return ConstantSubscripts(x.Rank(), ConstantSubscript{1});
     } else {
       // Indicate that underlying array comes from parentheses expression.
       // Continue to unwrap expression until we hit a constant
       arrayFromParenthesesExpr = true;
       return Get(x.left());

flang/lib/Evaluate/formatting.cpp

 #include "flang/Evaluate/fold.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Parser/characters.h"
 #include "flang/Semantics/symbol.h"
 #include "llvm/Support/raw_ostream.h"
 
 namespace Fortran::evaluate {
 
-static void ShapeAsFortran(
-    llvm::raw_ostream &o, const ConstantSubscripts &shape) {
-  if (GetRank(shape) > 1) {
+static void ShapeAsFortran(llvm::raw_ostream &o,
+    const ConstantSubscripts &shape, const ConstantSubscripts &lbounds,
+    bool hasNonDefaultLowerBound) {
+  if (GetRank(shape) > 1 || hasNonDefaultLowerBound) {
     o << ",shape=";
     char ch{'['};
     for (auto dim : shape) {
       o << ch << dim;
       ch = ',';
     }
-    o << "])";
+    o << ']';
+    if (hasNonDefaultLowerBound) {
+      o << ",%lbound=";
+      ch = '[';
+      for (auto lb : lbounds) {
+        o << ch << lb;
+        ch = ',';
+      }
+      o << ']';
+    }
+    o << ')';
   }
 }
 
 template <typename RESULT, typename VALUE>
 llvm::raw_ostream &ConstantBase<RESULT, VALUE>::AsFortran(
     llvm::raw_ostream &o) const {
-  if (Rank() > 1) {
+  bool hasNonDefaultLowerBound{HasNonDefaultLowerBound()};
+  if (Rank() > 1 || hasNonDefaultLowerBound) {
     o << "reshape(";
   }
   if (Rank() > 0) {
     o << '[' << GetType().AsFortran() << "::";
   }
   bool first{true};
   for (const auto &value : values_) {
     if (first) {
if constexpr (Result::category == TypeCategory::Integer) {
       }
     } else {
       StructureConstructor{result_.derivedTypeSpec(), value}.AsFortran(o);
     }
   }
   if (Rank() > 0) {
     o << ']';
   }
-  ShapeAsFortran(o, shape());
+  ShapeAsFortran(o, shape(), lbounds(), hasNonDefaultLowerBound);
   return o;
 }
 
 template <int KIND>
 llvm::raw_ostream &Constant<Type<TypeCategory::Character, KIND>>::AsFortran(
     llvm::raw_ostream &o) const {
-  if (Rank() > 1) {
+  bool hasNonDefaultLowerBound{HasNonDefaultLowerBound()};
+  if (Rank() > 1 || hasNonDefaultLowerBound) {
     o << "reshape(";
   }
   if (Rank() > 0) {
     o << '[' << GetType().AsFortran(std::to_string(length_)) << "::";
   }
   auto total{static_cast<ConstantSubscript>(size())};
   for (ConstantSubscript j{0}; j < total; ++j) {
     Scalar<Result> value{values_.substr(j * length_, length_)};
     if (j > 0) {
       o << ',';
     }
     if (Result::kind != 1) {
       o << Result::kind << '_';
     }
     o << parser::QuoteCharacterLiteral(value);
   }
   if (Rank() > 0) {
     o << ']';
   }
-  ShapeAsFortran(o, shape());
+  ShapeAsFortran(o, shape(), lbounds(), hasNonDefaultLowerBound);
   return o;
 }
 
 llvm::raw_ostream &ActualArgument::AssumedType::AsFortran(
     llvm::raw_ostream &o) const {
   return o << symbol_->name().ToString();
 }
 

flang/lib/Evaluate/shape.cpp

if (const auto *details{
                    symbol.detailsIf<semantics::AssocEntityDetails>()}) {
       if (assoc->rank()) { // SELECT RANK case
         const Symbol &resolved{ResolveAssociations(symbol)};
         if (IsDescriptor(resolved) && dimension_ < *assoc->rank()) {
           return ExtentExpr{DescriptorInquiry{std::move(base),
               DescriptorInquiry::Field::LowerBound, dimension_}};
         }
       } else {
-        auto exprLowerBound{((*this)(assoc->expr()))};
+        Result exprLowerBound{((*this)(assoc->expr()))};
         if (IsActuallyConstant(exprLowerBound)) {
           return std::move(exprLowerBound);
         } else {
           // If the lower bound of the associated entity is not resolved to
           // constant expression at the time of the association, it is unsafe
           // to re-evaluate it later in the associate construct. Statements
           // in-between may have modified its operands value.
           return ExtentExpr{DescriptorInquiry{std::move(base),
               DescriptorInquiry::Field::LowerBound, dimension_}};
         }
       }
     }
     if constexpr (LBOUND_SEMANTICS) {
       return Result{};
     } else {
       return Result{1};
     }
   }
 
-  Result operator()(const Symbol &symbol0) const {
-    return GetLowerBound(symbol0, NamedEntity{symbol0});
+  Result operator()(const Symbol &symbol) const {
+    return GetLowerBound(symbol, NamedEntity{symbol});
   }
 
   Result operator()(const Component &component) const {
     if (component.base().Rank() == 0) {
       return GetLowerBound(
           component.GetLastSymbol(), NamedEntity{common::Clone(component)});
     }
     return Result{1};
   }
 
+  template <typename T> Result operator()(const Expr<T> &expr) const {
+    if (const Symbol * whole{UnwrapWholeSymbolOrComponentDataRef(expr)}) {
+      return (*this)(*whole);
+    } else if constexpr (common::HasMember<Constant<T>, decltype(expr.u)>) {
+      if (const auto *con{std::get_if<Constant<T>>(&expr.u)}) {
+        ConstantSubscripts lb{con->lbounds()};
+        if (dimension_ < GetRank(lb)) {
+          return Result{lb[dimension_]};
+        }
+      } else { // operation
+        return Result{1};
+      }
+    } else {
+      return (*this)(expr.u);
+    }
+    if constexpr (LBOUND_SEMANTICS) {
+      return Result{};
+    } else {
+      return Result{1};
+    }
+  }
+
 private:
-  int dimension_;
+  int dimension_; // zero-based
   FoldingContext *context_{nullptr};
 };
 
 ExtentExpr GetRawLowerBound(const NamedEntity &base, int dimension) {
   return GetLowerBoundHelper<ExtentExpr, false>{dimension, nullptr}(base);
 }
 
 ExtentExpr GetRawLowerBound(
const Symbol &symbol{
       ResolveAssociationsExceptSelectRank(base.GetLastSymbol())};
   if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
     int rank{details->shape().Rank()};
     if (dimension < rank) {
       const semantics::ShapeSpec &shapeSpec{details->shape()[dimension]};
       if (auto ubound{GetExplicitUBOUND(context, shapeSpec)}) {
         return *ubound;
       } else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) {
-        return std::nullopt;
+        return std::nullopt; // UBOUND() folding replaces with -1
       } else if (auto lb{GetLBOUND(base, dimension)}) {
         return ComputeUpperBound(std::move(*lb), GetExtent(base, dimension));
       }
     }
   } else if (const auto *assoc{
                  symbol.detailsIf<semantics::AssocEntityDetails>()}) {
+    if (assoc->rank()) { // SELECT RANK case
+      const Symbol &resolved{ResolveAssociations(symbol)};
+      if (IsDescriptor(resolved) && dimension < *assoc->rank()) {
+        ExtentExpr lb{DescriptorInquiry{NamedEntity{base},
+            DescriptorInquiry::Field::LowerBound, dimension}};
+        ExtentExpr extent{DescriptorInquiry{
+            std::move(base), DescriptorInquiry::Field::Extent, dimension}};
+        return ComputeUpperBound(std::move(lb), std::move(extent));
+      }
+    } else if (assoc->expr()) {
       if (auto extent{GetAssociatedExtent(base, *assoc, dimension)}) {
         if (auto lb{GetLBOUND(base, dimension)}) {
           return ComputeUpperBound(std::move(*lb), std::move(extent));
         }
       }
     }
+  }
   return std::nullopt;
 }
 
 MaybeExtentExpr GetUBOUND(const NamedEntity &base, int dimension) {
   return GetUBOUND(nullptr, base, dimension);
 }
 
 MaybeExtentExpr GetUBOUND(
     FoldingContext &context, const NamedEntity &base, int dimension) {
   return Fold(context, GetUBOUND(&context, base, dimension));
 }
 
 static Shape GetUBOUNDs(FoldingContext *context, const NamedEntity &base) {
-  const Symbol &symbol{
-      ResolveAssociationsExceptSelectRank(base.GetLastSymbol())};
-  if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
-    Shape result;
-    int dim{0};
-    for (const auto &shapeSpec : details->shape()) {
-      if (auto ubound{GetExplicitUBOUND(context, shapeSpec)}) {
-        result.emplace_back(*ubound);
-      } else if (details->IsAssumedSize() && dim + 1 == base.Rank()) {
-        result.emplace_back(std::nullopt); // UBOUND folding replaces with -1
-      } else if (auto lb{GetLBOUND(base, dim)}) {
-        result.emplace_back(
-            ComputeUpperBound(std::move(*lb), GetExtent(base, dim)));
-      } else {
-        result.emplace_back(); // unknown
-      }
-      ++dim;
-    }
-    CHECK(GetRank(result) == symbol.Rank());
-    return result;
-  } else {
-    return std::move(GetShape(symbol).value());
-  }
+  int rank{base.Rank()};
+  for (int dim{0}; dim < rank; ++dim) {
+    result.emplace_back(GetUBOUND(context, base, dim));
 }
 
 Shape GetUBOUNDs(FoldingContext &context, const NamedEntity &base) {
   return Fold(context, GetUBOUNDs(&context, base));
 }
 
 Shape GetUBOUNDs(const NamedEntity &base) { return GetUBOUNDs(nullptr, base); }
 

flang/lib/Semantics/expression.cpp

return common::visit(
             return std::nullopt;
           },
       },
       std::move(dataRef.u));
 }
 
 void ExpressionAnalyzer::CheckConstantSubscripts(ArrayRef &ref) {
   // Fold subscript expressions and check for an empty triplet.
-  Shape lb{GetLBOUNDs(foldingContext_, ref.base())};
+  const Symbol &arraySymbol{ref.base().GetLastSymbol()};
+  Shape lb{GetLBOUNDs(foldingContext_, NamedEntity{arraySymbol})};
   CHECK(lb.size() >= ref.subscript().size());
-  Shape ub{GetUBOUNDs(foldingContext_, ref.base())};
+  Shape ub{GetUBOUNDs(foldingContext_, NamedEntity{arraySymbol})};
   CHECK(ub.size() >= ref.subscript().size());
   bool anyPossiblyEmptyDim{false};
   int dim{0};
   for (Subscript &ss : ref.subscript()) {
     if (Triplet * triplet{std::get_if<Triplet>(&ss.u)}) {
       auto expr{Fold(triplet->stride())};
       auto stride{ToInt64(expr)};
       triplet->set_stride(std::move(expr));

flang/lib/Semantics/resolve-names.cpp

if (const Scope * origTypeScope{origTypeSymbol.scope()}) {
       for (auto &pair : scope) {
         Symbol &comp{*pair.second};
         const Symbol &origComp{DEREF(FindInScope(*origTypeScope, comp.name()))};
         if (IsPointer(comp)) {
           if (auto *details{comp.detailsIf<ObjectEntityDetails>()}) {
             auto origDetails{origComp.get<ObjectEntityDetails>()};
             if (const MaybeExpr & init{origDetails.init()}) {
               SomeExpr newInit{*init};
-              MaybeExpr folded{
-                  evaluate::Fold(foldingContext, std::move(newInit))};
+              MaybeExpr folded{FoldExpr(std::move(newInit))};
               details->set_init(std::move(folded));
             }
           }
         }
       }
     }
   }
 }

flang/test/Lower/HLFIR/constant.f90

 ! CHECK:  %[[VAL_8:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1>
 ! CHECK:  hlfir.declare %[[VAL_5]](%[[VAL_8]]) typeparams %[[VAL_7]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "[[name]]"} : (!fir.ref<!fir.array<2x!fir.char<1,3>>>, !fir.shape<1>, index) -> (!fir.ref<!fir.array<2x!fir.char<1,3>>>, !fir.ref<!fir.array<2x!fir.char<1,3>>>)
 end subroutine
 
 ! CHECK-LABEL: func.func @_QPtest_constant_with_lower_bounds()
 subroutine test_constant_with_lower_bounds()
   integer, parameter :: i(-1:0, -1:0) = reshape([1,2,3,4], shape=[2,2])
   print *, i
-! CHECK:  %[[VAL_12:.*]] = fir.address_of(@_QQro[[name:.*]]) : !fir.ref<!fir.array<2x2xi32>>
-! CHECK:  %[[VAL_13:.*]] = arith.constant 2 : index
+! CHECK:  %[[VAL_12:.*]] = fir.address_of(@_QFtest_constant_with_lower_boundsECi) : !fir.ref<!fir.array<2x2xi32>>
+! CHECK:  %[[VAL_13:.*]] = arith.constant -1 : index
 ! CHECK:  %[[VAL_14:.*]] = arith.constant 2 : index
 ! CHECK:  %[[VAL_15:.*]] = arith.constant -1 : index
-! CHECK:  %[[VAL_16:.*]] = arith.constant -1 : index
-! CHECK:  %[[VAL_17:.*]] = fir.shape_shift %[[VAL_15]], %[[VAL_13]], %[[VAL_16]], %[[VAL_14]] : (index, index, index, index) -> !fir.shapeshift<2>
-! CHECK:  hlfir.declare %[[VAL_12]](%[[VAL_17]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro[[name]]"} : (!fir.ref<!fir.array<2x2xi32>>, !fir.shapeshift<2>) -> (!fir.box<!fir.array<2x2xi32>>, !fir.ref<!fir.array<2x2xi32>>)
+! CHECK:  %[[VAL_16:.*]] = arith.constant 2 : index
+! CHECK:  %[[VAL_17:.*]] = fir.shape_shift %[[VAL_13]], %[[VAL_14]], %[[VAL_15]], %[[VAL_16]] : (index, index, index, index) -> !fir.shapeshift<2>
+! CHECK:  hlfir.declare %[[VAL_12]](%[[VAL_17]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QFtest_constant_with_lower_boundsECi"} : (!fir.ref<!fir.array<2x2xi32>>, !fir.shapeshift<2>) -> (!fir.box<!fir.array<2x2xi32>>, !fir.ref<!fir.array<2x2xi32>>)
 end subroutine

flang/test/Semantics/associate02.f90

+! RUN: %flang_fc1 -fdebug-unparse  %s  2>&1 | FileCheck %s
+! Sometimes associations with named constants involving non-default
+! lower bounds expose those bounds to LBOUND()/UBOUND(), sometimes
+! they do not.
+subroutine s(n)
+  integer, intent(in) :: n
+  type t
+    real component(0:1,2:3)
+  end type
+  real, parameter :: abcd(2,2) = reshape([1.,2.,3.,4.], shape(abcd))
+  real, parameter :: namedConst1(-1:0,-2:-1) = abcd
+  type(t), parameter :: namedConst2 = t(abcd)
+  type(t), parameter :: namedConst3(2:3,3:4) = reshape([(namedConst2,j=1,size(namedConst3))], shape(namedConst3))
+!CHECK: PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+  print *, lbound(abcd), ubound(abcd), shape(abcd)
+!CHECK: PRINT *, [INTEGER(4)::-1_4,-2_4], [INTEGER(4)::0_4,-1_4], [INTEGER(4)::2_4,2_4]
+  print *, lbound(namedConst1), ubound(namedConst1), shape(namedConst1)
+!CHECK: PRINT *, [INTEGER(4)::0_4,2_4], [INTEGER(4)::1_4,3_4], [INTEGER(4)::2_4,2_4]
+  print *, lbound(namedConst2%component), ubound(namedConst2%component), shape(namedConst2%component)
+!CHECK: PRINT *, [INTEGER(4)::2_4,3_4], [INTEGER(4)::3_4,4_4], [INTEGER(4)::2_4,2_4]
+  print *, lbound(namedConst3), ubound(namedConst3), shape(namedConst3)
+!CHECK: PRINT *, [INTEGER(4)::0_4,2_4], [INTEGER(4)::1_4,3_4], [INTEGER(4)::2_4,2_4]
+  print *, lbound(namedConst3(n,n)%component), ubound(namedConst3(n,n)%component), shape(namedConst3(n,n)%component)
+!CHECK: PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+  print *, lbound(namedConst3%component(0,2)), ubound(namedConst3%component(0,2)), shape(namedConst3%component(0,2))
+  associate (a => abcd)
+!CHECK:  PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+    print *, lbound(a), ubound(a), shape(a)
+  end associate
+  associate (a => namedConst1)
+!CHECK:  PRINT *, [INTEGER(4)::-1_4,-2_4], [INTEGER(4)::0_4,-1_4], [INTEGER(4)::2_4,2_4]
+    print *, lbound(a), ubound(a), shape(a)
+  end associate
+  associate (a => (namedConst1))
+!CHECK:  PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+    print *, lbound(a), ubound(a), shape(a)
+  end associate
+  associate (a => namedConst1 * 2.)
+!CHECK:  PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+    print *, lbound(a), ubound(a), shape(a)
+  end associate
+  associate (a => namedConst2%component)
+!CHECK:  PRINT *, [INTEGER(4)::0_4,2_4], [INTEGER(4)::1_4,3_4], [INTEGER(4)::2_4,2_4]
+    print *, lbound(a), ubound(a), shape(a)
+  end associate
+  associate (a => (namedConst2%component))
+!CHECK:  PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+    print *, lbound(a), ubound(a), shape(a)
+  end associate
+  associate (a => namedConst2%component * 2.)
+!CHECK:  PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+    print *, lbound(a), ubound(a), shape(a)
+  end associate
+  associate (a => namedConst3)
+!CHECK:  PRINT *, [INTEGER(4)::2_4,3_4], [INTEGER(4)::3_4,4_4], [INTEGER(4)::2_4,2_4]
+    print *, lbound(a), ubound(a), shape(a)
+  end associate
+  associate (a => (namedConst3))
+!CHECK:  PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+    print *, lbound(a), ubound(a), shape(a)
+  end associate
+  associate (a => namedConst3(n,n)%component)
+!CHECK:  PRINT *, [INTEGER(4)::0_4,2_4], [INTEGER(4)::1_4,3_4], [INTEGER(4)::2_4,2_4]
+    print *, lbound(a), ubound(a), shape(a)
+  end associate
+  associate (a => (namedConst3(n,n)%component))
+!CHECK:  PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+    print *, lbound(a), ubound(a), shape(a)
+  end associate
+  associate (a => namedConst3(n,n)%component * 2.)
+!CHECK:  PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+    print *, lbound(a), ubound(a), shape(a)
+  end associate
+  associate (a => namedConst3%component(0,2))
+!CHECK: PRINT *, [INTEGER(4)::1_4,1_4], [INTEGER(4)::2_4,2_4], [INTEGER(4)::2_4,2_4]
+    print *, lbound(a), ubound(a), shape(a)
+  end associate
+end