[flang] LBOUND() edge case: empty dimension

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

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

13 files changed, 229 insertions, 137 deletions

diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 4a038742ddb3..8b84045d2011 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -71,6 +71,10 @@ end
   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
 
diff --git a/flang/include/flang/Evaluate/shape.h b/flang/include/flang/Evaluate/shape.h
index 29b1bafff29b..2bf286f000ff 100644
--- a/flang/include/flang/Evaluate/shape.h
+++ b/flang/include/flang/Evaluate/shape.h
@@ -62,16 +62,27 @@ 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);
diff --git a/flang/include/flang/Runtime/descriptor.h b/flang/include/flang/Runtime/descriptor.h
index 9666f9c0422a..376d3bb95e65 100644
--- a/flang/include/flang/Runtime/descriptor.h
+++ b/flang/include/flang/Runtime/descriptor.h
@@ -50,10 +50,17 @@ public:
   SubscriptValue ByteStride() const { return raw_.sm; }
 
   Dimension &SetBounds(SubscriptValue lower, SubscriptValue upper) {
-    raw_.lower_bound = lower;
-    raw_.extent = upper >= lower ? upper - lower + 1 : 0;
+    if (upper >= lower) {
+      raw_.lower_bound = lower;
+      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;
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index e4423f8c300f..c780b51d7270 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -120,7 +120,7 @@ bool IsConstantExprHelper<INVARIANT>::operator()(
     } 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())};
@@ -434,7 +434,7 @@ std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
             // 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(),
@@ -443,8 +443,8 @@ std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
                     .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));
             }
           }
diff --git a/flang/lib/Evaluate/constant.cpp b/flang/lib/Evaluate/constant.cpp
index 9f2040ce8575..19c3c2aa913a 100644
--- a/flang/lib/Evaluate/constant.cpp
+++ b/flang/lib/Evaluate/constant.cpp
@@ -25,6 +25,11 @@ 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() {
diff --git a/flang/lib/Evaluate/fold-designator.cpp b/flang/lib/Evaluate/fold-designator.cpp
index 45ae691d4b84..f3e1cf40cb8a 100644
--- a/flang/lib/Evaluate/fold-designator.cpp
+++ b/flang/lib/Evaluate/fold-designator.cpp
@@ -50,7 +50,7 @@ std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
   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() &&
@@ -206,7 +206,7 @@ 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) {
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 53dfaf240c33..8dcb7c093469 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -76,10 +76,11 @@ Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
         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)}));
           }
diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp
index c6397e46c48e..f3c2e6ca1c56 100644
--- a/flang/lib/Evaluate/fold.cpp
+++ b/flang/lib/Evaluate/fold.cpp
@@ -36,12 +36,13 @@ std::optional<Constant<SubscriptInteger>> GetConstantSubscript(
             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) {
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index bb5e6ea4cd37..e8caf47abfd8 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -229,101 +229,151 @@ bool ContainsAnyImpliedDoIndex(const ExtentExpr &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 {
-  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)) {
+  Result operator()(const Symbol &symbol0) const {
+    const Symbol &symbol{symbol0.GetUltimate()};
+    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 {
+                  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 {
-          break;
         }
       }
-    }
-  } 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 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());
       }
+    }
+    if constexpr (LBOUND_SEMANTICS) {
+      return Result{};
     } else {
-      return (*this)(assoc->expr());
+      return Result{1};
     }
   }
-  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_) {
-          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;
-          }
-        }
-      }
+  Result operator()(const Component &component) const {
+    if (component.base().Rank() == 0) {
+      return (*this)(component.GetLastSymbol());
     }
+    return Result{1};
   }
-  return Default();
+
+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));
 }
 
