[Patch, Fortran/90068] Add finalizer creation to array constructor for functions of derived type.

[Andre Vehreschild <vehre@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 356 bytes --]

Hi Fortraneers,

another patch to fix a memory leak. This time temporaries created during an
array construction did not have their finalizers called. I.e. allocated memory
was not freed. The attached patch addresses this issue.

Regtested ok on x86_64/Fedora 39. Ok for trunk?

Regards,
	Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr90068_1.patch --]
[-- Type: text/x-patch, Size: 4741 bytes --]

From 367e8be8945a32dcb24c4bfb9558abf687a53fe0 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Thu, 27 Jul 2023 14:51:34 +0200
Subject: [PATCH] Add finalizer creation to array constructor for functions of
 derived type.

	PR fortran/90068

gcc/fortran/ChangeLog:

	* trans-array.cc (gfc_trans_array_ctor_element): Eval non-
	variable expressions once only.
	(gfc_trans_array_constructor_value): Add statements of
	final block.
	(trans_array_constructor): Detect when final block is required.

gcc/testsuite/ChangeLog:

	* gfortran.dg/finalize_57.f90: New test.
---
 gcc/fortran/trans-array.cc                | 18 ++++++-
 gcc/testsuite/gfortran.dg/finalize_57.f90 | 63 +++++++++++++++++++++++
 2 files changed, 80 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/finalize_57.f90

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index eec62c296ff..cc50b961a97 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1885,6 +1885,16 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
 				 gfc_conv_descriptor_data_get (desc));
   tmp = gfc_build_array_ref (tmp, offset, NULL);

+  if (expr->expr_type == EXPR_FUNCTION && expr->ts.type == BT_DERIVED
+      && expr->ts.u.derived->attr.alloc_comp)
+    {
+      if (!VAR_P (se->expr))
+	se->expr = gfc_evaluate_now (se->expr, &se->pre);
+      gfc_add_expr_to_block (&se->finalblock,
+			     gfc_deallocate_alloc_comp_no_caf (
+			       expr->ts.u.derived, se->expr, expr->rank, true));
+    }
+
   if (expr->ts.type == BT_CHARACTER)
     {
       int i = gfc_validate_kind (BT_CHARACTER, expr->ts.kind, false);
@@ -2147,6 +2157,8 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock,
 	      *poffset = fold_build2_loc (input_location, PLUS_EXPR,
 					  gfc_array_index_type,
 					  *poffset, gfc_index_one_node);
+	      if (finalblock)
+		gfc_add_block_to_block (finalblock, &se.finalblock);
 	    }
 	  else
 	    {
@@ -2795,6 +2807,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
   tree neg_len;
   char *msg;
   stmtblock_t finalblock;
+  bool finalize_required;

   /* Save the old values for nested checking.  */
   old_first_len = first_len;
@@ -2973,8 +2986,11 @@ trans_array_constructor (gfc_ss * ss, locus * where)
   TREE_USED (offsetvar) = 0;

   gfc_init_block (&finalblock);
+  finalize_required = expr->must_finalize;
+  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp)
+    finalize_required = true;
   gfc_trans_array_constructor_value (&outer_loop->pre,
-				     expr->must_finalize ? &finalblock : NULL,
+				     finalize_required ? &finalblock : NULL,
 				     type, desc, c, &offset, &offsetvar,
 				     dynamic);

diff --git a/gcc/testsuite/gfortran.dg/finalize_57.f90 b/gcc/testsuite/gfortran.dg/finalize_57.f90
new file mode 100644
index 00000000000..b6257357c75
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_57.f90
@@ -0,0 +1,63 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/90068
+!
+! Contributed by Brad Richardson  <everythingfunctional@protonmail.com>
+!
+
+program array_memory_leak
+    implicit none
+
+    type, abstract :: base
+    end type base
+
+    type, extends(base) :: extended
+    end type extended
+
+    type :: container
+        class(base), allocatable :: thing
+    end type
+
+    type, extends(base) :: collection
+        type(container), allocatable :: stuff(:)
+    end type collection
+
+    call run()
+    call bad()
+contains
+    subroutine run()
+        type(collection) :: my_thing
+        type(container) :: a_container
+
+        a_container = newContainer(newExtended()) ! This is fine
+        my_thing = newCollection([a_container])
+    end subroutine run
+
+    subroutine bad()
+        type(collection) :: my_thing
+
+        my_thing = newCollection([newContainer(newExtended())]) ! This is a memory leak
+    end subroutine bad
+
+    function newExtended()
+        type(extended) :: newExtended
+    end function newExtended
+
+    function newContainer(thing)
+        class(base), intent(in) :: thing
+        type(container) :: newContainer
+
+        allocate(newContainer%thing, source = thing)
+    end function newContainer
+
+    function newCollection(things)
+        type(container), intent(in) :: things(:)
+        type(collection) :: newCollection
+
+        newCollection%stuff = things
+    end function newCollection
+end program array_memory_leak
+
+! { dg-final { scan-tree-dump-times "__builtin_free" 15 "original" } }
+
--
2.45.1