[flang-commits] [flang] de1aced - [flang] Handle non derived-type unlimited polymorphic allocation

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2022-11-04T08:20:08+01:00
New Revision: de1aced75942eacd59ba46b131311a6bbbe4d0f2

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

LOG: [flang] Handle non derived-type unlimited polymorphic allocation

Runtime call to PointerNullifyDerived or AllocatableInitDerived
should only be generated for derived-type allocation of polymorphic entities.
With unlimited polymorphic entities, it is possible that the type spec is not
a derived-type. Avoid failure in that case.

Reviewed By: PeteSteinfeld

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

Added: 
    

Modified: 
    flang/lib/Lower/Allocatable.cpp
    flang/test/Lower/polymorphic.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index 190fe1a698f3c..65f7e9c75b53b 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -482,6 +482,10 @@ class AllocateStmtHelper {
     if (!typeSpec)
       typeSpec = &alloc.type;
 
+    // Do not generate calls for non derived-type type spec.
+    if (!typeSpec->AsDerived())
+      return;
+
     assert(typeSpec && "type spec missing for polymorphic allocation");
     std::string typeName =
         Fortran::lower::mangle::mangleName(typeSpec->derivedTypeSpec());

diff  --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90
index 6177845af8f34..232dfada79194 100644
--- a/flang/test/Lower/polymorphic.f90
+++ b/flang/test/Lower/polymorphic.f90
@@ -49,4 +49,13 @@ subroutine check()
 ! CHECK: %[[BOX2:.*]] = fir.embox %[[DT2]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>
 ! CHECK: %[[CLASS2:.*]] = fir.convert %[[BOX2]] : (!fir.class<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> 
 ! CHECK: fir.call @_QMpolymorphic_testPprint(%[[CLASS2]]) : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> ()
+
+  subroutine test_allocate_unlimited_polymorphic_non_derived()
+    class(*), pointer :: u
+    allocate(integer::u)
+  end subroutine
+
+! CHECK-LABEL: test_allocate_unlimited_polymorphic_non_derived
+! CHECK-NOT: _FortranAPointerNullifyDerived
+! CHECK: fir.call @_FortranAPointerAllocate
 end module