[flang] Add implementation of move_alloc to the runtime

This patch adds a move_alloc implementation to the flang runtime.
Most of the checks required by the standard for move_alloc are
done by semenatic analysis; these checks are not replicated here.

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

2 files changed, 81 insertions, 0 deletions

diff --git a/flang/unittests/Runtime/Allocatable.cpp b/flang/unittests/Runtime/Allocatable.cpp
new file mode 100644
index 000000000000..bba501e40a71
--- /dev/null
+++ b/flang/unittests/Runtime/Allocatable.cpp
@@ -0,0 +1,80 @@
+//===-- flang/unittests/Runtime/Allocatable.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/allocatable.h"
+#include "gtest/gtest.h"
+#include "tools.h"
+#include "flang/Common/Fortran.h"
+#include "flang/ISO_Fortran_binding.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Support/InitFIR.h"
+#include "flang/Optimizer/Support/KindMapping.h"
+#include "flang/Runtime/descriptor.h"
+#include "flang/Runtime/memory.h"
+
+using namespace Fortran::runtime;
+
+static OwningPtr<Descriptor> createAllocatable(
+    Fortran::common::TypeCategory tc, int kind, int rank = 1) {
+  return Descriptor::Create(TypeCode{tc, kind}, kind, nullptr, rank, nullptr,
+      CFI_attribute_allocatable);
+}
+
+TEST(AllocatableTest, MoveAlloc) {
+  using Fortran::common::TypeCategory;
+  // INTEGER(4), ALLOCATABLE :: a(:)
+  auto a{createAllocatable(TypeCategory::Integer, 4)};
+  // INTEGER(4), ALLOCATABLE :: b(:)
+  auto b{createAllocatable(TypeCategory::Integer, 4)};
+  // ALLOCATE(a(20))
+  a->GetDimension(0).SetBounds(1, 20);
+  a->Allocate();
+
+  EXPECT_TRUE(a->IsAllocated());
+  EXPECT_FALSE(b->IsAllocated());
+
+  // Simple move_alloc
+  RTNAME(MoveAlloc)(*b, *a, false, nullptr, __FILE__, __LINE__);
+  EXPECT_FALSE(a->IsAllocated());
+  EXPECT_TRUE(b->IsAllocated());
+
+  // move_alloc with stat
+  std::int32_t stat{
+      RTNAME(MoveAlloc)(*a, *b, true, nullptr, __FILE__, __LINE__)};
+  EXPECT_TRUE(a->IsAllocated());
+  EXPECT_FALSE(b->IsAllocated());
+  EXPECT_EQ(stat, 0);
+
+  // move_alloc with errMsg
+  auto errMsg{Descriptor::Create(
+      sizeof(char), 64, nullptr, 0, nullptr, CFI_attribute_allocatable)};
+  errMsg->Allocate();
+  RTNAME(MoveAlloc)(*b, *a, false, errMsg.get(), __FILE__, __LINE__);
+  EXPECT_FALSE(a->IsAllocated());
+  EXPECT_TRUE(b->IsAllocated());
+
+  // move_alloc with stat and errMsg
+  stat = RTNAME(MoveAlloc)(*a, *b, true, errMsg.get(), __FILE__, __LINE__);
+  EXPECT_TRUE(a->IsAllocated());
+  EXPECT_FALSE(b->IsAllocated());
+  EXPECT_EQ(stat, 0);
+
+  // move_alloc with the same deallocated array
+  stat = RTNAME(MoveAlloc)(*b, *b, true, errMsg.get(), __FILE__, __LINE__);
+  EXPECT_FALSE(b->IsAllocated());
+  EXPECT_EQ(stat, 0);
+
+  // move_alloc with the same allocated array should fail
+  stat = RTNAME(MoveAlloc)(*a, *a, true, errMsg.get(), __FILE__, __LINE__);
+  EXPECT_EQ(stat, 18);
+  std::string_view errStr{errMsg->OffsetElement(), errMsg->ElementBytes()};
+  auto trim_pos = errStr.find_last_not_of(' ');
+  if (trim_pos != errStr.npos)
+    errStr.remove_suffix(errStr.size() - trim_pos - 1);
+  EXPECT_EQ(errStr, "Invalid descriptor");
+}
diff --git a/flang/unittests/Runtime/CMakeLists.txt b/flang/unittests/Runtime/CMakeLists.txt
index aa4eeccf789c..d7fc27d6b01f 100644
--- a/flang/unittests/Runtime/CMakeLists.txt
+++ b/flang/unittests/Runtime/CMakeLists.txt
@@ -1,4 +1,5 @@
 add_flang_unittest(FlangRuntimeTests
+  Allocatable.cpp
   BufferTest.cpp
   CharacterTest.cpp
   CommandTest.cpp