[flang] Handle non derived-type unlimited polymorphic allocation

[clementval]

Summary

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.

[PeteSteinfeld]

Aside from that one nit, all builds and tests correctly and looks good.

flang/lib/Lower/Allocatable.cpp

485

Should read "calls" rather than "call".

flang/lib/Lower/Allocatable.cpp

void genSetType(const Allocation &alloc, const fir::MutableBoxValue &box,
     const Fortran::semantics::DeclTypeSpec *typeSpec =
         getIfAllocateStmtTypeSpec();
 
     // No type spec provided in allocate statement so the declared type spec is
     // used.
     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());
     std::string typeDescName =
         fir::NameUniquer::getTypeDescriptorName(typeName);
 
     auto typeDescGlobal =
         builder.getModule().lookupSymbol<fir::GlobalOp>(typeDescName);

flang/test/Lower/polymorphic.f90

 ! CHECK-LABEL: func.func @_QMpolymorphic_testPcheck()
 ! CHECK: %[[DT1:.*]] = fir.alloca !fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}> {bindc_name = "t1", uniq_name = "_QMpolymorphic_testFcheckEt1"}
 ! CHECK: %[[DT2:.*]] = fir.alloca !fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}> {bindc_name = "t2", uniq_name = "_QMpolymorphic_testFcheckEt2"}
 ! CHECK: %[[CLASS1:.*]] = fir.embox %[[DT1]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
 ! CHECK: fir.call @_QMpolymorphic_testPprint(%[[CLASS1]]) : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> ()
 ! 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