Hi all,
the attached patch fixes a memory leak with unlimited polymorphic return types.
The leak occurred, because an expression with side-effects was evaluated twice.
I have substituted the check for non-variable expressions followed by creating a
SAVE_EXPR with checking for trees with side effects and creating temp. variable
and freeing the memory.
Btw, I do not get the SAVE_EXPR in the old code. Is there something missing to
manifest it or is a SAVE_EXPR not meant to be evaluated twice?
Anyway, regtested ok on Linux-x86_64-Fedora_39. Ok for master?
This work is funded by the Souvereign Tech Fund. Yes, the funding has been
granted and Nicolas, Mikael and me will be working on some Fortran topics in
the next 12-18 months.
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From edd6c94b802732b0dd742ef9eca4d74aaaf6d91b Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Wed, 12 Jul 2023 16:52:15 +0200
Subject: [PATCH] Fix memory leak.
Prevent double call of function return class object
and free the object after copy.
gcc/fortran/ChangeLog:
PR fortran/90069
* trans-expr.cc (gfc_conv_procedure_call): Evaluate
expressions with side-effects only ones and ensure
old is freeed.
gcc/testsuite/ChangeLog:
PR fortran/90069
* gfortran.dg/class_76.f90: New test.
---
gcc/fortran/trans-expr.cc | 29 +++++++++--
gcc/testsuite/gfortran.dg/class_76.f90 | 66 ++++++++++++++++++++++++++
2 files changed, 92 insertions(+), 3 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/class_76.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index dfc5b8e9b4a..38ba278f725 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6725,9 +6725,32 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
{
tree efield;
- /* Evaluate arguments just once. */
- if (e->expr_type != EXPR_VARIABLE)
- parmse.expr = save_expr (parmse.expr);
+ /* Evaluate arguments just once, when they have
+ side effects. */
+ if (TREE_SIDE_EFFECTS (parmse.expr))
+ {
+ tree cldata, zero;
+
+ parmse.expr = gfc_evaluate_now (parmse.expr,
+ &parmse.pre);
+
+ /* Prevent memory leak, when old component
+ was allocated already. */
+ cldata = gfc_class_data_get (parmse.expr);
+ zero = build_int_cst (TREE_TYPE (cldata),
+ 0);
+ tmp = fold_build2_loc (input_location, NE_EXPR,
+ logical_type_node,
+ cldata, zero);
+ tmp = build3_v (COND_EXPR, tmp,
+ gfc_call_free (cldata),
+ build_empty_stmt (
+ input_location));
+ gfc_add_expr_to_block (&parmse.finalblock,
+ tmp);
+ gfc_add_modify (&parmse.finalblock,
+ cldata, zero);
+ }
/* Set the _data field. */
tmp = gfc_class_data_get (var);
diff --git a/gcc/testsuite/gfortran.dg/class_76.f90 b/gcc/testsuite/gfortran.dg/class_76.f90
new file mode 100644
index 00000000000..1ee1e1fc25f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_76.f90
@@ -0,0 +1,66 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/90069
+!
+! Contributed by Brad Richardson <everythingfunctio...@protonmail.com>
+!
+
+program returned_memory_leak
+ implicit none
+
+ type, abstract :: base
+ end type base
+
+ type, extends(base) :: extended
+ end type extended
+
+ type :: container
+ class(*), allocatable :: thing
+ end type
+
+ call run()
+contains
+ subroutine run()
+ type(container) :: a_container
+
+ a_container = theRightWay()
+ a_container = theWrongWay()
+ end subroutine
+
+ function theRightWay()
+ type(container) :: theRightWay
+
+ class(base), allocatable :: thing
+
+ allocate(thing, source = newAbstract())
+ theRightWay = newContainer(thing)
+ end function theRightWay
+
+ function theWrongWay()
+ type(container) :: theWrongWay
+
+ theWrongWay = newContainer(newAbstract())
+ end function theWrongWay
+
+ function newAbstract()
+ class(base), allocatable :: newAbstract
+
+ allocate(newAbstract, source = newExtended())
+ end function newAbstract
+
+ function newExtended()
+ type(extended) :: newExtended
+ end function newExtended
+
+ function newContainer(thing)
+ class(*), intent(in) :: thing
+ type(container) :: newContainer
+
+ allocate(newContainer%thing, source = thing)
+ end function newContainer
+end program returned_memory_leak
+
+! { dg-final { scan-tree-dump-times "newabstract" 14 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free" 8 "original" } }
+
--
2.45.1
