Sync ragged array after upstreaming (#1326)

Author: clementval

flang/include/flang/Optimizer/Builder/FIRBuilder.h

@@ -493,7 +493,8 @@ void genRecordAssignment(fir::FirOpBuilder &builder, mlir::Location loc,
                          const fir::ExtendedValue &rhs);
 
 /// Builds and returns the type of a ragged array header used to cache mask
-/// evaluations.
+/// evaluations. RaggedArrayHeader is defined in
+/// flang/include/flang/Runtime/ragged.h.
 mlir::TupleType getRaggedArrayHeaderType(fir::FirOpBuilder &builder);
 
 /// Generate the, possibly dynamic, LEN of a CHARACTER. \p arrLoad determines

flang/include/flang/Runtime/ragged.h

@@ -19,14 +19,14 @@ namespace Fortran::runtime {
 // structure. It contains a pair in `flags` to indicate if the header points to
 // an array of headers (isIndirection) or data elements and the rank of the
 // pointed-to array. The rank is the length of the extents vector accessed
-// through `extentPointer`. The `bufferPointer` is overloaded and is null,
-// points to an array of headers (isIndirection), or data.
+// through `extentPointer`. The `bufferPointer` is overloaded
+// and is null, points to an array of headers (isIndirection), or data.
 // 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};
-  void *bufferPointer{nullptr};
-  std::int64_t *extentPointer{nullptr};
+  std::uint64_t flags;
+  void *bufferPointer;
+  std::int64_t *extentPointer;
 };
 
 RaggedArrayHeader *RaggedArrayAllocate(

flang/lib/Optimizer/Builder/FIRBuilder.cpp

@@ -1014,7 +1014,7 @@ void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder,
 
 mlir::TupleType
 fir::factory::getRaggedArrayHeaderType(fir::FirOpBuilder &builder) {
-  auto i64Ty = builder.getIntegerType(64);
+  mlir::IntegerType i64Ty = builder.getIntegerType(64);
   auto arrTy = fir::SequenceType::get(builder.getIntegerType(8), 1);
   auto buffTy = fir::HeapType::get(arrTy);
   auto extTy = fir::SequenceType::get(i64Ty, 1);

flang/lib/Optimizer/Builder/Runtime/Ragged.cpp

@@ -29,6 +29,7 @@ void fir::runtime::genRaggedArrayAllocate(mlir::Location loc,
       static_cast<fir::SequenceType::Extent>(rank)};
   auto extentTy = fir::SequenceType::get(shape, i64Ty);
   auto refTy = fir::ReferenceType::get(i64Ty);
+  // Position of the bufferPointer in the header struct.
   auto one = builder.createIntegerConstant(loc, i32Ty, 1);
   auto eleTy = fir::unwrapSequenceType(fir::unwrapRefType(header.getType()));
   auto ptrTy = builder.getRefType(eleTy.cast<mlir::TupleType>().getType(1));

flang/runtime/ragged.cpp

@@ -22,7 +22,7 @@ inline std::size_t rank(const RaggedArrayHeader *const header) {
 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) {
@@ -32,7 +32,7 @@ RaggedArrayHeader *RaggedArrayAllocate(RaggedArrayHeader *header, bool isHeader,
     header->flags = (rank << 1) | isHeader;
     header->extentPointer = extentVector;
     if (isHeader) {
-      header->bufferPointer = new RaggedArrayHeader[size];
+      header->bufferPointer = std::calloc(sizeof(RaggedArrayHeader), size);
     } else {
       header->bufferPointer =
           static_cast<void *>(std::calloc(elementSize, size));

flang/test/Lower/nested-where.f90

@@ -327,4 +327,3 @@ program nested_where
   ! CHECK:  return
   ! CHECK: }
 end program nested_where
-

flang/unittests/Optimizer/Builder/Runtime/RaggedTest.cpp

@@ -0,0 +1,36 @@
+//===- RaggedTest.cpp -- Ragged array runtime function builder unit tests -===//
+//
+// 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/Optimizer/Builder/Runtime/Ragged.h"
+#include "RuntimeCallTestBase.h"
+#include "gtest/gtest.h"
+
+TEST_F(RuntimeCallTest, genRaggedArrayAllocateTest) {
+  auto loc = firBuilder->getUnknownLoc();
+  mlir::TupleType headerTy =
+      fir::factory::getRaggedArrayHeaderType(*firBuilder);
+  mlir::Value header = firBuilder->create<fir::UndefOp>(loc, headerTy);
+  mlir::Value eleSize = firBuilder->createIntegerConstant(loc, i32Ty, 1);
+  mlir::Value extent = firBuilder->createIntegerConstant(loc, i32Ty, 1);
+  // Use a dummy header just to test the correctness of the generated call.
+  fir::runtime::genRaggedArrayAllocate(
+      loc, *firBuilder, header, false, eleSize, {extent});
+  checkCallOpFromResultBox(
+      eleSize, "_FortranARaggedArrayAllocate", 5, /*addLocArgs=*/false);
+}
+
+TEST_F(RuntimeCallTest, genRaggedArrayDeallocateTest) {
+  auto loc = firBuilder->getUnknownLoc();
+  mlir::TupleType headerTy =
+      fir::factory::getRaggedArrayHeaderType(*firBuilder);
+  // Use a dummy header just to test the correctness of the generated call.
+  mlir::Value header = firBuilder->create<fir::UndefOp>(loc, headerTy);
+  fir::runtime::genRaggedArrayDeallocate(loc, *firBuilder, header);
+  checkCallOpFromResultBox(
+      header, "_FortranARaggedArrayDeallocate", 1, /*addLocArgs=*/false);
+}

flang/unittests/Optimizer/CMakeLists.txt

@@ -14,6 +14,7 @@ add_flang_unittest(FlangOptimizerTests
   Builder/DoLoopHelperTest.cpp
   Builder/FIRBuilderTest.cpp
   Builder/Runtime/AssignTest.cpp
+  Builder/Runtime/RaggedTest.cpp
   Builder/Runtime/ReductionTest.cpp
   Builder/Runtime/TransformationalTest.cpp
   FIRContextTest.cpp

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,32 @@
+//===-- 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->flags >> 1);
+  EXPECT_FALSE(ret->flags & 1);
+
+  _FortranARaggedArrayDeallocate(ret);
+  EXPECT_EQ(0u, ret->flags);
+}