[gcc r13-7934] Fortran: Alloc comp of non-finalizable type not finalized [PR111674]

[gcc r13-7934] Fortran: Alloc comp of non-finalizable type not finalized [PR111674]

[Paul Thomas]

https://gcc.gnu.org/g:29cd67f93f00cc7a9b08eae4f3e12e67ed568f19

commit r13-7934-g29cd67f93f00cc7a9b08eae4f3e12e67ed568f19
Author: Paul Thomas <pault@gcc.gnu.org>
Date:   Wed Oct 4 08:26:35 2023 +0100

    Fortran: Alloc comp of non-finalizable type not finalized [PR111674]
    
    2023-10-04  Paul Thomas  <pault@gcc.gnu.org>
    
    gcc/fortran
            PR fortran/37336
            PR fortran/111674
            * trans-expr.cc (gfc_trans_scalar_assign): Finalize components
            on deallocation if derived type is not finalizable.
    
    gcc/testsuite/
            PR fortran/37336
            PR fortran/111674
            * gfortran.dg/allocate_with_source_25.f90: Final count in tree
            dump reverts from 4 to original 6.
            * gfortran.dg/finalize_38.f90: Add test for fix of PR111674.
    
    (cherry picked from commit 84284e1c490e9235fca5cb85269ecfcb87eef4f1)

Diff:
---
 gcc/fortran/trans-expr.cc                             |  2 +-
 gcc/testsuite/gfortran.dg/allocate_with_source_25.f90 |  2 +-
 gcc/testsuite/gfortran.dg/finalize_38.f90             | 16 ++++++++++++++++
 3 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 65b4a62ff5c..da1fa314378 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -10526,7 +10526,7 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
 	{
 	  tmp_var = gfc_evaluate_now (lse->expr, &lse->pre);
 	  tmp = gfc_deallocate_alloc_comp_no_caf (ts.u.derived, tmp_var,
-						  0, true);
+						  0, gfc_may_be_finalized (ts));
 	  if (deep_copy)
 	    tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location),
 			    tmp);
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_25.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_25.f90
index de20a147842..92dc50756d4 100644
--- a/gcc/testsuite/gfortran.dg/allocate_with_source_25.f90
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_25.f90
@@ -68,4 +68,4 @@ contains
   end function func_foo_a
 
 end program simple_leak
-! { dg-final { scan-tree-dump-times "\>_final" 4 "original" } }
+! { dg-final { scan-tree-dump-times "\>_final" 6 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/finalize_38.f90 b/gcc/testsuite/gfortran.dg/finalize_38.f90
index f4b00a16a54..85334890035 100644
--- a/gcc/testsuite/gfortran.dg/finalize_38.f90
+++ b/gcc/testsuite/gfortran.dg/finalize_38.f90
@@ -4,6 +4,8 @@
 ! With -std=gnu, no finalization of array or structure constructors should occur.
 ! See finalize_38a.f90 for the result with f2008.
 ! Tests fix for PR64290 as well.
+! Extended to test that nonfinalizable types with allocatable finalizable components
+! are finalized before deallocation (PR111674).
 !
 module testmode
   implicit none
@@ -20,6 +22,10 @@ module testmode
     final :: destructor3, destructor4
   end type complicated
 
+  type :: notfinalizable
+    type(simple), allocatable :: aa
+  end type
+
   integer :: check_scalar
   integer :: check_array(4)
   real :: check_real
@@ -114,6 +120,7 @@ program test_final
   type(simple), allocatable :: MyType, MyType2
   type(simple), allocatable :: MyTypeArray(:)
   type(simple) :: ThyType = simple(21), ThyType2 = simple(22)
+  type(notfinalizable) :: MyNf
   class(simple), allocatable :: MyClass
   class(simple), allocatable :: MyClassArray(:)
 
@@ -214,6 +221,15 @@ program test_final
   deallocate (MyClassArray)
   call test(2, 0, [10, 20], 170, rarray = [10.0,20.0])
 
+!******************
+! Test for PR111674
+!******************
+  final_count = 0
+  MyNf = notfinalizable (simple (42)) ! Allocatable component not finalized
+  if (final_count .ne. 0) stop 171
+  MyNf = notfinalizable (simple (84)) ! Component finalized before deallocation
+  call test(1, 42, [0,0], 180)
+
 ! Clean up for valgrind testing
   if (allocated (MyType)) deallocate (MyType)
   if (allocated (MyType2)) deallocate (MyType2)