unittests/Evaluate/ISO-Fortran-binding.cpp - llvm-project/flang - Git at Google

 #include "testing.h"
 #include "flang/ISO_Fortran_binding.h"
 #include "flang/Runtime/descriptor.h"
 #include "llvm/Support/raw_ostream.h"
 #include <type_traits>

 using namespace Fortran::runtime;
 using namespace Fortran::ISO;

 // CFI_CDESC_T test helpers
 template <int rank> class Test_CFI_CDESC_T {
 public:
   Test_CFI_CDESC_T() {}
   ~Test_CFI_CDESC_T() {}
   void Check() {
     // Test CFI_CDESC_T macro defined in section 18.5.4 of F2018 standard
     // CFI_CDESC_T must give storage that is:
     using type = decltype(dvStorage_);
     // unqualified
     MATCH(false, std::is_const<type>::value);
     MATCH(false, std::is_volatile<type>::value);
     // suitable in size
     if (rank > 0) {
       MATCH(sizeof(dvStorage_), Descriptor::SizeInBytes(rank_, false));
     } else { // C++ implementation over-allocates for rank=0 by 24bytes.
       MATCH(true, sizeof(dvStorage_) >= Descriptor::SizeInBytes(rank_, false));
     }
     // suitable in alignment
     MATCH(0,
         reinterpret_cast<std::uintptr_t>(&dvStorage_) &
             (alignof(CFI_cdesc_t) - 1));
   }

 private:
   static constexpr int rank_{rank};
   CFI_CDESC_T(rank) dvStorage_;
 };

 template <int rank> static void TestCdescMacroForAllRanksSmallerThan() {
   static_assert(rank > 0, "rank<0!");
   Test_CFI_CDESC_T<rank> obj;
   obj.Check();
   TestCdescMacroForAllRanksSmallerThan<rank - 1>();
 }

 template <> void TestCdescMacroForAllRanksSmallerThan<0>() {
   Test_CFI_CDESC_T<0> obj;
   obj.Check();
 }

 // CFI_establish test helper
 static void AddNoiseToCdesc(CFI_cdesc_t *dv, CFI_rank_t rank) {
   static const int trap{0};
   dv->rank = 16;
   // This address is not supposed to be used. Any write attempt should trigger
   // program termination
   dv->base_addr = const_cast<int *>(&trap);
   dv->elem_len = 320;
   dv->type = CFI_type_struct;
   dv->attribute = CFI_attribute_pointer;
   for (int i{0}; i < rank; i++) {
     dv->dim[i].extent = -42;
     dv->dim[i].lower_bound = -42;
     dv->dim[i].sm = -42;
   }
 }

 #ifdef VERBOSE
 static void DumpTestWorld(const void *bAddr, CFI_attribute_t attr,
     CFI_type_t ty, std::size_t eLen, CFI_rank_t rank,
     const CFI_index_t *eAddr) {
   llvm::outs() << " base_addr: ";
   llvm::outs().write_hex(reinterpret_cast<std::intptr_t>(bAddr))
       << " attribute: " << static_cast<int>(attr)
       << " type: " << static_cast<int>(ty) << " elem_len: " << eLen
       << " rank: " << static_cast<int>(rank) << " extent: ";
   llvm::outs().write_hex(reinterpret_cast<std::intptr_t>(eAddr)) << '\n';
   llvm::outs().flush();
 }
 #endif

 static void check_CFI_establish(CFI_cdesc_t *dv, void *base_addr,
     CFI_attribute_t attribute, CFI_type_t type, std::size_t elem_len,
     CFI_rank_t rank, const CFI_index_t extents[]) {
 #ifdef VERBOSE
   DumpTestWorld(base_addr, attribute, type, elem_len, rank, extent);
 #endif
   // CFI_establish reqs from F2018 section 18.5.5
   int retCode{
       CFI_establish(dv, base_addr, attribute, type, elem_len, rank, extents)};
   Descriptor *res{reinterpret_cast<Descriptor *>(dv)};
   if (retCode == CFI_SUCCESS) {
     res->Check();
     MATCH((attribute == CFI_attribute_pointer), res->IsPointer());
     MATCH((attribute == CFI_attribute_allocatable), res->IsAllocatable());
     MATCH(rank, res->rank());
     MATCH(reinterpret_cast<std::intptr_t>(dv->base_addr),
         reinterpret_cast<std::intptr_t>(base_addr));
     MATCH(true, dv->version == CFI_VERSION);
     if (base_addr != nullptr) {
       MATCH(true, res->IsContiguous());
       for (int i{0}; i < rank; ++i) {
         MATCH(extents[i], res->GetDimension(i).Extent());
       }
     }
     if (attribute == CFI_attribute_allocatable) {
       MATCH(res->IsAllocated(), false);
     }
     if (attribute == CFI_attribute_pointer) {
       if (base_addr != nullptr) {
         for (int i{0}; i < rank; ++i) {
           MATCH(0, res->GetDimension(i).LowerBound());
         }
       }
     }
     if (type == CFI_type_struct || type == CFI_type_char ||
         type == CFI_type_char16_t || type == CFI_type_char32_t ||
         type == CFI_type_other) {
       MATCH(elem_len, res->ElementBytes());
     }
   }
   // Checking failure/success according to combination of args forbidden by the
   // standard:
   int numErr{0};
   int expectedRetCode{CFI_SUCCESS};
   if (base_addr != nullptr && attribute == CFI_attribute_allocatable) {
     ++numErr;
     expectedRetCode = CFI_ERROR_BASE_ADDR_NOT_NULL;
   }
   if (rank > CFI_MAX_RANK) {
     ++numErr;
     expectedRetCode = CFI_INVALID_RANK;
   }
   if (type < 0 || type > CFI_TYPE_LAST) {
     ++numErr;
     expectedRetCode = CFI_INVALID_TYPE;
   }

   if ((type == CFI_type_struct || type == CFI_type_char ||
           type == CFI_type_char16_t || type == CFI_type_char32_t ||
           type == CFI_type_other) &&
       elem_len <= 0) {
     ++numErr;
     expectedRetCode = CFI_INVALID_ELEM_LEN;
   }
   if (rank > 0 && base_addr != nullptr && extents == nullptr) {
     ++numErr;
     expectedRetCode = CFI_INVALID_EXTENT;
   }
   if (numErr > 1) {
     MATCH(true, retCode != CFI_SUCCESS);
   } else {
     MATCH(retCode, expectedRetCode);
   }
 }

 static void run_CFI_establish_tests() {
   // Testing CFI_establish defined in section 18.5.5
   CFI_index_t extents[CFI_MAX_RANK];
   for (int i{0}; i < CFI_MAX_RANK; ++i) {
     extents[i] = i + 66;
   }
   CFI_CDESC_T(CFI_MAX_RANK) dv_storage;
   CFI_cdesc_t *dv{&dv_storage};
   char base;
   void *dummyAddr{&base};
   // Define test space
   CFI_attribute_t attrCases[]{
       CFI_attribute_pointer, CFI_attribute_allocatable, CFI_attribute_other};
   CFI_type_t typeCases[]{CFI_type_int, CFI_type_struct, CFI_type_double,
       CFI_type_char, CFI_type_char16_t, CFI_type_char32_t, CFI_type_other,
       CFI_TYPE_LAST + 1};
   CFI_index_t *extentCases[]{extents, nullptr};
   void *baseAddrCases[]{dummyAddr, nullptr};
   CFI_rank_t rankCases[]{0, 1, CFI_MAX_RANK, CFI_MAX_RANK + 1};
   std::size_t lenCases[]{0, 42};

   for (CFI_attribute_t attribute : attrCases) {
     for (void *base_addr : baseAddrCases) {
       for (CFI_index_t *extent : extentCases) {
         for (CFI_rank_t rank : rankCases) {
           for (CFI_type_t type : typeCases) {
             for (size_t elem_len : lenCases) {
               AddNoiseToCdesc(dv, CFI_MAX_RANK);
               check_CFI_establish(
                   dv, base_addr, attribute, type, elem_len, rank, extent);
             }
           }
         }
       }
     }
   }
   // If base_addr is null, extents shall be ignored even if rank !=0
   const int rank3d{3};
   CFI_CDESC_T(rank3d) dv3darrayStorage;
   CFI_cdesc_t *dv_3darray{&dv3darrayStorage};
   AddNoiseToCdesc(dv_3darray, rank3d); // => dv_3darray->dim[2].extent = -42
   check_CFI_establish(dv_3darray, nullptr, CFI_attribute_other, CFI_type_int, 4,
       rank3d, extents);
   MATCH(false,
       dv_3darray->dim[2].extent == 2 + 66); // extents was read
 }

 static void check_CFI_address(
     const CFI_cdesc_t *dv, const CFI_index_t subscripts[]) {
   // 18.5.5.2
   void *addr{CFI_address(dv, subscripts)};
   const Descriptor *desc{reinterpret_cast<const Descriptor *>(dv)};
   void *addrCheck{desc->Element<void>(subscripts)};
   MATCH(true, addr == addrCheck);
 }

 // Helper function to set lower bound of descriptor
 static void EstablishLowerBounds(CFI_cdesc_t *dv, CFI_index_t *sub) {
   for (int i{0}; i < dv->rank; ++i) {
     dv->dim[i].lower_bound = sub[i];
   }
 }

 // Helper to get size without making internal compiler functions accessible
 static std::size_t ByteSize(CFI_type_t ty, std::size_t size) {
   CFI_CDESC_T(0) storage;
   CFI_cdesc_t *dv{&storage};
   int retCode{
       CFI_establish(dv, nullptr, CFI_attribute_other, ty, size, 0, nullptr)};
   return retCode == CFI_SUCCESS ? dv->elem_len : 0;
 }

 static void run_CFI_address_tests() {
   // Test CFI_address defined in 18.5.5.2
   // Create test world
   CFI_index_t extents[CFI_MAX_RANK];
   CFI_CDESC_T(CFI_MAX_RANK) dv_storage;
   CFI_cdesc_t *dv{&dv_storage};
   char base;
   void *dummyAddr{&base};
   CFI_attribute_t attrCases[]{
       CFI_attribute_pointer, CFI_attribute_allocatable, CFI_attribute_other};
   CFI_type_t validTypeCases[]{
       CFI_type_int, CFI_type_struct, CFI_type_double, CFI_type_char};
   CFI_index_t subscripts[CFI_MAX_RANK];
   CFI_index_t negativeLowerBounds[CFI_MAX_RANK];
   CFI_index_t zeroLowerBounds[CFI_MAX_RANK];
   CFI_index_t positiveLowerBounds[CFI_MAX_RANK];
   CFI_index_t *lowerBoundCases[]{
       negativeLowerBounds, zeroLowerBounds, positiveLowerBounds};
   for (int i{0}; i < CFI_MAX_RANK; ++i) {
     negativeLowerBounds[i] = -1;
     zeroLowerBounds[i] = 0;
     positiveLowerBounds[i] = 1;
     extents[i] = i + 2;
     subscripts[i] = i + 1;
   }

   // test for scalar
   for (CFI_attribute_t attribute : attrCases) {
     for (CFI_type_t type : validTypeCases) {
       CFI_establish(dv, dummyAddr, attribute, type, 42, 0, nullptr);
       check_CFI_address(dv, nullptr);
     }
   }
   // test for arrays
   CFI_establish(dv, dummyAddr, CFI_attribute_other, CFI_type_int, 0,
       CFI_MAX_RANK, extents);
   for (CFI_index_t *lowerBounds : lowerBoundCases) {
     EstablishLowerBounds(dv, lowerBounds);
     for (CFI_type_t type : validTypeCases) {
       for (bool contiguous : {true, false}) {
         std::size_t size{ByteSize(type, 12)};
         dv->elem_len = size;
         for (int i{0}; i < dv->rank; ++i) {
           dv->dim[i].sm = size + (contiguous ? 0 : dv->elem_len);
           size = dv->dim[i].sm * dv->dim[i].extent;
         }
         for (CFI_attribute_t attribute : attrCases) {
           dv->attribute = attribute;
           check_CFI_address(dv, subscripts);
         }
       }
     }
   }
   // Test on an assumed size array.
   CFI_establish(
       dv, dummyAddr, CFI_attribute_other, CFI_type_int, 0, 3, extents);
   dv->dim[2].extent = -1;
   check_CFI_address(dv, subscripts);
 }

 static void check_CFI_allocate(CFI_cdesc_t *dv,
     const CFI_index_t lower_bounds[], const CFI_index_t upper_bounds[],
     std::size_t elem_len) {
   // 18.5.5.3
   // Backup descriptor data for future checks
   const CFI_rank_t rank{dv->rank};
   const std::size_t desc_elem_len{dv->elem_len};
   const CFI_attribute_t attribute{dv->attribute};
   const CFI_type_t type{dv->type};
   const void *base_addr{dv->base_addr};
   const int version{dv->version};
 #ifdef VERBOSE
   DumpTestWorld(base_addr, attribute, type, elem_len, rank, nullptr);
 #endif
   int retCode{CFI_allocate(dv, lower_bounds, upper_bounds, elem_len)};
   Descriptor *desc = reinterpret_cast<Descriptor *>(dv);
   if (retCode == CFI_SUCCESS) {
     // check res properties from 18.5.5.3 par 3
     MATCH(true, dv->base_addr != nullptr);
     for (int i{0}; i < rank; ++i) {
       MATCH(lower_bounds[i], dv->dim[i].lower_bound);
       MATCH(upper_bounds[i], dv->dim[i].extent + dv->dim[i].lower_bound - 1);
     }
     if (type == CFI_type_char) {
       MATCH(elem_len, dv->elem_len);
     } else {
       MATCH(true, desc_elem_len == dv->elem_len);
     }
     MATCH(true, desc->IsContiguous());
   } else {
     MATCH(true, base_addr == dv->base_addr);
   }

   // Below dv members shall not be altered by CFI_allocate regardless of
   // success/failure
   MATCH(true, attribute == dv->attribute);
   MATCH(true, rank == dv->rank);
   MATCH(true, type == dv->type);
   MATCH(true, version == dv->version);

   // Success/failure according to standard
   int numErr{0};
   int expectedRetCode{CFI_SUCCESS};
   if (rank > CFI_MAX_RANK) {
     ++numErr;
     expectedRetCode = CFI_INVALID_RANK;
   }
   if (type < 0 || type > CFI_TYPE_LAST) {
     ++numErr;
     expectedRetCode = CFI_INVALID_TYPE;
   }
   if (base_addr != nullptr && attribute == CFI_attribute_allocatable) {
     // This is less restrictive than 18.5.5.3 arg req for which pointers arg
     // shall be unassociated. However, this match ALLOCATE behavior
     // (9.7.3/9.7.4)
     ++numErr;
     expectedRetCode = CFI_ERROR_BASE_ADDR_NOT_NULL;
   }
   if (attribute != CFI_attribute_pointer &&
       attribute != CFI_attribute_allocatable) {
     ++numErr;
     expectedRetCode = CFI_INVALID_ATTRIBUTE;
   }
   if (rank > 0 && (lower_bounds == nullptr || upper_bounds == nullptr)) {
     ++numErr;
     expectedRetCode = CFI_INVALID_EXTENT;
   }

   // Memory allocation failures are unpredictable in this test.
   if (numErr == 0 && retCode != CFI_SUCCESS) {
     MATCH(true, retCode == CFI_ERROR_MEM_ALLOCATION);
   } else if (numErr > 1) {
     MATCH(true, retCode != CFI_SUCCESS);
   } else {
     MATCH(expectedRetCode, retCode);
   }
   // clean-up
   if (retCode == CFI_SUCCESS) {
     CFI_deallocate(dv);
   }
 }

 static void run_CFI_allocate_tests() {
   // 18.5.5.3
   // create test world
   CFI_CDESC_T(CFI_MAX_RANK) dv_storage;
   CFI_cdesc_t *dv{&dv_storage};
   char base;
   void *dummyAddr{&base};
   CFI_attribute_t attrCases[]{
       CFI_attribute_pointer, CFI_attribute_allocatable, CFI_attribute_other};
   CFI_type_t typeCases[]{CFI_type_int, CFI_type_struct, CFI_type_double,
       CFI_type_char, CFI_type_other, CFI_TYPE_LAST + 1};
   void *baseAddrCases[]{dummyAddr, nullptr};
   CFI_rank_t rankCases[]{0, 1, CFI_MAX_RANK, CFI_MAX_RANK + 1};
   std::size_t lenCases[]{0, 42};
   CFI_index_t lb1[CFI_MAX_RANK];
   CFI_index_t ub1[CFI_MAX_RANK];
   for (int i{0}; i < CFI_MAX_RANK; ++i) {
     lb1[i] = -1;
     ub1[i] = 0;
   }

   check_CFI_establish(
       dv, nullptr, CFI_attribute_other, CFI_type_int, 0, 0, nullptr);
   for (CFI_type_t type : typeCases) {
     std::size_t ty_len{ByteSize(type, 12)};
     for (CFI_attribute_t attribute : attrCases) {
       for (void *base_addr : baseAddrCases) {
         for (CFI_rank_t rank : rankCases) {
           for (size_t elem_len : lenCases) {
             dv->base_addr = base_addr;
             dv->rank = rank;
             dv->attribute = attribute;
             dv->type = type;
             dv->elem_len = ty_len;
             check_CFI_allocate(dv, lb1, ub1, elem_len);
           }
         }
       }
     }
   }
 }

 static void run_CFI_section_tests() {
   // simple tests
   bool testPreConditions{true};
   constexpr CFI_index_t m{5}, n{6}, o{7};
   constexpr CFI_rank_t rank{3};
   long long array[o][n][m]; // Fortran A(m,n,o)
   long long counter{1};

   for (CFI_index_t k{0}; k < o; ++k) {
     for (CFI_index_t j{0}; j < n; ++j) {
       for (CFI_index_t i{0}; i < m; ++i) {
         array[k][j][i] = counter++; // Fortran A(i,j,k)
       }
     }
   }
   CFI_CDESC_T(rank) sourceStorage;
   CFI_cdesc_t *source{&sourceStorage};
   CFI_index_t extent[rank] = {m, n, o};
   int retCode{CFI_establish(source, &array, CFI_attribute_other,
       CFI_type_long_long, 0, rank, extent)};
   testPreConditions &= (retCode == CFI_SUCCESS);

   CFI_index_t lb[rank] = {2, 5, 4};
   CFI_index_t ub[rank] = {4, 5, 6};
   CFI_index_t strides[rank] = {2, 0, 2};
   constexpr CFI_rank_t resultRank{rank - 1};

   CFI_CDESC_T(resultRank) resultStorage;
   CFI_cdesc_t *result{&resultStorage};
   retCode = CFI_establish(result, nullptr, CFI_attribute_other,
       CFI_type_long_long, 0, resultRank, nullptr);
   testPreConditions &= (retCode == CFI_SUCCESS);

   if (!testPreConditions) {
     MATCH(true, testPreConditions);
     return;
   }

   retCode = CFI_section(
       result, source, lb, ub, strides); // Fortran B = A(2:4:2, 5:5:0, 4:6:2)
   MATCH(true, retCode == CFI_SUCCESS);

   const CFI_index_t lbs0{source->dim[0].lower_bound};
   const CFI_index_t lbs1{source->dim[1].lower_bound};
   const CFI_index_t lbs2{source->dim[2].lower_bound};

   CFI_index_t resJ{result->dim[1].lower_bound};
   for (CFI_index_t k{lb[2]}; k <= ub[2]; k += strides[2]) {
     for (CFI_index_t j{lb[1]}; j <= ub[1]; j += strides[1] ? strides[1] : 1) {
       CFI_index_t resI{result->dim[0].lower_bound};
       for (CFI_index_t i{lb[0]}; i <= ub[0]; i += strides[0]) {
         // check A(i,j,k) == B(resI, resJ) == array[k-1][j-1][i-1]
         const CFI_index_t resSubcripts[]{resI, resJ};
         const CFI_index_t srcSubcripts[]{i, j, k};
         MATCH(true,
             CFI_address(source, srcSubcripts) ==
                 CFI_address(result, resSubcripts));
         MATCH(true,
             CFI_address(source, srcSubcripts) ==
                 &array[k - lbs2][j - lbs1][i - lbs0]);
         ++resI;
       }
     }
     ++resJ;
   }

   strides[0] = -1;
   lb[0] = 4;
   ub[0] = 2;
   retCode = CFI_section(
       result, source, lb, ub, strides); // Fortran B = A(4:2:-1, 5:5:0, 4:6:2)
   MATCH(true, retCode == CFI_SUCCESS);

   resJ = result->dim[1].lower_bound;
   for (CFI_index_t k{lb[2]}; k <= ub[2]; k += strides[2]) {
     for (CFI_index_t j{lb[1]}; j <= ub[1]; j += 1) {
       CFI_index_t resI{result->dim[1].lower_bound + result->dim[0].extent - 1};
       for (CFI_index_t i{2}; i <= 4; ++i) {
         // check A(i,j,k) == B(resI, resJ) == array[k-1][j-1][i-1]
         const CFI_index_t resSubcripts[]{resI, resJ};
         const CFI_index_t srcSubcripts[]{i, j, k};
         MATCH(true,
             CFI_address(source, srcSubcripts) ==
                 CFI_address(result, resSubcripts));
         MATCH(true,
             CFI_address(source, srcSubcripts) ==
                 &array[k - lbs2][j - lbs1][i - lbs0]);
         --resI;
       }
     }
     ++resJ;
   }
 }

 static void run_CFI_select_part_tests() {
   constexpr std::size_t name_len{5};
   typedef struct {
     double distance;
     int stars;
     char name[name_len];
   } Galaxy;

   const CFI_rank_t rank{2};
   constexpr CFI_index_t universeSize[]{2, 3};
   Galaxy universe[universeSize[1]][universeSize[0]];

   for (int i{0}; i < universeSize[1]; ++i) {
     for (int j{0}; j < universeSize[0]; ++j) {
       // Initializing Fortran var universe(j,i)
       universe[i][j].distance = j + i * 32;
       universe[i][j].stars = j * 2 + i * 64;
       universe[i][j].name[2] = static_cast<char>(j);
       universe[i][j].name[3] = static_cast<char>(i);
     }
   }

   CFI_CDESC_T(rank) resStorage, srcStorage;
   CFI_cdesc_t *result{&resStorage};
   CFI_cdesc_t *source{&srcStorage};

   bool testPreConditions{true};
   int retCode{CFI_establish(result, nullptr, CFI_attribute_other, CFI_type_int,
       sizeof(int), rank, nullptr)};
   testPreConditions &= (retCode == CFI_SUCCESS);
   retCode = CFI_establish(source, &universe, CFI_attribute_other,
       CFI_type_struct, sizeof(Galaxy), rank, universeSize);
   testPreConditions &= (retCode == CFI_SUCCESS);
   if (!testPreConditions) {
     MATCH(true, testPreConditions);
     return;
   }

   std::size_t displacement{offsetof(Galaxy, stars)};
   std::size_t elem_len{0}; // ignored
   retCode = CFI_select_part(result, source, displacement, elem_len);
   MATCH(CFI_SUCCESS, retCode);

   bool baseAddrShiftedOk{
       static_cast<char *>(source->base_addr) + displacement ==
       result->base_addr};
   MATCH(true, baseAddrShiftedOk);
   if (!baseAddrShiftedOk) {
     return;
   }

   MATCH(sizeof(int), result->elem_len);
   for (CFI_index_t j{0}; j < universeSize[1]; ++j) {
     for (CFI_index_t i{0}; i < universeSize[0]; ++i) {
       CFI_index_t subscripts[]{
           result->dim[0].lower_bound + i, result->dim[1].lower_bound + j};
       MATCH(
           i * 2 + j * 64, *static_cast<int *>(CFI_address(result, subscripts)));
     }
   }

   // Test for Fortran character type
   retCode = CFI_establish(
       result, nullptr, CFI_attribute_other, CFI_type_char, 2, rank, nullptr);
   testPreConditions &= (retCode == CFI_SUCCESS);
   if (!testPreConditions) {
     MATCH(true, testPreConditions);
     return;
   }

   displacement = offsetof(Galaxy, name) + 2;
   elem_len = 2; // not ignored this time
   retCode = CFI_select_part(result, source, displacement, elem_len);
   MATCH(CFI_SUCCESS, retCode);

   baseAddrShiftedOk = static_cast<char *>(source->base_addr) + displacement ==
       result->base_addr;
   MATCH(true, baseAddrShiftedOk);
   if (!baseAddrShiftedOk) {
     return;
   }

   MATCH(elem_len, result->elem_len);
   for (CFI_index_t j{0}; j < universeSize[1]; ++j) {
     for (CFI_index_t i{0}; i < universeSize[0]; ++i) {
       CFI_index_t subscripts[]{
           result->dim[0].lower_bound + i, result->dim[1].lower_bound + j};
       MATCH(static_cast<char>(i),
           static_cast<char *>(CFI_address(result, subscripts))[0]);
       MATCH(static_cast<char>(j),
           static_cast<char *>(CFI_address(result, subscripts))[1]);
     }
   }
 }

 static void run_CFI_setpointer_tests() {
   constexpr CFI_rank_t rank{3};
   CFI_CDESC_T(rank) resStorage, srcStorage;
   CFI_cdesc_t *result{&resStorage};
   CFI_cdesc_t *source{&srcStorage};
   CFI_index_t lower_bounds[rank];
   CFI_index_t extents[rank];
   for (int i{0}; i < rank; ++i) {
     lower_bounds[i] = i;
     extents[i] = 2;
   }

   char target;
   char *dummyBaseAddress{&target};
   bool testPreConditions{true};
   CFI_type_t type{CFI_type_int};
   std::size_t elem_len{ByteSize(type, 42)};
   int retCode{CFI_establish(
       result, nullptr, CFI_attribute_pointer, type, elem_len, rank, nullptr)};
   testPreConditions &= (retCode == CFI_SUCCESS);
   retCode = CFI_establish(source, dummyBaseAddress, CFI_attribute_other, type,
       elem_len, rank, extents);
   testPreConditions &= (retCode == CFI_SUCCESS);
   if (!testPreConditions) {
     MATCH(true, testPreConditions);
     return;
   }

   retCode = CFI_setpointer(result, source, lower_bounds);
   MATCH(CFI_SUCCESS, retCode);

   // The following members must be invariant
   MATCH(rank, result->rank);
   MATCH(elem_len, result->elem_len);
   MATCH(type, result->type);
   // check pointer association
   MATCH(true, result->base_addr == source->base_addr);
   for (int j{0}; j < rank; ++j) {
     MATCH(source->dim[j].extent, result->dim[j].extent);
     MATCH(source->dim[j].sm, result->dim[j].sm);
     MATCH(lower_bounds[j], result->dim[j].lower_bound);
   }
 }

 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_section_tests();
   run_CFI_select_part_tests();
   run_CFI_setpointer_tests();
   return testing::Complete();
 }
	#include "testing.h"
	#include "flang/ISO_Fortran_binding.h"
	#include "flang/Runtime/descriptor.h"
	#include "llvm/Support/raw_ostream.h"
	#include <type_traits>

	using namespace Fortran::runtime;
	using namespace Fortran::ISO;

	// CFI_CDESC_T test helpers
	template <int rank> class Test_CFI_CDESC_T {
	public:
	Test_CFI_CDESC_T() {}
	~Test_CFI_CDESC_T() {}
	void Check() {
	// Test CFI_CDESC_T macro defined in section 18.5.4 of F2018 standard
	// CFI_CDESC_T must give storage that is:
	using type = decltype(dvStorage_);
	// unqualified
	MATCH(false, std::is_const<type>::value);
	MATCH(false, std::is_volatile<type>::value);
	// suitable in size
	if (rank > 0) {
	MATCH(sizeof(dvStorage_), Descriptor::SizeInBytes(rank_, false));
	} else { // C++ implementation over-allocates for rank=0 by 24bytes.
	MATCH(true, sizeof(dvStorage_) >= Descriptor::SizeInBytes(rank_, false));
	}
	// suitable in alignment
	MATCH(0,
	reinterpret_cast<std::uintptr_t>(&dvStorage_) &
	(alignof(CFI_cdesc_t) - 1));
	}

	private:
	static constexpr int rank_{rank};
	CFI_CDESC_T(rank) dvStorage_;
	};

	template <int rank> static void TestCdescMacroForAllRanksSmallerThan() {
	static_assert(rank > 0, "rank<0!");
	Test_CFI_CDESC_T<rank> obj;
	obj.Check();
	TestCdescMacroForAllRanksSmallerThan<rank - 1>();
	}

	template <> void TestCdescMacroForAllRanksSmallerThan<0>() {
	Test_CFI_CDESC_T<0> obj;
	obj.Check();
	}

	// CFI_establish test helper
	static void AddNoiseToCdesc(CFI_cdesc_t *dv, CFI_rank_t rank) {
	static const int trap{0};
	dv->rank = 16;
	// This address is not supposed to be used. Any write attempt should trigger
	// program termination
	dv->base_addr = const_cast<int *>(&trap);
	dv->elem_len = 320;
	dv->type = CFI_type_struct;
	dv->attribute = CFI_attribute_pointer;
	for (int i{0}; i < rank; i++) {
	dv->dim[i].extent = -42;
	dv->dim[i].lower_bound = -42;
	dv->dim[i].sm = -42;
	}
	}

	#ifdef VERBOSE
	static void DumpTestWorld(const void *bAddr, CFI_attribute_t attr,
	CFI_type_t ty, std::size_t eLen, CFI_rank_t rank,
	const CFI_index_t *eAddr) {
	llvm::outs() << " base_addr: ";
	llvm::outs().write_hex(reinterpret_cast<std::intptr_t>(bAddr))
	<< " attribute: " << static_cast<int>(attr)
	<< " type: " << static_cast<int>(ty) << " elem_len: " << eLen
	<< " rank: " << static_cast<int>(rank) << " extent: ";
	llvm::outs().write_hex(reinterpret_cast<std::intptr_t>(eAddr)) << '\n';
	llvm::outs().flush();
	}
	#endif

	static void check_CFI_establish(CFI_cdesc_t dv, void base_addr,
	CFI_attribute_t attribute, CFI_type_t type, std::size_t elem_len,
	CFI_rank_t rank, const CFI_index_t extents[]) {
	#ifdef VERBOSE
	DumpTestWorld(base_addr, attribute, type, elem_len, rank, extent);
	#endif
	// CFI_establish reqs from F2018 section 18.5.5
	int retCode{
	CFI_establish(dv, base_addr, attribute, type, elem_len, rank, extents)};
	Descriptor res{reinterpret_cast<Descriptor >(dv)};
	if (retCode == CFI_SUCCESS) {
	res->Check();
	MATCH((attribute == CFI_attribute_pointer), res->IsPointer());
	MATCH((attribute == CFI_attribute_allocatable), res->IsAllocatable());
	MATCH(rank, res->rank());
	MATCH(reinterpret_cast<std::intptr_t>(dv->base_addr),
	reinterpret_cast<std::intptr_t>(base_addr));
	MATCH(true, dv->version == CFI_VERSION);
	if (base_addr != nullptr) {
	MATCH(true, res->IsContiguous());
	for (int i{0}; i < rank; ++i) {
	MATCH(extents[i], res->GetDimension(i).Extent());
	}
	}
	if (attribute == CFI_attribute_allocatable) {
	MATCH(res->IsAllocated(), false);
	}
	if (attribute == CFI_attribute_pointer) {
	if (base_addr != nullptr) {
	for (int i{0}; i < rank; ++i) {
	MATCH(0, res->GetDimension(i).LowerBound());
	}
	}
	}
	if (type == CFI_type_struct \|\| type == CFI_type_char \|\|
	type == CFI_type_char16_t \|\| type == CFI_type_char32_t \|\|
	type == CFI_type_other) {
	MATCH(elem_len, res->ElementBytes());
	}
	}
	// Checking failure/success according to combination of args forbidden by the
	// standard:
	int numErr{0};
	int expectedRetCode{CFI_SUCCESS};
	if (base_addr != nullptr && attribute == CFI_attribute_allocatable) {
	++numErr;
	expectedRetCode = CFI_ERROR_BASE_ADDR_NOT_NULL;
	}
	if (rank > CFI_MAX_RANK) {
	++numErr;
	expectedRetCode = CFI_INVALID_RANK;
	}
	if (type < 0 \|\| type > CFI_TYPE_LAST) {
	++numErr;
	expectedRetCode = CFI_INVALID_TYPE;
	}

	if ((type == CFI_type_struct \|\| type == CFI_type_char \|\|
	type == CFI_type_char16_t \|\| type == CFI_type_char32_t \|\|
	type == CFI_type_other) &&
	elem_len <= 0) {
	++numErr;
	expectedRetCode = CFI_INVALID_ELEM_LEN;
	}
	if (rank > 0 && base_addr != nullptr && extents == nullptr) {
	++numErr;
	expectedRetCode = CFI_INVALID_EXTENT;
	}
	if (numErr > 1) {
	MATCH(true, retCode != CFI_SUCCESS);
	} else {
	MATCH(retCode, expectedRetCode);
	}
	}

	static void run_CFI_establish_tests() {
	// Testing CFI_establish defined in section 18.5.5
	CFI_index_t extents[CFI_MAX_RANK];
	for (int i{0}; i < CFI_MAX_RANK; ++i) {
	extents[i] = i + 66;
	}
	CFI_CDESC_T(CFI_MAX_RANK) dv_storage;
	CFI_cdesc_t *dv{&dv_storage};
	char base;
	void *dummyAddr{&base};
	// Define test space
	CFI_attribute_t attrCases[]{
	CFI_attribute_pointer, CFI_attribute_allocatable, CFI_attribute_other};
	CFI_type_t typeCases[]{CFI_type_int, CFI_type_struct, CFI_type_double,
	CFI_type_char, CFI_type_char16_t, CFI_type_char32_t, CFI_type_other,
	CFI_TYPE_LAST + 1};
	CFI_index_t *extentCases[]{extents, nullptr};
	void *baseAddrCases[]{dummyAddr, nullptr};
	CFI_rank_t rankCases[]{0, 1, CFI_MAX_RANK, CFI_MAX_RANK + 1};
	std::size_t lenCases[]{0, 42};

	for (CFI_attribute_t attribute : attrCases) {
	for (void *base_addr : baseAddrCases) {
	for (CFI_index_t *extent : extentCases) {
	for (CFI_rank_t rank : rankCases) {
	for (CFI_type_t type : typeCases) {
	for (size_t elem_len : lenCases) {
	AddNoiseToCdesc(dv, CFI_MAX_RANK);
	check_CFI_establish(
	dv, base_addr, attribute, type, elem_len, rank, extent);
	}
	}
	}
	}
	}
	}
	// If base_addr is null, extents shall be ignored even if rank !=0
	const int rank3d{3};
	CFI_CDESC_T(rank3d) dv3darrayStorage;
	CFI_cdesc_t *dv_3darray{&dv3darrayStorage};
	AddNoiseToCdesc(dv_3darray, rank3d); // => dv_3darray->dim[2].extent = -42
	check_CFI_establish(dv_3darray, nullptr, CFI_attribute_other, CFI_type_int, 4,
	rank3d, extents);
	MATCH(false,
	dv_3darray->dim[2].extent == 2 + 66); // extents was read
	}

	static void check_CFI_address(
	const CFI_cdesc_t *dv, const CFI_index_t subscripts[]) {
	// 18.5.5.2
	void *addr{CFI_address(dv, subscripts)};
	const Descriptor desc{reinterpret_cast<const Descriptor >(dv)};
	void *addrCheck{desc->Element<void>(subscripts)};
	MATCH(true, addr == addrCheck);
	}

	// Helper function to set lower bound of descriptor
	static void EstablishLowerBounds(CFI_cdesc_t dv, CFI_index_t sub) {
	for (int i{0}; i < dv->rank; ++i) {
	dv->dim[i].lower_bound = sub[i];
	}
	}

	// Helper to get size without making internal compiler functions accessible
	static std::size_t ByteSize(CFI_type_t ty, std::size_t size) {
	CFI_CDESC_T(0) storage;
	CFI_cdesc_t *dv{&storage};
	int retCode{
	CFI_establish(dv, nullptr, CFI_attribute_other, ty, size, 0, nullptr)};
	return retCode == CFI_SUCCESS ? dv->elem_len : 0;
	}

	static void run_CFI_address_tests() {
	// Test CFI_address defined in 18.5.5.2
	// Create test world
	CFI_index_t extents[CFI_MAX_RANK];
	CFI_CDESC_T(CFI_MAX_RANK) dv_storage;
	CFI_cdesc_t *dv{&dv_storage};
	char base;
	void *dummyAddr{&base};
	CFI_attribute_t attrCases[]{
	CFI_attribute_pointer, CFI_attribute_allocatable, CFI_attribute_other};
	CFI_type_t validTypeCases[]{
	CFI_type_int, CFI_type_struct, CFI_type_double, CFI_type_char};
	CFI_index_t subscripts[CFI_MAX_RANK];
	CFI_index_t negativeLowerBounds[CFI_MAX_RANK];
	CFI_index_t zeroLowerBounds[CFI_MAX_RANK];
	CFI_index_t positiveLowerBounds[CFI_MAX_RANK];
	CFI_index_t *lowerBoundCases[]{
	negativeLowerBounds, zeroLowerBounds, positiveLowerBounds};
	for (int i{0}; i < CFI_MAX_RANK; ++i) {
	negativeLowerBounds[i] = -1;
	zeroLowerBounds[i] = 0;
	positiveLowerBounds[i] = 1;
	extents[i] = i + 2;
	subscripts[i] = i + 1;
	}

	// test for scalar
	for (CFI_attribute_t attribute : attrCases) {
	for (CFI_type_t type : validTypeCases) {
	CFI_establish(dv, dummyAddr, attribute, type, 42, 0, nullptr);
	check_CFI_address(dv, nullptr);
	}
	}
	// test for arrays
	CFI_establish(dv, dummyAddr, CFI_attribute_other, CFI_type_int, 0,
	CFI_MAX_RANK, extents);
	for (CFI_index_t *lowerBounds : lowerBoundCases) {
	EstablishLowerBounds(dv, lowerBounds);
	for (CFI_type_t type : validTypeCases) {
	for (bool contiguous : {true, false}) {
	std::size_t size{ByteSize(type, 12)};
	dv->elem_len = size;
	for (int i{0}; i < dv->rank; ++i) {
	dv->dim[i].sm = size + (contiguous ? 0 : dv->elem_len);
	size = dv->dim[i].sm * dv->dim[i].extent;
	}
	for (CFI_attribute_t attribute : attrCases) {
	dv->attribute = attribute;
	check_CFI_address(dv, subscripts);
	}
	}
	}
	}
	// Test on an assumed size array.
	CFI_establish(
	dv, dummyAddr, CFI_attribute_other, CFI_type_int, 0, 3, extents);
	dv->dim[2].extent = -1;
	check_CFI_address(dv, subscripts);
	}

	static void check_CFI_allocate(CFI_cdesc_t *dv,
	const CFI_index_t lower_bounds[], const CFI_index_t upper_bounds[],
	std::size_t elem_len) {
	// 18.5.5.3
	// Backup descriptor data for future checks
	const CFI_rank_t rank{dv->rank};
	const std::size_t desc_elem_len{dv->elem_len};
	const CFI_attribute_t attribute{dv->attribute};
	const CFI_type_t type{dv->type};
	const void *base_addr{dv->base_addr};
	const int version{dv->version};
	#ifdef VERBOSE
	DumpTestWorld(base_addr, attribute, type, elem_len, rank, nullptr);
	#endif
	int retCode{CFI_allocate(dv, lower_bounds, upper_bounds, elem_len)};
	Descriptor desc = reinterpret_cast<Descriptor >(dv);
	if (retCode == CFI_SUCCESS) {
	// check res properties from 18.5.5.3 par 3
	MATCH(true, dv->base_addr != nullptr);
	for (int i{0}; i < rank; ++i) {
	MATCH(lower_bounds[i], dv->dim[i].lower_bound);
	MATCH(upper_bounds[i], dv->dim[i].extent + dv->dim[i].lower_bound - 1);
	}
	if (type == CFI_type_char) {
	MATCH(elem_len, dv->elem_len);
	} else {
	MATCH(true, desc_elem_len == dv->elem_len);
	}
	MATCH(true, desc->IsContiguous());
	} else {
	MATCH(true, base_addr == dv->base_addr);
	}

	// Below dv members shall not be altered by CFI_allocate regardless of
	// success/failure
	MATCH(true, attribute == dv->attribute);
	MATCH(true, rank == dv->rank);
	MATCH(true, type == dv->type);
	MATCH(true, version == dv->version);

	// Success/failure according to standard
	int numErr{0};
	int expectedRetCode{CFI_SUCCESS};
	if (rank > CFI_MAX_RANK) {
	++numErr;
	expectedRetCode = CFI_INVALID_RANK;
	}
	if (type < 0 \|\| type > CFI_TYPE_LAST) {
	++numErr;
	expectedRetCode = CFI_INVALID_TYPE;
	}
	if (base_addr != nullptr && attribute == CFI_attribute_allocatable) {
	// This is less restrictive than 18.5.5.3 arg req for which pointers arg
	// shall be unassociated. However, this match ALLOCATE behavior
	// (9.7.3/9.7.4)
	++numErr;
	expectedRetCode = CFI_ERROR_BASE_ADDR_NOT_NULL;
	}
	if (attribute != CFI_attribute_pointer &&
	attribute != CFI_attribute_allocatable) {
	++numErr;
	expectedRetCode = CFI_INVALID_ATTRIBUTE;
	}
	if (rank > 0 && (lower_bounds == nullptr \|\| upper_bounds == nullptr)) {
	++numErr;
	expectedRetCode = CFI_INVALID_EXTENT;
	}

	// Memory allocation failures are unpredictable in this test.
	if (numErr == 0 && retCode != CFI_SUCCESS) {
	MATCH(true, retCode == CFI_ERROR_MEM_ALLOCATION);
	} else if (numErr > 1) {
	MATCH(true, retCode != CFI_SUCCESS);
	} else {
	MATCH(expectedRetCode, retCode);
	}
	// clean-up
	if (retCode == CFI_SUCCESS) {
	CFI_deallocate(dv);
	}
	}

	static void run_CFI_allocate_tests() {
	// 18.5.5.3
	// create test world
	CFI_CDESC_T(CFI_MAX_RANK) dv_storage;
	CFI_cdesc_t *dv{&dv_storage};
	char base;
	void *dummyAddr{&base};
	CFI_attribute_t attrCases[]{
	CFI_attribute_pointer, CFI_attribute_allocatable, CFI_attribute_other};
	CFI_type_t typeCases[]{CFI_type_int, CFI_type_struct, CFI_type_double,
	CFI_type_char, CFI_type_other, CFI_TYPE_LAST + 1};
	void *baseAddrCases[]{dummyAddr, nullptr};
	CFI_rank_t rankCases[]{0, 1, CFI_MAX_RANK, CFI_MAX_RANK + 1};
	std::size_t lenCases[]{0, 42};
	CFI_index_t lb1[CFI_MAX_RANK];
	CFI_index_t ub1[CFI_MAX_RANK];
	for (int i{0}; i < CFI_MAX_RANK; ++i) {
	lb1[i] = -1;
	ub1[i] = 0;
	}

	check_CFI_establish(
	dv, nullptr, CFI_attribute_other, CFI_type_int, 0, 0, nullptr);
	for (CFI_type_t type : typeCases) {
	std::size_t ty_len{ByteSize(type, 12)};
	for (CFI_attribute_t attribute : attrCases) {
	for (void *base_addr : baseAddrCases) {
	for (CFI_rank_t rank : rankCases) {
	for (size_t elem_len : lenCases) {
	dv->base_addr = base_addr;
	dv->rank = rank;
	dv->attribute = attribute;
	dv->type = type;
	dv->elem_len = ty_len;
	check_CFI_allocate(dv, lb1, ub1, elem_len);
	}
	}
	}
	}
	}
	}

	static void run_CFI_section_tests() {
	// simple tests
	bool testPreConditions{true};
	constexpr CFI_index_t m{5}, n{6}, o{7};
	constexpr CFI_rank_t rank{3};
	long long array[o][n][m]; // Fortran A(m,n,o)
	long long counter{1};

	for (CFI_index_t k{0}; k < o; ++k) {
	for (CFI_index_t j{0}; j < n; ++j) {
	for (CFI_index_t i{0}; i < m; ++i) {
	array[k][j][i] = counter++; // Fortran A(i,j,k)
	}
	}
	}
	CFI_CDESC_T(rank) sourceStorage;
	CFI_cdesc_t *source{&sourceStorage};
	CFI_index_t extent[rank] = {m, n, o};
	int retCode{CFI_establish(source, &array, CFI_attribute_other,
	CFI_type_long_long, 0, rank, extent)};
	testPreConditions &= (retCode == CFI_SUCCESS);

	CFI_index_t lb[rank] = {2, 5, 4};
	CFI_index_t ub[rank] = {4, 5, 6};
	CFI_index_t strides[rank] = {2, 0, 2};
	constexpr CFI_rank_t resultRank{rank - 1};

	CFI_CDESC_T(resultRank) resultStorage;
	CFI_cdesc_t *result{&resultStorage};
	retCode = CFI_establish(result, nullptr, CFI_attribute_other,
	CFI_type_long_long, 0, resultRank, nullptr);
	testPreConditions &= (retCode == CFI_SUCCESS);

	if (!testPreConditions) {
	MATCH(true, testPreConditions);
	return;
	}

	retCode = CFI_section(
	result, source, lb, ub, strides); // Fortran B = A(2:4:2, 5:5:0, 4:6:2)
	MATCH(true, retCode == CFI_SUCCESS);

	const CFI_index_t lbs0{source->dim[0].lower_bound};
	const CFI_index_t lbs1{source->dim[1].lower_bound};
	const CFI_index_t lbs2{source->dim[2].lower_bound};

	CFI_index_t resJ{result->dim[1].lower_bound};
	for (CFI_index_t k{lb[2]}; k <= ub[2]; k += strides[2]) {
	for (CFI_index_t j{lb[1]}; j <= ub[1]; j += strides[1] ? strides[1] : 1) {
	CFI_index_t resI{result->dim[0].lower_bound};
	for (CFI_index_t i{lb[0]}; i <= ub[0]; i += strides[0]) {
	// check A(i,j,k) == B(resI, resJ) == array[k-1][j-1][i-1]
	const CFI_index_t resSubcripts[]{resI, resJ};
	const CFI_index_t srcSubcripts[]{i, j, k};
	MATCH(true,
	CFI_address(source, srcSubcripts) ==
	CFI_address(result, resSubcripts));
	MATCH(true,
	CFI_address(source, srcSubcripts) ==
	&array[k - lbs2][j - lbs1][i - lbs0]);
	++resI;
	}
	}
	++resJ;
	}

	strides[0] = -1;
	lb[0] = 4;
	ub[0] = 2;
	retCode = CFI_section(
	result, source, lb, ub, strides); // Fortran B = A(4:2:-1, 5:5:0, 4:6:2)
	MATCH(true, retCode == CFI_SUCCESS);

	resJ = result->dim[1].lower_bound;
	for (CFI_index_t k{lb[2]}; k <= ub[2]; k += strides[2]) {
	for (CFI_index_t j{lb[1]}; j <= ub[1]; j += 1) {
	CFI_index_t resI{result->dim[1].lower_bound + result->dim[0].extent - 1};
	for (CFI_index_t i{2}; i <= 4; ++i) {
	// check A(i,j,k) == B(resI, resJ) == array[k-1][j-1][i-1]
	const CFI_index_t resSubcripts[]{resI, resJ};
	const CFI_index_t srcSubcripts[]{i, j, k};
	MATCH(true,
	CFI_address(source, srcSubcripts) ==
	CFI_address(result, resSubcripts));
	MATCH(true,
	CFI_address(source, srcSubcripts) ==
	&array[k - lbs2][j - lbs1][i - lbs0]);
	--resI;
	}
	}
	++resJ;
	}
	}

	static void run_CFI_select_part_tests() {
	constexpr std::size_t name_len{5};
	typedef struct {
	double distance;
	int stars;
	char name[name_len];
	} Galaxy;

	const CFI_rank_t rank{2};
	constexpr CFI_index_t universeSize[]{2, 3};
	Galaxy universe[universeSize[1]][universeSize[0]];

	for (int i{0}; i < universeSize[1]; ++i) {
	for (int j{0}; j < universeSize[0]; ++j) {
	// Initializing Fortran var universe(j,i)
	universe[i][j].distance = j + i * 32;
	universe[i][j].stars = j * 2 + i * 64;
	universe[i][j].name[2] = static_cast<char>(j);
	universe[i][j].name[3] = static_cast<char>(i);
	}
	}

	CFI_CDESC_T(rank) resStorage, srcStorage;
	CFI_cdesc_t *result{&resStorage};
	CFI_cdesc_t *source{&srcStorage};

	bool testPreConditions{true};
	int retCode{CFI_establish(result, nullptr, CFI_attribute_other, CFI_type_int,
	sizeof(int), rank, nullptr)};
	testPreConditions &= (retCode == CFI_SUCCESS);
	retCode = CFI_establish(source, &universe, CFI_attribute_other,
	CFI_type_struct, sizeof(Galaxy), rank, universeSize);
	testPreConditions &= (retCode == CFI_SUCCESS);
	if (!testPreConditions) {
	MATCH(true, testPreConditions);
	return;
	}

	std::size_t displacement{offsetof(Galaxy, stars)};
	std::size_t elem_len{0}; // ignored
	retCode = CFI_select_part(result, source, displacement, elem_len);
	MATCH(CFI_SUCCESS, retCode);

	bool baseAddrShiftedOk{
	static_cast<char *>(source->base_addr) + displacement ==
	result->base_addr};
	MATCH(true, baseAddrShiftedOk);
	if (!baseAddrShiftedOk) {
	return;
	}

	MATCH(sizeof(int), result->elem_len);
	for (CFI_index_t j{0}; j < universeSize[1]; ++j) {
	for (CFI_index_t i{0}; i < universeSize[0]; ++i) {
	CFI_index_t subscripts[]{
	result->dim[0].lower_bound + i, result->dim[1].lower_bound + j};
	MATCH(
	i * 2 + j * 64, static_cast<int >(CFI_address(result, subscripts)));
	}
	}

	// Test for Fortran character type
	retCode = CFI_establish(
	result, nullptr, CFI_attribute_other, CFI_type_char, 2, rank, nullptr);
	testPreConditions &= (retCode == CFI_SUCCESS);
	if (!testPreConditions) {
	MATCH(true, testPreConditions);
	return;
	}

	displacement = offsetof(Galaxy, name) + 2;
	elem_len = 2; // not ignored this time
	retCode = CFI_select_part(result, source, displacement, elem_len);
	MATCH(CFI_SUCCESS, retCode);

	baseAddrShiftedOk = static_cast<char *>(source->base_addr) + displacement ==
	result->base_addr;
	MATCH(true, baseAddrShiftedOk);
	if (!baseAddrShiftedOk) {
	return;
	}

	MATCH(elem_len, result->elem_len);
	for (CFI_index_t j{0}; j < universeSize[1]; ++j) {
	for (CFI_index_t i{0}; i < universeSize[0]; ++i) {
	CFI_index_t subscripts[]{
	result->dim[0].lower_bound + i, result->dim[1].lower_bound + j};
	MATCH(static_cast<char>(i),
	static_cast<char *>(CFI_address(result, subscripts))[0]);
	MATCH(static_cast<char>(j),
	static_cast<char *>(CFI_address(result, subscripts))[1]);
	}
	}
	}

	static void run_CFI_setpointer_tests() {
	constexpr CFI_rank_t rank{3};
	CFI_CDESC_T(rank) resStorage, srcStorage;
	CFI_cdesc_t *result{&resStorage};
	CFI_cdesc_t *source{&srcStorage};
	CFI_index_t lower_bounds[rank];
	CFI_index_t extents[rank];
	for (int i{0}; i < rank; ++i) {
	lower_bounds[i] = i;
	extents[i] = 2;
	}

	char target;
	char *dummyBaseAddress{&target};
	bool testPreConditions{true};
	CFI_type_t type{CFI_type_int};
	std::size_t elem_len{ByteSize(type, 42)};
	int retCode{CFI_establish(
	result, nullptr, CFI_attribute_pointer, type, elem_len, rank, nullptr)};
	testPreConditions &= (retCode == CFI_SUCCESS);
	retCode = CFI_establish(source, dummyBaseAddress, CFI_attribute_other, type,
	elem_len, rank, extents);
	testPreConditions &= (retCode == CFI_SUCCESS);
	if (!testPreConditions) {
	MATCH(true, testPreConditions);
	return;
	}

	retCode = CFI_setpointer(result, source, lower_bounds);
	MATCH(CFI_SUCCESS, retCode);

	// The following members must be invariant
	MATCH(rank, result->rank);
	MATCH(elem_len, result->elem_len);
	MATCH(type, result->type);
	// check pointer association
	MATCH(true, result->base_addr == source->base_addr);
	for (int j{0}; j < rank; ++j) {
	MATCH(source->dim[j].extent, result->dim[j].extent);
	MATCH(source->dim[j].sm, result->dim[j].sm);
	MATCH(lower_bounds[j], result->dim[j].lower_bound);
	}
	}

	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_section_tests();
	run_CFI_select_part_tests();
	run_CFI_setpointer_tests();
	return testing::Complete();
	}