-ExtentExpr GetLowerBound(const NamedEntity &base, int dimension) {
-  return GetLowerBoundHelper{dimension}(base);
+MaybeExtentExpr GetLBOUND(const NamedEntity &base, int dimension) {
+  return GetLowerBoundHelper<MaybeExtentExpr, true>{dimension, nullptr}(base);
 }
 
-ExtentExpr GetLowerBound(
+MaybeExtentExpr GetLBOUND(
     FoldingContext &context, const NamedEntity &base, int dimension) {
-  return Fold(context, GetLowerBound(base, dimension));
+  return Fold(context,
+      GetLowerBoundHelper<MaybeExtentExpr, true>{dimension, &context}(base));
 }
 
-Shape GetLowerBounds(const NamedEntity &base) {
+Shape GetRawLowerBounds(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(GetRawLowerBound(base, dim));
   }
   return result;
 }
 
-Shape GetLowerBounds(FoldingContext &context, const NamedEntity &base) {
+Shape GetRawLowerBounds(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(GetRawLowerBound(context, base, dim));
+  }
+  return result;
+}
+
+Shape GetLBOUNDs(const NamedEntity &base) {
+  Shape result;
+  int rank{base.Rank()};
+  for (int dim{0}; dim < rank; ++dim) {
+    result.emplace_back(GetLBOUND(base, dim));
+  }
+  return result;
+}
+
+Shape GetLBOUNDs(FoldingContext &context, const NamedEntity &base) {
+  Shape result;
+  int rank{base.Rank()};
+  for (int dim{0}; dim < rank; ++dim) {
+    result.emplace_back(GetLBOUND(context, base, dim));
   }
   return result;
 }
@@ -420,7 +470,7 @@ MaybeExtentExpr GetExtent(
             }
             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()});
@@ -472,9 +522,8 @@ MaybeExtentExpr GetUpperBound(const NamedEntity &base, int dimension) {
           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));
         }
       }
     }
@@ -482,8 +531,10 @@ MaybeExtentExpr GetUpperBound(const NamedEntity &base, int dimension) {
                  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)));
+        if (auto lb{GetLBOUND(base, dimension)}) {
+          return ComputeUpperBound(
+              std::move(*lb), std::move(shape->at(dimension)));
+        }
       }
     }
   }
@@ -506,9 +557,11 @@ Shape GetUpperBounds(const NamedEntity &base) {
         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;
     }
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index feda8da14c23..477ac7846813 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -794,9 +794,10 @@ evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
     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)),
-          parameters));
+      bounds.emplace_back(
+          GetValue(std::make_optional(
+                       evaluate::GetRawLowerBound(foldingContext, entity, j)),
+              parameters));
       bounds.emplace_back(GetValue(
           evaluate::GetUpperBound(foldingContext, entity, j), parameters));
     }
diff --git a/flang/runtime/ISO_Fortran_binding.cpp b/flang/runtime/ISO_Fortran_binding.cpp
index 1e5da86d8b4c..e4d8cc286cad 100644
--- a/flang/runtime/ISO_Fortran_binding.cpp
+++ b/flang/runtime/ISO_Fortran_binding.cpp
@@ -72,7 +72,7 @@ int CFI_allocate(CFI_cdesc_t *descriptor, const CFI_index_t lower_bounds[],
     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;
@@ -361,8 +361,10 @@ int CFI_section(CFI_cdesc_t *result, const CFI_cdesc_t *source,
   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;
     }
@@ -437,10 +439,12 @@ int CFI_setpointer(CFI_cdesc_t *result, const CFI_cdesc_t *source,
   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;
diff --git a/flang/runtime/pointer.cpp b/flang/runtime/pointer.cpp
index 8aebf1a60304..b396a04e1be8 100644
--- a/flang/runtime/pointer.cpp
+++ b/flang/runtime/pointer.cpp
@@ -76,9 +76,11 @@ void RTNAME(PointerAssociateLowerBounds)(Descriptor &pointer,
   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),
-            boundElementBytes, terminator));
+    Dimension &dim{pointer.GetDimension(j)};
+    dim.SetLowerBound(dim.Extent() == 0
+            ? 1
+            : GetInt64(lowerBounds.ZeroBasedIndexedElement<const char>(j),
+                  boundElementBytes, terminator));
   }
 }
 
diff --git a/flang/test/Evaluate/folding08.f90 b/flang/test/Evaluate/folding08.f90
index c64a9590f353..f00ec873a032 100644
--- a/flang/test/Evaluate/folding08.f90
+++ b/flang/test/Evaluate/folding08.f90
@@ -2,50 +2,53 @@
 ! Test folding of LBOUND and UBOUND
 
 module m
+  real :: a3(42:52)
+  integer, parameter :: lba3(*) = lbound(a3)
+  logical, parameter :: test_lba3 = all(lba3 == [42])
+  type :: t
+    real :: a
+  end type
+  type(t) :: ta(0:2)
+  character(len=2) :: ca(-1:1)
+  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])
  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)
+    real, intent(in) :: a1(1:n1), a2(0:*)
     integer, parameter :: lba1(*) = lbound(a1)
-    logical, parameter :: test_lba1 = all(lba1 == [0])
+    logical, parameter :: test_lba1 = all(lba1 == [1])
     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])
   end subroutine
   subroutine test2
     real :: a(2:3,4:6)