[flang-commits] [flang] 9ae4e1a - [flang] Do not perform INTERNAL_CHECK for deallocation of unlimited polymorphic with intrinsic type spec

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2023-01-18T18:54:44+01:00
New Revision: 9ae4e1aea5c894a4990575c237176af0d04b641c

URL: https://github.com/llvm/llvm-project/commit/9ae4e1aea5c894a4990575c237176af0d04b641c
DIFF: https://github.com/llvm/llvm-project/commit/9ae4e1aea5c894a4990575c237176af0d04b641c.diff

LOG: [flang] Do not perform INTERNAL_CHECK for deallocation of unlimited polymorphic with intrinsic type spec

When an unlimited polymorphic descriptor is establish for an intrinsic
type spec, the `PointerNullifyIntrinsic` or `AllocatableInitIntrinsic` runtime
function is called. These functions do not initialize an addendum with a derivedType.
When the deallocation on this descriptor is performed, the runtime should not
crash if the addendum is not present. This patch updates `PointerDeallocatePolymorphic`
and `AllocatableDeallocatePolymorphic` for this use case.

Depends on D141996

Reviewed By: jeanPerier, PeteSteinfeld

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

Added: 
    

Modified: 
    flang/runtime/allocatable.cpp
    flang/runtime/pointer.cpp
    flang/unittests/Runtime/Pointer.cpp

Removed: 
    


################################################################################
diff  --git a/flang/runtime/allocatable.cpp b/flang/runtime/allocatable.cpp
index d879420440fc..2e7e0e9acacf 100644
--- a/flang/runtime/allocatable.cpp
+++ b/flang/runtime/allocatable.cpp
@@ -151,8 +151,15 @@ int RTNAME(AllocatableDeallocatePolymorphic)(Descriptor &descriptor,
       descriptor, hasStat, errMsg, sourceFile, sourceLine)};
   if (stat == StatOk) {
     DescriptorAddendum *addendum{descriptor.Addendum()};
-    INTERNAL_CHECK(addendum != nullptr);
-    addendum->set_derivedType(derivedType);
+    if (addendum) { // Unlimited polymorphic allocated from intrinsic type spec
+                    // does not have
+      addendum->set_derivedType(derivedType);
+    } else {
+      // Unlimited polymorphic descriptors initialized with
+      // AllocatableInitIntrinsic do not have an addendum. Make sure the
+      // derivedType is null in that case.
+      INTERNAL_CHECK(!derivedType);
+    }
   }
   return stat;
 }

diff  --git a/flang/runtime/pointer.cpp b/flang/runtime/pointer.cpp
index c657c0e06f23..06ef73661bac 100644
--- a/flang/runtime/pointer.cpp
+++ b/flang/runtime/pointer.cpp
@@ -168,8 +168,14 @@ int RTNAME(PointerDeallocatePolymorphic)(Descriptor &pointer,
       pointer, hasStat, errMsg, sourceFile, sourceLine)};
   if (stat == StatOk) {
     DescriptorAddendum *addendum{pointer.Addendum()};
-    INTERNAL_CHECK(addendum != nullptr);
-    addendum->set_derivedType(derivedType);
+    if (addendum) {
+      addendum->set_derivedType(derivedType);
+    } else {
+      // Unlimited polymorphic descriptors initialized with
+      // PointerNullifyIntrinsic do not have an addendum. Make sure the
+      // derivedType is null in that case.
+      INTERNAL_CHECK(!derivedType);
+    }
   }
   return stat;
 }

diff  --git a/flang/unittests/Runtime/Pointer.cpp b/flang/unittests/Runtime/Pointer.cpp
index caf7d7e98652..e00fb9bd5711 100644
--- a/flang/unittests/Runtime/Pointer.cpp
+++ b/flang/unittests/Runtime/Pointer.cpp
@@ -51,3 +51,15 @@ TEST(Pointer, ApplyMoldAllocation) {
   EXPECT_EQ(p->ElementBytes(), m->ElementBytes());
   EXPECT_EQ(p->type(), m->type());
 }
+
+TEST(Pointer, DeallocatePolymorphic) {
+  // CLASS(*) :: p
+  // ALLOCATE(integer::p)
+  auto p{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Integer, 4},
+      4, nullptr, 0, nullptr, CFI_attribute_pointer)};
+  RTNAME(PointerAllocate)
+  (*p, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);
+  // DEALLOCATE(p)
+  RTNAME(PointerDeallocatePolymorphic)
+  (*p, nullptr, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);
+}