[flang-commits] [PATCH] D122492: [flang][runtime] Ensure PointerDeallocate actually deallocate pointers

[Jean Perier via Phabricator via flang-commits]

jeanPerier created this revision.
jeanPerier added a reviewer: klausler.
jeanPerier added a project: Flang.
Herald added subscribers: jdoerfert, mgorny.
Herald added a reviewer: sscalpone.
Herald added a project: All.
jeanPerier requested review of this revision.

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.


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D122492

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


Index: flang/unittests/Runtime/Pointer.cpp
===================================================================
--- /dev/null
+++ 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));
+}
Index: flang/unittests/Runtime/CMakeLists.txt
===================================================================
--- flang/unittests/Runtime/CMakeLists.txt
+++ flang/unittests/Runtime/CMakeLists.txt
@@ -12,6 +12,7 @@
   Namelist.cpp
   Numeric.cpp
   NumericalFormatTest.cpp
+  Pointer.cpp
   Ragged.cpp
   Random.cpp
   Reduction.cpp
Index: flang/runtime/pointer.cpp
===================================================================
--- flang/runtime/pointer.cpp
+++ flang/runtime/pointer.cpp
@@ -141,7 +141,7 @@
   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) {
Index: flang/runtime/descriptor.cpp
===================================================================
--- flang/runtime/descriptor.cpp
+++ flang/runtime/descriptor.cpp
@@ -146,8 +146,8 @@
   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()}) {
Index: flang/include/flang/Runtime/descriptor.h
===================================================================
--- flang/include/flang/Runtime/descriptor.h
+++ flang/include/flang/Runtime/descriptor.h
@@ -347,7 +347,7 @@
 
   // 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())};


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D122492.418275.patch
Type: text/x-patch
Size: 3378 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20220325/1888173f/attachment.bin>