[flang][runtime] Fix another IsContiguous edge case

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() {