[flang-commits] [flang] 479eed1 - [flang][runtime] Ensure PointerDeallocate actually deallocate pointers

[Jean Perier via flang-commits]

Author: Jean Perier
Date: 2022-03-28T10:22:08+02:00
New Revision: 479eed18503d1cf17fe9c0348cdb5f2968bc9969

URL: https://github.com/llvm/llvm-project/commit/479eed18503d1cf17fe9c0348cdb5f2968bc9969
DIFF: https://github.com/llvm/llvm-project/commit/479eed18503d1cf17fe9c0348cdb5f2968bc9969.diff

LOG: [flang][runtime] Ensure PointerDeallocate actually deallocate pointers

PointerDeallocate was silently doing nothing because it relied on
Destroy that doe not do anything for Pointers. Add an option to Destroy
in order to destroy pointers.

Add a unit test for PointerDeallocate.

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

Added: 
    flang/unittests/Runtime/Pointer.cpp

Modified: 
    flang/include/flang/Runtime/descriptor.h
    flang/runtime/descriptor.cpp
    flang/runtime/pointer.cpp
    flang/unittests/Runtime/CMakeLists.txt

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Runtime/descriptor.h b/flang/include/flang/Runtime/descriptor.h
index 349af69ee52da..3bae3ef893550 100644
--- a/flang/include/flang/Runtime/descriptor.h
+++ b/flang/include/flang/Runtime/descriptor.h
@@ -347,7 +347,7 @@ class Descriptor {
 
   // Deallocates storage, including allocatable and automatic
   // components.  Optionally invokes FINAL subroutines.
-  int Destroy(bool finalize = false);
+  int Destroy(bool finalize = false, bool destroyPointers = false);
 
   bool IsContiguous(int leadingDimensions = maxRank) const {
     auto bytes{static_cast<SubscriptValue>(ElementBytes())};

diff  --git a/flang/runtime/descriptor.cpp b/flang/runtime/descriptor.cpp
index d4f6de65965af..7f608c2336df0 100644
--- a/flang/runtime/descriptor.cpp
+++ b/flang/runtime/descriptor.cpp
@@ -146,8 +146,8 @@ int Descriptor::Allocate() {
   return 0;
 }
 
-int Descriptor::Destroy(bool finalize) {
-  if (raw_.attribute == CFI_attribute_pointer) {
+int Descriptor::Destroy(bool finalize, bool destroyPointers) {
+  if (!destroyPointers && raw_.attribute == CFI_attribute_pointer) {
     return StatOk;
   } else {
     if (auto *addendum{Addendum()}) {

diff  --git a/flang/runtime/pointer.cpp b/flang/runtime/pointer.cpp
index b396a04e1be84..7fcb90072e754 100644
--- a/flang/runtime/pointer.cpp
+++ b/flang/runtime/pointer.cpp
@@ -141,7 +141,7 @@ int RTNAME(PointerDeallocate)(Descriptor &pointer, bool hasStat,
   if (!pointer.IsAllocated()) {
     return ReturnError(terminator, StatBaseNull, errMsg, hasStat);
   }
-  return ReturnError(terminator, pointer.Destroy(true), errMsg, hasStat);
+  return ReturnError(terminator, pointer.Destroy(true, true), errMsg, hasStat);
 }
 
 bool RTNAME(PointerIsAssociated)(const Descriptor &pointer) {

diff  --git a/flang/unittests/Runtime/CMakeLists.txt b/flang/unittests/Runtime/CMakeLists.txt
index 370f13dc6de76..09de2ae09a7a8 100644
--- a/flang/unittests/Runtime/CMakeLists.txt
+++ b/flang/unittests/Runtime/CMakeLists.txt
@@ -12,6 +12,7 @@ add_flang_unittest(FlangRuntimeTests
   Namelist.cpp
   Numeric.cpp
   NumericalFormatTest.cpp
+  Pointer.cpp
   Ragged.cpp
   Random.cpp
   Reduction.cpp

diff  --git a/flang/unittests/Runtime/Pointer.cpp b/flang/unittests/Runtime/Pointer.cpp
new file mode 100644
index 0000000000000..72393f36aa9ad
--- /dev/null
+++ b/flang/unittests/Runtime/Pointer.cpp
@@ -0,0 +1,32 @@
+//===-- flang/unittests/Runtime/Pointer.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/pointer.h"
+#include "gtest/gtest.h"
+#include "tools.h"
+#include "flang/Runtime/descriptor.h"
+
+using namespace Fortran::runtime;
+
+TEST(Pointer, BasicAllocateDeallocate) {
+  // REAL(4), POINTER :: p(:)
+  auto p{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4}, 4,
+      nullptr, 1, nullptr, CFI_attribute_pointer)};
+  // ALLOCATE(p(2:11))
+  RTNAME(PointerSetBounds)(*p, 0, 2, 11);
+  RTNAME(PointerAllocate)
+  (*p, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);
+  EXPECT_TRUE(RTNAME(PointerIsAssociated)(*p));
+  EXPECT_EQ(p->Elements(), 10u);
+  EXPECT_EQ(p->GetDimension(0).LowerBound(), 2);
+  EXPECT_EQ(p->GetDimension(0).UpperBound(), 11);
+  // DEALLOCATE(p)
+  RTNAME(PointerDeallocate)
+  (*p, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);
+  EXPECT_FALSE(RTNAME(PointerIsAssociated)(*p));
+}