https://gcc.gnu.org/g:2f97d98d174e3ef9f3a9a83c179d787abde5e066
commit r15-891-g2f97d98d174e3ef9f3a9a83c179d787abde5e066
Author: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Wed Jul 12 16:52:15 2023 +0200
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.
Diff:
---
gcc/fortran/trans-expr.cc | 29 +++++++++++++--
gcc/testsuite/gfortran.dg/class_76.f90 | 66 ++++++++++++++++++++++++++++++++++
2 files changed, 92 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index dfc5b8e9b4a..9f6cc8f871e 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" } }
+
