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 --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index dfc5b8e9b4a54f868ee82284e3ebc51fa1c2c43f..9f6cc8f871e246e6260cb525506e9d6b535faaa8 100644 (file)
--- 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 (file)
index 0000000..1ee1e1f
--- /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  <everythingfunctional@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" } }
+