[flang] LBOUND() edge case: empty dimension

[klausler]

Summary

LBOUND must return 1 for an empty dimension, no matter what
explicit expression might appear in a declaration or arrive in
a descriptor.

[jeanPerier]

LGTM

flang/docs/Extensions.md

* The name of the control variable in an implied DO loop in an array
   expression, but it will work, instead of being needlessly undefined.
 * If both the `COUNT=` and the `COUNT_MAX=` optional arguments are
   present on the same call to the intrinsic subroutine `SYSTEM_CLOCK`,
   we require that their types have the same integer kind, since the
   kind of these arguments is used to select the clock rate.
   In common with some other compilers, the clock is in milliseconds
   for kinds <= 4 and nanoseconds otherwise where the target system
   supports these rates.
+* If a dimension of a descriptor has zero extent in a call to
+  `CFI_section`, `CFI_setpointer` or `CFI_allocate`, the lower
+  bound on that dimension will be set to 1 for consistency with
+  the `LBOUND()` intrinsic function.
 
 ## Extensions, deletions, and legacy features supported by default
 
 * Tabs in source
 * `<>` as synonym for `.NE.` and `/=`
 * `$` and `@` as legal characters in names
 * Initialization in type declaration statements using `/values/`
 * Kind specification with `*`, e.g. `REAL*4`

flang/include/flang/Evaluate/shape.h

 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);
+//
+// GetRawLowerBound() returns a lower bound expression, which may
+// not be suitable for all purposes; specifically, it might not be invariant
+// in its scope, and it will not have been forced to 1 on an empty dimension.
+// GetLBOUND()'s result is safer, but it is optional because it does fail
+// in those circumstances.
+ExtentExpr GetRawLowerBound(const NamedEntity &, int dimension);
+ExtentExpr GetRawLowerBound(
+    FoldingContext &, const NamedEntity &, int dimension);
+MaybeExtentExpr GetLBOUND(const NamedEntity &, int dimension);
+MaybeExtentExpr GetLBOUND(FoldingContext &, const NamedEntity &, int dimension);
 MaybeExtentExpr GetUpperBound(const NamedEntity &, int dimension);
 MaybeExtentExpr GetUpperBound(
     FoldingContext &, const NamedEntity &, int dimension);
 MaybeExtentExpr ComputeUpperBound(ExtentExpr &&lower, MaybeExtentExpr &&extent);
 MaybeExtentExpr ComputeUpperBound(
     FoldingContext &, ExtentExpr &&lower, MaybeExtentExpr &&extent);
-Shape GetLowerBounds(const NamedEntity &);
-Shape GetLowerBounds(FoldingContext &, const NamedEntity &);
+Shape GetRawLowerBounds(const NamedEntity &);
+Shape GetRawLowerBounds(FoldingContext &, const NamedEntity &);
+Shape GetLBOUNDs(const NamedEntity &);
+Shape GetLBOUNDs(FoldingContext &, const NamedEntity &);
 Shape GetUpperBounds(const NamedEntity &);
 Shape GetUpperBounds(FoldingContext &, const NamedEntity &);
 MaybeExtentExpr GetExtent(const NamedEntity &, int dimension);
 MaybeExtentExpr GetExtent(FoldingContext &, const NamedEntity &, int dimension);
 MaybeExtentExpr GetExtent(
     const Subscript &, const NamedEntity &, int dimension);
 MaybeExtentExpr GetExtent(
     FoldingContext &, const Subscript &, const NamedEntity &, int dimension);

