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

[Jean Perier via Phabricator via flang-commits]

This revision was automatically updated to reflect the committed changes.
Closed by commit rG479eed18503d: [flang][runtime] Ensure PointerDeallocate actually deallocate pointers (authored by jeanPerier).

Repository:
  rG LLVM Github Monorepo

CHANGES SINCE LAST ACTION
  https://reviews.llvm.org/D122492/new/

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.418516.patch
Type: text/x-patch
Size: 3378 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20220328/d1062ff9/attachment.bin>