From 7602e09b1c530bf60028b8c5e508139e6db6e91a Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval@gmail.com>
Date: Tue, 13 Dec 2022 14:59:39 +0100
Subject: [PATCH] [flang] Handle type generation for unlimited polymorphic
 function result

An unlimited polymorphic entity is considered to have a derived category
in its dynamic type but no type descriptor. Avoid a nullptr dereference when
an unlimited polymorphic type needs to be generated.

Reviewed By: PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D139923
---
 flang/lib/Lower/ConvertExpr.cpp  |  2 ++
 flang/test/Lower/polymorphic.f90 | 16 ++++++++++++++++
 2 files changed, 18 insertions(+)

diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 0378da27d736d..e45eb8f213370 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -1872,6 +1872,8 @@ class ScalarExprLowering {
   mlir::Type genType(const Fortran::evaluate::DynamicType &dt) {
     if (dt.category() != Fortran::common::TypeCategory::Derived)
       return converter.genType(dt.category(), dt.kind());
+    if (dt.IsUnlimitedPolymorphic())
+      return mlir::NoneType::get(&converter.getMLIRContext());
     return converter.genType(dt.GetDerivedTypeSpec());
   }
 
diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90
index 86c8eb1f1a8dd..c7ffc466e6901 100644
--- a/flang/test/Lower/polymorphic.f90
+++ b/flang/test/Lower/polymorphic.f90
@@ -722,6 +722,22 @@ subroutine test_polymorphic_io()
 ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[LOAD_P]] : (!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>
 ! CHECK: %{{.*}} = fir.call @_FortranAioInputDescriptor(%{{.*}}, %[[BOX_NONE]]) {{.*}} : (!fir.ref<i8>, !fir.box<none>) -> i1
 
+  function unlimited_polymorphic_alloc_array_ret()
+    class(*), allocatable :: unlimited_polymorphic_alloc_array_ret(:)
+  end function
+
+  subroutine test_unlimited_polymorphic_alloc_array_ret()
+    select type (a => unlimited_polymorphic_alloc_array_ret())
+      type is (real)
+        print*, 'type is real' 
+    end select
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_unlimited_polymorphic_alloc_array_ret() {
+! CHECK: %[[RES_TMP:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?xnone>>> {bindc_name = ".result"}
+! CHECK: %[[RES:.*]] = fir.call @_QMpolymorphic_testPunlimited_polymorphic_alloc_array_ret() fastmath<contract> : () -> !fir.class<!fir.heap<!fir.array<?xnone>>>
+! CHECK: fir.save_result %[[RES]] to %[[RES_TMP]] : !fir.class<!fir.heap<!fir.array<?xnone>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?xnone>>>>
+
 end module
 
 program test