flang/include/flang/Runtime/descriptor.h

 class Dimension {
 public:
   SubscriptValue LowerBound() const { return raw_.lower_bound; }
   SubscriptValue Extent() const { return raw_.extent; }
   SubscriptValue UpperBound() const { return LowerBound() + Extent() - 1; }
   SubscriptValue ByteStride() const { return raw_.sm; }
 
   Dimension &SetBounds(SubscriptValue lower, SubscriptValue upper) {
+    if (upper >= lower) {
       raw_.lower_bound = lower;
-    raw_.extent = upper >= lower ? upper - lower + 1 : 0;
+      raw_.extent = upper - lower + 1;
+    } else {
+      raw_.lower_bound = 1;
+      raw_.extent = 0;
+    }
     return *this;
   }
+  // Do not use this API to cause the LB of an empty dimension
+  // to anything other than 1.  Use SetBounds() instead if you can.
   Dimension &SetLowerBound(SubscriptValue lower) {
     raw_.lower_bound = lower;
     return *this;
   }
   Dimension &SetUpperBound(SubscriptValue upper) {
     auto lower{raw_.lower_bound};
     raw_.extent = upper >= lower ? upper - lower + 1 : 0;
     return *this;

flang/lib/Evaluate/check-expression.cpp

if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&call.proc().u)}) {
     if (intrinsic->name == "kind" ||
         intrinsic->name == IntrinsicProcTable::InvalidName) {
       // kind is always a constant, and we avoid cascading errors by considering
       // invalid calls to intrinsics to be constant
       return true;
     } else if (intrinsic->name == "lbound" && call.arguments().size() == 1) {
       // LBOUND(x) without DIM=
       auto base{ExtractNamedEntity(call.arguments()[0]->UnwrapExpr())};
-      return base && IsConstantExprShape(GetLowerBounds(*base));
+      return base && IsConstantExprShape(GetLBOUNDs(*base));
     } else if (intrinsic->name == "ubound" && call.arguments().size() == 1) {
       // UBOUND(x) without DIM=
       auto base{ExtractNamedEntity(call.arguments()[0]->UnwrapExpr())};
       return base && IsConstantExprShape(GetUpperBounds(*base));
     } else if (intrinsic->name == "shape") {
       auto shape{GetShape(call.arguments()[0]->UnwrapExpr())};
       return shape && IsConstantExprShape(*shape);
     } else if (intrinsic->name == "size" && call.arguments().size() == 1) {
if (converted) {
         } else if (auto extents{AsConstantExtents(context, symTS->shape())}) {
           if (folded.Rank() == 0 && symRank == 0) {
             // symbol and constant are both scalars
             return {std::move(folded)};
           } else if (folded.Rank() == 0 && symRank > 0) {
             // expand the scalar constant to an array
             return ScalarConstantExpander{std::move(*extents),
                 AsConstantExtents(
-                    context, GetLowerBounds(context, NamedEntity{symbol}))}
+                    context, GetRawLowerBounds(context, NamedEntity{symbol}))}
                 .Expand(std::move(folded));
           } else if (auto resultShape{GetShape(context, folded)}) {
             if (CheckConformance(context.messages(), symTS->shape(),
                     *resultShape, CheckConformanceFlags::None,
                     "initialized object", "initialization expression")
                     .value_or(false /*fail if not known now to conform*/)) {
               // make a constant array with adjusted lower bounds
               return ArrayConstantBoundChanger{
-                  std::move(*AsConstantExtents(
-                      context, GetLowerBounds(context, NamedEntity{symbol})))}
+                  std::move(*AsConstantExtents(context,
+                      GetRawLowerBounds(context, NamedEntity{symbol})))}
                   .ChangeLbounds(std::move(folded));
             }
           }
         } else if (IsNamedConstant(symbol)) {
           if (IsExplicitShape(symbol)) {
             context.messages().Say(
                 "Named constant '%s' array must have constant shape"_err_en_US,
                 symbol.name());

flang/lib/Evaluate/constant.cpp

 ConstantBounds::ConstantBounds(ConstantSubscripts &&shape)
     : shape_(std::move(shape)), lbounds_(shape_.size(), 1) {}
 
 ConstantBounds::~ConstantBounds() = default;
 
 void ConstantBounds::set_lbounds(ConstantSubscripts &&lb) {
   CHECK(lb.size() == shape_.size());
   lbounds_ = std::move(lb);
+  for (std::size_t j{0}; j < shape_.size(); ++j) {
+    if (shape_[j] == 0) {
+      lbounds_[j] = 1;
+    }
+  }
 }
 
 void ConstantBounds::SetLowerBoundsToOne() {
   for (auto &n : lbounds_) {
     n = 1;
   }
 }
 

flang/lib/Evaluate/fold-designator.cpp

 }
 
 std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
     const ArrayRef &x, ConstantSubscript which) {
   const Symbol &array{x.base().GetLastSymbol()};
   if (auto type{DynamicType::From(array)}) {
     if (auto extents{GetConstantExtents(context_, array)}) {
       if (auto bytes{ToInt64(type->MeasureSizeInBytes(context_, true))}) {
-        Shape lbs{GetLowerBounds(context_, x.base())};
+        Shape lbs{GetLBOUNDs(context_, x.base())};
         if (auto lowerBounds{AsConstantExtents(context_, lbs)}) {
           std::optional<OffsetSymbol> result;
           if (!x.base().IsSymbol() &&
               x.base().GetComponent().base().Rank() > 0) {
             // A(:)%B(1) - apply elementNumber_ to base
             result = FoldDesignator(x.base(), which);
             which = 0;
           } else { // A(1)%B(:) - apply elementNumber_ to subscripts

 // Conversions of offset symbols (back) to Designators
 
 // Reconstructs subscripts.
 // "offset" is decremented in place to hold remaining component offset.
 static std::optional<ArrayRef> OffsetToArrayRef(FoldingContext &context,
     NamedEntity &&entity, const Shape &shape, const DynamicType &elementType,
     ConstantSubscript &offset) {
   auto extents{AsConstantExtents(context, shape)};
-  Shape lbs{GetLowerBounds(context, entity)};
+  Shape lbs{GetRawLowerBounds(context, entity)};
   auto lower{AsConstantExtents(context, lbs)};
   auto elementBytes{ToInt64(elementType.MeasureSizeInBytes(context, true))};
   if (!extents || !lower || !elementBytes || *elementBytes <= 0) {
     return std::nullopt;
   }
   int rank{GetRank(shape)};
   CHECK(extents->size() == static_cast<std::size_t>(rank) &&
       lower->size() == extents->size());

flang/lib/Evaluate/fold-integer.cpp

if (int rank{array->Rank()}; rank > 0) {
         }
       }
       bool lowerBoundsAreOne{true};
       if (auto named{ExtractNamedEntity(*array)}) {
         const Symbol &symbol{named->GetLastSymbol()};
         if (symbol.Rank() == rank) {
           lowerBoundsAreOne = false;
           if (dim) {
-            return Fold(context,
-                ConvertToType<T>(GetLowerBound(context, *named, *dim)));
+            if (auto lb{GetLBOUND(context, *named, *dim)}) {
+              return Fold(context, ConvertToType<T>(std::move(*lb)));
+            }
           } else if (auto extents{
-                         AsExtentArrayExpr(GetLowerBounds(context, *named))}) {
+                         AsExtentArrayExpr(GetLBOUNDs(context, *named))}) {
             return Fold(context,
                 ConvertToType<T>(Expr<ExtentType>{std::move(*extents)}));
           }
         } else {
           lowerBoundsAreOne = symbol.Rank() == 0; // LBOUND(array%component)
         }
       }
       if (IsActuallyConstant(*array)) {

flang/lib/Evaluate/fold.cpp

return std::visit(
             } else {
               return std::nullopt;
             }
           },
           [&](Triplet &triplet) -> std::optional<Constant<SubscriptInteger>> {
             auto lower{triplet.lower()}, upper{triplet.upper()};
             std::optional<ConstantSubscript> stride{ToInt64(triplet.stride())};
             if (!lower) {
-              lower = GetLowerBound(context, base, dim);
+              lower = GetLBOUND(context, base, dim);
             }
             if (!upper) {
-              upper =
-                  ComputeUpperBound(context, GetLowerBound(context, base, dim),
-                      GetExtent(context, base, dim));
+              if (auto lb{GetLBOUND(context, base, dim)}) {
+                upper = ComputeUpperBound(
+                    context, std::move(*lb), GetExtent(context, base, dim));
+              }
             }
             auto lbi{ToInt64(lower)}, ubi{ToInt64(upper)};
             if (lbi && ubi && stride && *stride != 0) {
               std::vector<SubscriptInteger::Scalar> values;
               while ((*stride > 0 && *lbi <= *ubi) ||
                   (*stride < 0 && *lbi >= *ubi)) {
                 values.emplace_back(*lbi);
                 *lbi += *stride;

flang/lib/Evaluate/shape.cpp

struct MyVisitor : public AnyTraverse<MyVisitor> {
     bool operator()(const ImpliedDoIndex &) { return true; }
   };
   return MyVisitor{}(expr);
 }
 
 // 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 traversal of their referents.
-class GetLowerBoundHelper : public Traverse<GetLowerBoundHelper, ExtentExpr> {
+template <typename RESULT, bool LBOUND_SEMANTICS>
+class GetLowerBoundHelper
+    : public Traverse<GetLowerBoundHelper<RESULT, LBOUND_SEMANTICS>, RESULT> {
 public:
-  using Result = ExtentExpr;
-  using Base = Traverse<GetLowerBoundHelper, ExtentExpr>;
+  using Result = RESULT;
+  using Base = Traverse<GetLowerBoundHelper, RESULT>;
   using Base::operator();
-  explicit GetLowerBoundHelper(int d) : Base{*this}, dimension_{d} {}
-  static ExtentExpr Default() { return ExtentExpr{1}; }
-  static ExtentExpr Combine(Result &&, Result &&) { return Default(); }
-  ExtentExpr operator()(const Symbol &);
-  ExtentExpr operator()(const Component &);
-
-private:
-  int dimension_;
-};
+  explicit GetLowerBoundHelper(int d, FoldingContext *context)
+      : Base{*this}, dimension_{d}, context_{context} {}
+  static Result Default() { return Result{1}; }
+  static Result Combine(Result &&, Result &&) {
+    // Operator results and array references always have lower bounds == 1
+    return Result{1};
+  }
 
-auto GetLowerBoundHelper::operator()(const Symbol &symbol0) -> Result {
+  Result operator()(const Symbol &symbol0) const {
     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_) {
-        const auto &bound{shapeSpec.lbound().GetExplicit()};
-        if (bound && IsScopeInvariantExpr(*bound)) {
-          return *bound;
-        } else if (IsDescriptor(symbol)) {
-          return ExtentExpr{DescriptorInquiry{NamedEntity{symbol0},
-              DescriptorInquiry::Field::LowerBound, dimension_}};
+    if (const auto *details{
+            symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
+      int rank{details->shape().Rank()};
+      if (dimension_ < rank) {
+        const semantics::ShapeSpec &shapeSpec{details->shape()[dimension_]};
+        if (shapeSpec.lbound().isExplicit()) {
+          if (const auto &lbound{shapeSpec.lbound().GetExplicit()}) {
+            if constexpr (LBOUND_SEMANTICS) {
+              bool ok{false};
+              auto lbValue{ToInt64(*lbound)};
+              if (dimension_ == rank - 1 && details->IsAssumedSize()) {
+                // last dimension of assumed-size dummy array: don't worry
+                // about handling an empty dimension
+                ok = IsScopeInvariantExpr(*lbound);
+              } else if (lbValue.value_or(0) == 1) {
+                // Lower bound is 1, regardless of extent
+                ok = true;
+              } else if (const auto &ubound{shapeSpec.ubound().GetExplicit()}) {
+                // If we can't prove that the dimension is nonempty,
+                // we must be conservative.
+                // TODO: simple symbolic math in expression rewriting to
+                // cope with cases like A(J:J)
+                if (context_) {
+                  auto extent{ToInt64(Fold(*context_,
+                      ExtentExpr{*ubound} - ExtentExpr{*lbound} +
+                          ExtentExpr{1}))};
+                  ok = extent && *extent > 0;
                 } else {
-          break;
+                  auto ubValue{ToInt64(*ubound)};
+                  ok = lbValue && ubValue && *lbValue <= *ubValue;
                 }
               }
+              return ok ? *lbound : Result{};
+            } else {
+              return *lbound;
+            }
+          } else {
+            return Result{1};
+          }
+        }
+        if (IsDescriptor(symbol)) {
+          return ExtentExpr{DescriptorInquiry{NamedEntity{symbol0},
+              DescriptorInquiry::Field::LowerBound, 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()) {
           return ExtentExpr{DescriptorInquiry{NamedEntity{symbol0},
               DescriptorInquiry::Field::LowerBound, dimension_}};
         }
       } else {
         return (*this)(assoc->expr());
       }
     }
-  return Default();
+    if constexpr (LBOUND_SEMANTICS) {
+      return Result{};
+    } else {
+      return Result{1};
+    }
   }
 
-auto GetLowerBoundHelper::operator()(const Component &component) -> Result {
+  Result operator()(const Component &component) const {
     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_) {
-          const auto &bound{shapeSpec.lbound().GetExplicit()};
-          if (bound && IsScopeInvariantExpr(*bound)) {
-            return *bound;
-          } else if (IsDescriptor(symbol)) {
-            return ExtentExpr{
-                DescriptorInquiry{NamedEntity{common::Clone(component)},
-                    DescriptorInquiry::Field::LowerBound, dimension_}};
-          } else {
-            break;
-          }
-        }
-      }
-    }
-  }
-  return Default();
+      return (*this)(component.GetLastSymbol());
+    return Result{1};
+
+private:
+  int dimension_;
+  FoldingContext *context_{nullptr};
+};
+
+ExtentExpr GetRawLowerBound(const NamedEntity &base, int dimension) {
+  return GetLowerBoundHelper<ExtentExpr, false>{dimension, nullptr}(base);
+
+ExtentExpr GetRawLowerBound(
+    FoldingContext &context, const NamedEntity &base, int dimension) {
+  return Fold(context,
+      GetLowerBoundHelper<ExtentExpr, false>{dimension, &context}(base));
+
+MaybeExtentExpr GetLBOUND(const NamedEntity &base, int dimension) {
+  return GetLowerBoundHelper<MaybeExtentExpr, true>{dimension, nullptr}(base);
+
+MaybeExtentExpr GetLBOUND(
+    FoldingContext &context, const NamedEntity &base, int dimension) {
+  return Fold(context,
+      GetLowerBoundHelper<MaybeExtentExpr, true>{dimension, &context}(base));
 }
 
-ExtentExpr GetLowerBound(const NamedEntity &base, int dimension) {
-  return GetLowerBoundHelper{dimension}(base);
+Shape GetRawLowerBounds(const NamedEntity &base) {
+  Shape result;
+  int rank{base.Rank()};
+  for (int dim{0}; dim < rank; ++dim) {
+    result.emplace_back(GetRawLowerBound(base, dim));
+  }
+  return result;
 }
 
-ExtentExpr GetLowerBound(
-    FoldingContext &context, const NamedEntity &base, int dimension) {
-  return Fold(context, GetLowerBound(base, dimension));
+Shape GetRawLowerBounds(FoldingContext &context, const NamedEntity &base) {
+  Shape result;
+  int rank{base.Rank()};
+  for (int dim{0}; dim < rank; ++dim) {
+    result.emplace_back(GetRawLowerBound(context, base, dim));
+  }
+  return result;
 }
 
-Shape GetLowerBounds(const NamedEntity &base) {
+Shape GetLBOUNDs(const NamedEntity &base) {
   Shape result;
   int rank{base.Rank()};
   for (int dim{0}; dim < rank; ++dim) {
-    result.emplace_back(GetLowerBound(base, dim));
+    result.emplace_back(GetLBOUND(base, dim));
   }
   return result;
 }
 
-Shape GetLowerBounds(FoldingContext &context, const NamedEntity &base) {
+Shape GetLBOUNDs(FoldingContext &context, const NamedEntity &base) {
   Shape result;
   int rank{base.Rank()};
   for (int dim{0}; dim < rank; ++dim) {
-    result.emplace_back(GetLowerBound(context, base, dim));
+    result.emplace_back(GetLBOUND(context, base, dim));
   }
   return result;
 }
 
 // If the upper and lower bounds are constant, return a constant expression for
 // the extent.  In particular, if the upper bound is less than the lower bound,
 // return zero.
 static MaybeExtentExpr GetNonNegativeExtent(
return std::visit(
       common::visitors{
           [&](const Triplet &triplet) -> MaybeExtentExpr {
             MaybeExtentExpr upper{triplet.upper()};
             if (!upper) {
               upper = GetUpperBound(base, dimension);
             }
             MaybeExtentExpr lower{triplet.lower()};
             if (!lower) {
-              lower = GetLowerBound(base, dimension);
+              lower = GetLBOUND(base, dimension);
             }
             return CountTrips(std::move(lower), std::move(upper),
                 MaybeExtentExpr{triplet.stride()});
           },
           [&](const IndirectSubscriptIntegerExpr &subs) -> MaybeExtentExpr {
             if (auto shape{GetShape(subs.value())}) {
               if (GetRank(*shape) > 0) {
                 CHECK(GetRank(*shape) == 1); // vector-valued subscript
if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
     int j{0};
     for (const auto &shapeSpec : details->shape()) {
       if (j++ == dimension) {
         const auto &bound{shapeSpec.ubound().GetExplicit()};
         if (bound && IsScopeInvariantExpr(*bound)) {
           return *bound;
         } else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) {
           break;
-        } else {
-          return ComputeUpperBound(
-              GetLowerBound(base, dimension), GetExtent(base, dimension));
+        } 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 (auto shape{GetShape(assoc->expr())}) {
       if (dimension < static_cast<int>(shape->size())) {
+        if (auto lb{GetLBOUND(base, dimension)}) {
           return ComputeUpperBound(
-            GetLowerBound(base, dimension), std::move(shape->at(dimension)));
+              std::move(*lb), std::move(shape->at(dimension)));
+        }
       }
     }
   }
   return std::nullopt;
 }
 
 MaybeExtentExpr GetUpperBound(
     FoldingContext &context, const NamedEntity &base, int dimension) {
   return Fold(context, GetUpperBound(base, dimension));
 }
 
 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()) {
       const auto &bound{shapeSpec.ubound().GetExplicit()};
       if (bound && IsScopeInvariantExpr(*bound)) {
         result.push_back(*bound);
       } else if (details->IsAssumedSize() && dim + 1 == base.Rank()) {
         result.emplace_back(std::nullopt); // UBOUND folding replaces with -1
-      } else {
+      } else if (auto lb{GetLBOUND(base, dim)}) {
         result.emplace_back(
-            ComputeUpperBound(GetLowerBound(base, dim), GetExtent(base, dim)));
+            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());
   }

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)),
+      bounds.emplace_back(
+          GetValue(std::make_optional(
+                       evaluate::GetRawLowerBound(foldingContext, entity, j)),
               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}));

flang/runtime/ISO_Fortran_binding.cpp

int CFI_allocate(CFI_cdesc_t *descriptor, const CFI_index_t lower_bounds[],
   }
   std::size_t rank{descriptor->rank};
   CFI_dim_t *dim{descriptor->dim};
   std::size_t byteSize{elem_len};
   for (std::size_t j{0}; j < rank; ++j, ++dim) {
     CFI_index_t lb{lower_bounds[j]};
     CFI_index_t ub{upper_bounds[j]};
     CFI_index_t extent{ub >= lb ? ub - lb + 1 : 0};
-    dim->lower_bound = lb;
+    dim->lower_bound = extent == 0 ? 1 : lb;
     dim->extent = extent;
     dim->sm = byteSize;
     byteSize *= extent;
   }
   void *p{std::malloc(byteSize)};
   if (!p && byteSize) {
     return CFI_ERROR_MEM_ALLOCATION;
   }
int CFI_section(CFI_cdesc_t *result, const CFI_cdesc_t *source,
   }
 
   // For zero-sized arrays, base_addr is processor-dependent (see 18.5.3).
   // We keep it on the source base_addr
   result->base_addr = isZeroSized ? source->base_addr : shiftedBaseAddr;
   resRank = 0;
   for (int j{0}; j < source->rank; ++j) {
     if (actualStride[j] != 0) {
-      result->dim[resRank].lower_bound = 0;
       result->dim[resRank].extent = extent[j];
+      result->dim[resRank].lower_bound = extent[j] == 0 ? 1
+          : lower_bounds                                ? lower_bounds[j]
+                         : source->dim[j].lower_bound;
       result->dim[resRank].sm = actualStride[j] * source->dim[j].sm;
       ++resRank;
     }
   }
   return CFI_SUCCESS;
 }
 
 int CFI_select_part(CFI_cdesc_t *result, const CFI_cdesc_t *source,
int CFI_setpointer(CFI_cdesc_t *result, const CFI_cdesc_t *source,
   if (IsAssumedSize(source)) {
     return CFI_INVALID_DESCRIPTOR;
   }
 
   const bool copySrcLB{!lower_bounds};
   result->base_addr = source->base_addr;
   if (source->base_addr) {
     for (int j{0}; j < result->rank; ++j) {
-      result->dim[j].extent = source->dim[j].extent;
+      CFI_index_t extent{source->dim[j].extent};
+      result->dim[j].extent = extent;
       result->dim[j].sm = source->dim[j].sm;
-      result->dim[j].lower_bound =
-          copySrcLB ? source->dim[j].lower_bound : lower_bounds[j];
+      result->dim[j].lower_bound = extent == 0 ? 1
+          : copySrcLB                          ? source->dim[j].lower_bound
+                                               : lower_bounds[j];
     }
   }
   return CFI_SUCCESS;
 }
 } // extern "C"
 } // namespace Fortran::ISO

flang/runtime/pointer.cpp

 void RTNAME(PointerAssociateLowerBounds)(Descriptor &pointer,
     const Descriptor &target, const Descriptor &lowerBounds) {
   pointer = target;
   pointer.raw().attribute = CFI_attribute_pointer;
   int rank{pointer.rank()};
   Terminator terminator{__FILE__, __LINE__};
   std::size_t boundElementBytes{lowerBounds.ElementBytes()};
   for (int j{0}; j < rank; ++j) {
-    pointer.GetDimension(j).SetLowerBound(
-        GetInt64(lowerBounds.ZeroBasedIndexedElement<const char>(j),
+    Dimension &dim{pointer.GetDimension(j)};
+    dim.SetLowerBound(dim.Extent() == 0
+            ? 1
+            : GetInt64(lowerBounds.ZeroBasedIndexedElement<const char>(j),
                   boundElementBytes, terminator));
   }
 }
 
 void RTNAME(PointerAssociateRemapping)(Descriptor &pointer,
     const Descriptor &target, const Descriptor &bounds, const char *sourceFile,
     int sourceLine) {
   pointer = target;
   pointer.raw().attribute = CFI_attribute_pointer;

flang/test/Evaluate/folding08.f90

 ! RUN: %python %S/test_folding.py %s %flang_fc1
 ! Test folding of LBOUND and UBOUND
 
 module m
- contains
-  function foo()
-    real :: foo(2:3,4:6)
-  end function
-  subroutine test(n1,a1,a2)
-    integer, intent(in) :: n1
-    real, intent(in) :: a1(0:n1), a2(0:*)
-    type :: t
-      real :: a
-    end type
-    type(t) :: ta(0:2)
-    character(len=2) :: ca(-1:1)
-    integer, parameter :: lba1(*) = lbound(a1)
-    logical, parameter :: test_lba1 = all(lba1 == [0])
-    integer, parameter :: lba2(*) = lbound(a2)
-    logical, parameter :: test_lba2 = all(lba2 == [0])
-    integer, parameter :: lbtadim = lbound(ta,1)
-    logical, parameter :: test_lbtadim = lbtadim == 0
-    integer, parameter :: ubtadim = ubound(ta,1)
-    logical, parameter :: test_ubtadim = ubtadim == 2
-    integer, parameter :: lbta1(*) = lbound(ta)
-    logical, parameter :: test_lbta1 = all(lbta1 == [0])
-    integer, parameter :: ubta1(*) = ubound(ta)
-    logical, parameter :: test_ubta1 = all(ubta1 == [2])
-    integer, parameter :: lbta2(*) = lbound(ta(:))
-    logical, parameter :: test_lbta2 = all(lbta2 == [1])
-    integer, parameter :: ubta2(*) = ubound(ta(:))
-    logical, parameter :: test_ubta2 = all(ubta2 == [3])
-    integer, parameter :: lbta3(*) = lbound(ta%a)
-    logical, parameter :: test_lbta3 = all(lbta3 == [1])
-    integer, parameter :: ubta3(*) = ubound(ta%a)
-    logical, parameter :: test_ubta3 = all(ubta3 == [3])
-    integer, parameter :: lbca1(*) = lbound(ca)
-    logical, parameter :: test_lbca1 = all(lbca1 == [-1])
-    integer, parameter :: ubca1(*) = ubound(ca)
-    logical, parameter :: test_ubca1 = all(ubca1 == [1])
-    integer, parameter :: lbca2(*) = lbound(ca(:)(1:1))
-    logical, parameter :: test_lbca2 = all(lbca2 == [1])
-    integer, parameter :: ubca2(*) = ubound(ca(:)(1:1))
-    logical, parameter :: test_ubca2 = all(ubca2 == [3])
-    integer, parameter :: lbfoo(*) = lbound(foo())
-    logical, parameter :: test_lbfoo = all(lbfoo == [1,1])
-    integer, parameter :: ubfoo(*) = ubound(foo())
-    logical, parameter :: test_ubfoo = all(ubfoo == [2,3])
+  real :: a3(42:52)
+  integer, parameter :: lba3(*) = lbound(a3)
+  logical, parameter :: test_lba3 = all(lba3 == [42])
+ contains
+  function foo()
+    real :: foo(2:3,4:6)
+  end function
+  subroutine test(n1,a1,a2)
+    integer, intent(in) :: n1
+    real, intent(in) :: a1(1:n1), a2(0:*)
+    integer, parameter :: lba1(*) = lbound(a1)
+    logical, parameter :: test_lba1 = all(lba1 == [1])
+    integer, parameter :: lba2(*) = lbound(a2)
+    logical, parameter :: test_lba2 = all(lba2 == [0])
   end subroutine
   subroutine test2
     real :: a(2:3,4:6)
     associate (b => a)
       block
         integer, parameter :: lbb(*) = lbound(b)
         logical, parameter :: test_lbb = all(lbb == [2,4])
         integer, parameter :: ubb(*) = ubound(b)