diff --git a/flang/include/flang/Runtime/descriptor.h b/flang/include/flang/Runtime/descriptor.h index c69bb336dd29e..85240353e8ae9 100644 --- a/flang/include/flang/Runtime/descriptor.h +++ b/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(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. diff --git a/flang/runtime/ISO_Fortran_binding.cpp b/flang/runtime/ISO_Fortran_binding.cpp index 103413cb7140a..c2e82758ae08a 100644 --- a/flang/runtime/ISO_Fortran_binding.cpp +++ b/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(descriptor->elem_len)) { + if (stridesAreContiguous || bytes == 0) { return 1; } return 0; diff --git a/flang/unittests/Evaluate/ISO-Fortran-binding.cpp b/flang/unittests/Evaluate/ISO-Fortran-binding.cpp index d1f0a31454056..3c98363f90046 100644 --- a/flang/unittests/Evaluate/ISO-Fortran-binding.cpp +++ b/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() {