[flang] Do not finalize pointer function result

According to 7.5.6.3 point 5, only nonpointer function result
need to be finalized. Update the condition to exclude pointer
function result.

Reviewed By: jeanPerier

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

diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index be37c5f..4f1dd00 100644 (file)
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -376,15 +376,16 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
   }
 
   if (allocatedResult) {
-    // 7.5.6.3 point 5. Derived-type finalization.
+    // 7.5.6.3 point 5. Derived-type finalization for nonpointer function.
     // Check if the derived-type is finalizable if it is a monorphic
     // derived-type.
     // For polymorphic and unlimited polymorphic enities call the runtime
     // in any cases.
     std::optional<Fortran::evaluate::DynamicType> retTy =
         caller.getCallDescription().proc().GetType();
-    if (retTy && (retTy->category() == Fortran::common::TypeCategory::Derived ||
-                  retTy->IsPolymorphic() || retTy->IsUnlimitedPolymorphic())) {
+    if (!fir::isPointerType(funcType.getResults()[0]) && retTy &&
+        (retTy->category() == Fortran::common::TypeCategory::Derived ||
+         retTy->IsPolymorphic() || retTy->IsUnlimitedPolymorphic())) {
       if (retTy->IsPolymorphic() || retTy->IsUnlimitedPolymorphic()) {
         auto *bldr = &converter.getFirOpBuilder();
         stmtCtx.attachCleanup([bldr, loc, allocatedResult]() {

diff --git a/flang/test/Lower/derived-type-finalization.f90 b/flang/test/Lower/derived-type-finalization.f90
index fae1cdc..7c117fc 100644 (file)
--- a/flang/test/Lower/derived-type-finalization.f90
+++ b/flang/test/Lower/derived-type-finalization.f90
@@ -148,6 +148,26 @@ contains
 ! CHECK: %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}}: (!fir.box<none>) -> none
 ! CHECK: return
 
+  function get_t1(i)
+    type(t1), pointer :: get_t1
+    allocate(get_t1)
+    get_t1%a = i
+  end function
+
+  subroutine test_nonpointer_function()
+    print*, get_t1(20)
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_nonpointer_function() {
+! CHECK: %[[TMP:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>> {bindc_name = ".result"}
+! CHECK: %{{.*}} = fir.call @_FortranAioBeginExternalListOutput
+! CHECK: %[[RES:.*]] = fir.call @_QMderived_type_finalizationPget_t1(%{{.*}}) {{.*}} : (!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>
+! CHECK: fir.save_result %[[RES]] to %[[TMP]] : !fir.box<!fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>, !fir.ref<!fir.box<!fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>>
+! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor
+! CHECK-NOT: %{{.*}} = fir.call @_FortranADestroy
+! CHECK: %{{.*}} = fir.call @_FortranAioEndIoStatement
+! CHECK: return
+
 end module
 
 program p