[flang][runtime] Add ragged array runtime functions

This patch adds the runtime function to allocate and
deallocate ragged arrays.

This patch is part of the upstreaming effort from fir-dev branch.

Reviewed By: klausler

Differential Revision: https://reviews.llvm.org/D114534

Co-authored-by: Eric Schweitz <[email protected]>

Conflicts resolved in favor of recent commit:
	flang/include/flang/Runtime/ragged.h
	flang/runtime/ragged.cpp

Author: clementval

flang/include/flang/Runtime/ragged.h

@@ -24,9 +24,13 @@ namespace Fortran::runtime {
 // By default, a header is set to zero, which is its unused state.
 // The layout of a ragged buffer header is mirrored in the compiler.
 struct RaggedArrayHeader {
-  std::uint64_t flags{0u};
+  bool indirection{false};
+  std::uint8_t rank;
   void *bufferPointer{nullptr};
   std::int64_t *extentPointer{nullptr};
+
+  bool isIndirection() { return indirection; }
+  std::uint8_t getRank() { return rank; }
 };
 
 RaggedArrayHeader *RaggedArrayAllocate(

flang/runtime/ragged.cpp

@@ -11,28 +11,21 @@
 
 namespace Fortran::runtime {
 
-inline bool isIndirection(const RaggedArrayHeader *const header) {
-  return header->flags & 1;
-}
-
-inline std::size_t rank(const RaggedArrayHeader *const header) {
-  return header->flags >> 1;
-}
-
 RaggedArrayHeader *RaggedArrayAllocate(RaggedArrayHeader *header, bool isHeader,
     std::int64_t rank, std::int64_t elementSize, std::int64_t *extentVector) {
   if (header && rank) {
-    std::int64_t size = 1;
+    std::int64_t size{1};
     for (std::int64_t counter{0}; counter < rank; ++counter) {
       size *= extentVector[counter];
       if (size <= 0) {
         return nullptr;
       }
     }
-    header->flags = (rank << 1) | isHeader;
+    header->indirection = isHeader;
+    header->rank = rank;
     header->extentPointer = extentVector;
     if (isHeader) {
-      header->bufferPointer = new RaggedArrayHeader[size];
+      header->bufferPointer = std::malloc(sizeof(RaggedArrayHeader) * size);
     } else {
       header->bufferPointer =
           static_cast<void *>(std::calloc(elementSize, size));
@@ -46,8 +39,8 @@ RaggedArrayHeader *RaggedArrayAllocate(RaggedArrayHeader *header, bool isHeader,
 // Deallocate a ragged array from the heap.
 void RaggedArrayDeallocate(RaggedArrayHeader *raggedArrayHeader) {
   if (raggedArrayHeader) {
-    if (std::size_t end{rank(raggedArrayHeader)}) {
-      if (isIndirection(raggedArrayHeader)) {
+    if (std::size_t end{raggedArrayHeader->getRank()}) {
+      if (raggedArrayHeader->isIndirection()) {
         std::size_t linearExtent{1u};
         for (std::size_t counter{0u}; counter < end && linearExtent > 0;
              ++counter) {
@@ -60,7 +53,8 @@ void RaggedArrayDeallocate(RaggedArrayHeader *raggedArrayHeader) {
       }
       std::free(raggedArrayHeader->bufferPointer);
       std::free(raggedArrayHeader->extentPointer);
-      raggedArrayHeader->flags = 0u;
+      raggedArrayHeader->indirection = false;
+      raggedArrayHeader->rank = 0u;
     }
   }
 }

flang/unittests/Runtime/CMakeLists.txt

@@ -11,6 +11,7 @@ add_flang_unittest(FlangRuntimeTests
   Namelist.cpp
   Numeric.cpp
   NumericalFormatTest.cpp
+  Ragged.cpp
   Random.cpp
   Reduction.cpp
   RuntimeCrashTest.cpp

flang/unittests/Runtime/Ragged.cpp

@@ -0,0 +1,33 @@
+//===-- flang/unittests/Runtime/Ragged.cpp ----------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Runtime/ragged.h"
+#include "gtest/gtest.h"
+
+using namespace Fortran::runtime;
+
+TEST(Ragged, RaggedArrayAllocateDeallocateTest) {
+  struct RaggedArrayHeader header;
+  unsigned rank = 2;
+  int64_t *extents = new int64_t[2];
+  extents[0] = 10;
+  extents[1] = 100;
+  RaggedArrayHeader *ret = (RaggedArrayHeader *)_FortranARaggedArrayAllocate(
+      &header, false, rank, 32, extents);
+  EXPECT_TRUE(ret != nullptr);
+  EXPECT_TRUE(ret->bufferPointer != nullptr);
+  EXPECT_EQ(extents, ret->extentPointer);
+  EXPECT_EQ(10, ret->extentPointer[0]);
+  EXPECT_EQ(100, ret->extentPointer[1]);
+  EXPECT_EQ(rank, ret->getRank());
+  EXPECT_FALSE(ret->isIndirection());
+
+  _FortranARaggedArrayDeallocate(ret);
+  EXPECT_EQ(0u, ret->getRank());
+  EXPECT_FALSE(ret->isIndirection());
+}