[flang] Fix crash on SELECT RANK

[klausler]

Summary

In some circumstances, such as in compile-time array shape analysis,
clients of the utility function ResolveAssociations() don't really
want it to drill all of the way down to an assumed-rank dummy argument.
Add a variation, ResolveAssociationsExceptSelectRank(), that
will return a specific rank case's AssocEntity symbol instead.
This fixes a crash in subscript validation checking that stemmed from
deducing an incorrect number of lower and upper bound expressions
from a specific rank case association entity.

flang/include/flang/Evaluate/tools.h

 // like GetUltimate(), but also resolves through whole variable associations
 // with ASSOCIATE(x => y) and related constructs.  GetAssociationRoot()
 // applies ResolveAssociations() and then, in the case of resolution to
 // a construct association with part of a variable that does not involve a
 // vector subscript, returns the first symbol of that variable instead
 // of the construct entity.
 // (E.g., for ASSOCIATE(x => y%z), ResolveAssociations(x) returns x,
 // while GetAssociationRoot(x) returns y.)
+// ResolveAssociationsExceptSelectRank() stops at a RANK case symbol.
 const Symbol &ResolveAssociations(const Symbol &);
 const Symbol &GetAssociationRoot(const Symbol &);
+const Symbol &ResolveAssociationsExceptSelectRank(const Symbol &);
 
 const Symbol *FindCommonBlockContaining(const Symbol &);
 int CountLenParameters(const DerivedTypeSpec &);
 int CountNonConstantLenParameters(const DerivedTypeSpec &);
 
 // 15.5.2.4(4), type compatibility for dummy and actual arguments.
 // Also used for assignment compatibility checking
 bool AreTypeParamCompatible(

flang/lib/Evaluate/shape.cpp

if (auto shape{GetShape(assoc.expr())}) {
     }
   }
   return std::nullopt;
 }
 
 MaybeExtentExpr GetExtent(const NamedEntity &base, int dimension) {
   CHECK(dimension >= 0);
   const Symbol &last{base.GetLastSymbol()};
-  const Symbol &symbol{ResolveAssociations(last)};
+  const Symbol &symbol{ResolveAssociationsExceptSelectRank(last)};
   if (const auto *assoc{last.detailsIf<semantics::AssocEntityDetails>()}) {
     if (assoc->rank()) { // SELECT RANK case
       if (semantics::IsDescriptor(symbol) && dimension < *assoc->rank()) {
         return ExtentExpr{DescriptorInquiry{
             NamedEntity{base}, DescriptorInquiry::Field::Extent, dimension}};
       }
     } else {
       return GetAssociatedExtent(base, *assoc, dimension);

 }
 
 MaybeExtentExpr ComputeUpperBound(
     FoldingContext &context, ExtentExpr &&lower, MaybeExtentExpr &&extent) {
   return Fold(context, ComputeUpperBound(std::move(lower), std::move(extent)));
 }
 
 MaybeExtentExpr GetRawUpperBound(const NamedEntity &base, int dimension) {
-  const Symbol &symbol{ResolveAssociations(base.GetLastSymbol())};
+  const Symbol &symbol{
+      ResolveAssociationsExceptSelectRank(base.GetLastSymbol())};
   if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
     int rank{details->shape().Rank()};
     if (dimension < rank) {
       const auto &bound{details->shape()[dimension].ubound().GetExplicit()};
       if (bound && IsScopeInvariantExpr(*bound)) {
         return *bound;
       } else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) {
         return std::nullopt;
if (auto extent{GetNonNegativeExtent(shapeSpec)}) {
       }
     }
   }
   return std::nullopt;
 }
 
 static MaybeExtentExpr GetUBOUND(
     FoldingContext *context, const NamedEntity &base, int dimension) {
-  const Symbol &symbol{ResolveAssociations(base.GetLastSymbol())};
+  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;

 }
 
 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{ResolveAssociations(base.GetLastSymbol())};
+  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

flang/lib/Evaluate/tools.cpp

const Symbol &ResolveAssociations(const Symbol &original) {
   if (const auto *details{symbol.detailsIf<AssocEntityDetails>()}) {
     if (const Symbol * nested{UnwrapWholeSymbolDataRef(details->expr())}) {
       return ResolveAssociations(*nested);
     }
   }
   return symbol;
 }
 
+const Symbol &ResolveAssociationsExceptSelectRank(const Symbol &original) {
+  const Symbol &symbol{original.GetUltimate()};
+  if (const auto *details{symbol.detailsIf<AssocEntityDetails>()}) {
+    if (!details->rank()) {
+      if (const Symbol * nested{UnwrapWholeSymbolDataRef(details->expr())}) {
+        return ResolveAssociations(*nested);
+      }
+    }
+  }
+  return symbol;
+}
+
 // When a construct association maps to a variable, and that variable
 // is not an array with a vector-valued subscript, return the base
 // Symbol of that variable, else nullptr.  Descends into other construct
 // associations when one associations maps to another.
 static const Symbol *GetAssociatedVariable(const AssocEntityDetails &details) {
   if (const auto &expr{details.expr()}) {
     if (IsVariable(*expr) && !HasVectorSubscript(*expr)) {
       if (const Symbol * varSymbol{GetFirstSymbol(*expr)}) {

flang/lib/Semantics/expression.cpp

return common::visit(
           },
       },
       std::move(dataRef.u));
 }
 
 void ExpressionAnalyzer::CheckConstantSubscripts(ArrayRef &ref) {
   // Fold subscript expressions and check for an empty triplet.
   Shape lb{GetLBOUNDs(foldingContext_, ref.base())};
+  CHECK(lb.size() >= ref.subscript().size());
   Shape ub{GetUBOUNDs(foldingContext_, ref.base())};
+  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));
       std::optional<ConstantSubscript> lower, upper;