[flang][runtime] Fix another IsContiguous edge case (#69199)

A recent PR addressed zero and one element edge cases but did not cover
another case where the descriptors of arrays with more than two elements
may have byte strides that are not perfect multiples, like when creating
a descriptor for A(:, 1:1:2).

In general, the byte stride in a dimension is only meaningful if that
dimension has more than one element. Update IsContiguous and
CFI_is_contiguous to reflect that.

flang/include/flang/Runtime/descriptor.h

@@ -393,13 +393,17 @@ class Descriptor {
     bool stridesAreContiguous{true};
     for (int j{0}; j < leadingDimensions; ++j) {
       const Dimension &dim{GetDimension(j)};
-      stridesAreContiguous &= bytes == dim.ByteStride();
+      stridesAreContiguous &= (bytes == dim.ByteStride()) | (dim.Extent() == 1);
       bytes *= dim.Extent();
     }
     // One and zero element arrays are contiguous even if the descriptor
     // byte strides are not perfect multiples.
-    return stridesAreContiguous || bytes == 0 ||
-        bytes == static_cast<SubscriptValue>(ElementBytes());
+    // Arrays with more than 2 elements may also be contiguous even if a
+    // byte stride in one dimension is not a perfect multiple, as long as
+    // this is the last dimension, or if the dimension has one extent and
+    // the following dimension have either one extents or contiguous byte
+    // strides.
+    return stridesAreContiguous || bytes == 0;
   }
 
   // Establishes a pointer to a section or element.

flang/runtime/ISO_Fortran_binding.cpp

@@ -125,16 +125,15 @@ RT_API_ATTRS int CFI_establish(CFI_cdesc_t *descriptor, void *base_addr,
 }
 
 RT_API_ATTRS int CFI_is_contiguous(const CFI_cdesc_t *descriptor) {
+  // See Descriptor::IsContiguous for the rationale.
   bool stridesAreContiguous{true};
   CFI_index_t bytes = descriptor->elem_len;
   for (int j{0}; j < descriptor->rank; ++j) {
-    stridesAreContiguous &= bytes == descriptor->dim[j].sm;
+    stridesAreContiguous &=
+        (bytes == descriptor->dim[j].sm) | (descriptor->dim[j].extent == 1);
     bytes *= descriptor->dim[j].extent;
   }
-  // One and zero element arrays are contiguous even if the descriptor
-  // byte strides are not perfect multiples.
-  if (stridesAreContiguous || bytes == 0 ||
-      bytes == static_cast<CFI_index_t>(descriptor->elem_len)) {
+  if (stridesAreContiguous || bytes == 0) {
     return 1;
   }
   return 0;

flang/unittests/Evaluate/ISO-Fortran-binding.cpp

@@ -736,6 +736,38 @@ static void run_CFI_is_contiguous_tests() {
   MATCH(true, retCode == CFI_SUCCESS);
   MATCH(true, CFI_is_contiguous(section) == 0);
   MATCH(false, sectionDesc->IsContiguous());
+
+  // Test section B = A(0:3:1,0:0:2) is contiguous.
+  lb[0] = 0;
+  lb[1] = 0;
+  ub[0] = 3;
+  ub[1] = 0;
+  strides[0] = 1;
+  strides[1] = 2;
+  retCode = CFI_section(section, dv, lb, ub, strides);
+  MATCH(true, retCode == CFI_SUCCESS);
+  MATCH(true, CFI_is_contiguous(section) == 1);
+  MATCH(true, sectionDesc->IsContiguous());
+
+  // INTEGER :: C(0:0, 0:3)
+  CFI_index_t c_extents[rank] = {1, 4};
+  CFI_CDESC_T(rank) c_dv_storage;
+  CFI_cdesc_t *cdv{&c_dv_storage};
+  retCode = CFI_establish(cdv, base_addr, CFI_attribute_other, CFI_type_int,
+      /*elem_len=*/0, rank, c_extents);
+  MATCH(retCode == CFI_SUCCESS, true);
+
+  // Test section B = C(0:0:2, 0:3:1) is contiguous.
+  lb[0] = 0;
+  lb[1] = 0;
+  ub[0] = 0;
+  ub[1] = 3;
+  strides[0] = 2;
+  strides[1] = 1;
+  retCode = CFI_section(section, cdv, lb, ub, strides);
+  MATCH(true, retCode == CFI_SUCCESS);
+  MATCH(true, CFI_is_contiguous(section) == 1);
+  MATCH(true, sectionDesc->IsContiguous());
 }
 
 int main() {