[flang-commits] [flang] [flang][runtime] Fix IsContiguous for zero and one element arrays (PR #68869)

[via flang-commits]

https://github.com/jeanPerier created https://github.com/llvm/llvm-project/pull/68869

The byte strides in zero and one element array descriptor may not be perfect multiple of the element size and previous and extents.

IsContiguous and its CFI equivalent should still return true for such arrays (Fortran 2018 standards says in 8.5.7 that an array is not contiguous if it has two or more elements and ....).

>From c8abee96325e1782b353396266f3dc8d5c6c3991 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Thu, 12 Oct 2023 02:31:36 -0700
Subject: [PATCH] [flang][runtime] Fix IsContiguous for zero and one element
 arrays

The byte strides in zero and one element array descriptor may not be
perfect multiple of the element size and previous and extents.

IsContiguous and its CFI equivalent should still return true for such
arrays (Fortran 2018 standards tells in 8.5.7 that an array is not
contiguous if it has two or more elements and ....).
---
 flang/include/flang/Runtime/descriptor.h      | 10 +-
 flang/runtime/ISO_Fortran_binding.cpp         | 13 ++-
 .../Evaluate/ISO-Fortran-binding.cpp          | 97 ++++++++++++++++++-
 3 files changed, 111 insertions(+), 9 deletions(-)

diff --git a/flang/include/flang/Runtime/descriptor.h b/flang/include/flang/Runtime/descriptor.h
index c9a3b1b0310077e..c69bb336dd29e7d 100644
--- a/flang/include/flang/Runtime/descriptor.h
+++ b/flang/include/flang/Runtime/descriptor.h
@@ -390,14 +390,16 @@ class Descriptor {
     if (leadingDimensions > raw_.rank) {
       leadingDimensions = raw_.rank;
     }
+    bool stridesAreContiguous{true};
     for (int j{0}; j < leadingDimensions; ++j) {
       const Dimension &dim{GetDimension(j)};
-      if (bytes != dim.ByteStride()) {
-        return false;
-      }
+      stridesAreContiguous &= bytes == dim.ByteStride();
       bytes *= dim.Extent();
     }
-    return true;
+    // 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());
   }
 
   // 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 15743be88d1beb0..103413cb7140aaa 100644
--- a/flang/runtime/ISO_Fortran_binding.cpp
+++ b/flang/runtime/ISO_Fortran_binding.cpp
@@ -125,14 +125,19 @@ 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) {
+  bool stridesAreContiguous{true};
   CFI_index_t bytes = descriptor->elem_len;
   for (int j{0}; j < descriptor->rank; ++j) {
-    if (bytes != descriptor->dim[j].sm) {
-      return 0;
-    }
+    stridesAreContiguous &= bytes == descriptor->dim[j].sm;
     bytes *= descriptor->dim[j].extent;
   }
-  return 1;
+  // 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)) {
+    return 1;
+  }
+  return 0;
 }
 
 RT_API_ATTRS int CFI_section(CFI_cdesc_t *result, const CFI_cdesc_t *source,
diff --git a/flang/unittests/Evaluate/ISO-Fortran-binding.cpp b/flang/unittests/Evaluate/ISO-Fortran-binding.cpp
index 09a51e6cea10b76..d1f0a31454056bf 100644
--- a/flang/unittests/Evaluate/ISO-Fortran-binding.cpp
+++ b/flang/unittests/Evaluate/ISO-Fortran-binding.cpp
@@ -643,13 +643,108 @@ static void run_CFI_setpointer_tests() {
   }
 }
 
+static void run_CFI_is_contiguous_tests() {
+  // INTEGER :: A(0:3,0:3)
+  constexpr CFI_rank_t rank{2};
+  CFI_index_t extents[rank] = {4, 4};
+  CFI_CDESC_T(rank) dv_storage;
+  CFI_cdesc_t *dv{&dv_storage};
+  Descriptor *dvDesc{reinterpret_cast<Descriptor *>(dv)};
+  char base;
+  void *base_addr{&base};
+  int retCode{CFI_establish(dv, base_addr, CFI_attribute_other, CFI_type_int,
+      /*elem_len=*/0, rank, extents)};
+  MATCH(retCode == CFI_SUCCESS, true);
+
+  MATCH(true, CFI_is_contiguous(dv) == 1);
+  MATCH(true, dvDesc->IsContiguous());
+
+  CFI_CDESC_T(rank) sectionDescriptorStorage;
+  CFI_cdesc_t *section{&sectionDescriptorStorage};
+  Descriptor *sectionDesc{reinterpret_cast<Descriptor *>(section)};
+  retCode = CFI_establish(section, base_addr, CFI_attribute_other, CFI_type_int,
+      /*elem_len=*/0, rank, extents);
+  MATCH(retCode == CFI_SUCCESS, true);
+
+  // Test empty section B = A(0:3:2,0:3:-2) is contiguous.
+  CFI_index_t lb[rank] = {0, 0};
+  CFI_index_t ub[rank] = {3, 3};
+  CFI_index_t strides[rank] = {2, -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());
+
+  // Test 1 element section B = A(0:1:2,0:1:2) is contiguous.
+  lb[0] = 0;
+  lb[1] = 0;
+  ub[0] = 1;
+  ub[1] = 1;
+  strides[0] = 2;
+  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());
+
+  // Test section B = A(0:3:1,0:2:1) is contiguous.
+  lb[0] = 0;
+  lb[1] = 0;
+  ub[0] = 3;
+  ub[1] = 2;
+  strides[0] = 1;
+  strides[1] = 1;
+  retCode = CFI_section(section, dv, lb, ub, strides);
+  sectionDesc->Dump();
+  MATCH(true, retCode == CFI_SUCCESS);
+  MATCH(true, CFI_is_contiguous(section) == 1);
+  MATCH(true, sectionDesc->IsContiguous());
+
+  // Test section B = A(0:2:1,0:2:1) is not contiguous.
+  lb[0] = 0;
+  lb[1] = 0;
+  ub[0] = 2;
+  ub[1] = 2;
+  strides[0] = 1;
+  strides[1] = 1;
+  retCode = CFI_section(section, dv, lb, ub, strides);
+  sectionDesc->Dump();
+  MATCH(true, retCode == CFI_SUCCESS);
+  MATCH(true, CFI_is_contiguous(section) == 0);
+  MATCH(false, sectionDesc->IsContiguous());
+
+  // Test section B = A(0:3:2,0:3:1) is not contiguous.
+  lb[0] = 0;
+  lb[1] = 0;
+  ub[0] = 3;
+  ub[1] = 3;
+  strides[0] = 2;
+  strides[1] = 1;
+  retCode = CFI_section(section, dv, lb, ub, strides);
+  MATCH(true, retCode == CFI_SUCCESS);
+  MATCH(true, CFI_is_contiguous(section) == 0);
+  MATCH(false, sectionDesc->IsContiguous());
+
+  // Test section B = A(0:3:1,0:3:2) is not contiguous.
+  lb[0] = 0;
+  lb[1] = 0;
+  ub[0] = 3;
+  ub[1] = 3;
+  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) == 0);
+  MATCH(false, sectionDesc->IsContiguous());
+}
+
 int main() {
   TestCdescMacroForAllRanksSmallerThan<CFI_MAX_RANK>();
   run_CFI_establish_tests();
   run_CFI_address_tests();
   run_CFI_allocate_tests();
   // TODO: test CFI_deallocate
-  // TODO: test CFI_is_contiguous
+  run_CFI_is_contiguous_tests();
   run_CFI_section_tests();
   run_CFI_select_part_tests();
   run_CFI_setpointer_tests();