[flang] Do not perform INTERNAL_CHECK for deallocation of unlimited p…

…olymorphic 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

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;
 }

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;
 }

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__);
+}