Index: gcc/fortran/trans-expr.c =================================================================== *** gcc/fortran/trans-expr.c (revision 262444) --- gcc/fortran/trans-expr.c (working copy) *************** gfc_conv_procedure_call (gfc_se * se, gf *** 5360,5366 **** && e->ts.type == BT_CLASS && !CLASS_DATA (e)->attr.dimension && !CLASS_DATA (e)->attr.codimension) ! parmse.expr = gfc_class_data_get (parmse.expr); /* Wrap scalar variable in a descriptor. We need to convert the address of a pointer back to the pointer itself before, --- 5360,5384 ---- && e->ts.type == BT_CLASS && !CLASS_DATA (e)->attr.dimension && !CLASS_DATA (e)->attr.codimension) ! { ! parmse.expr = gfc_class_data_get (parmse.expr); ! /* The result is a class temporary, whose _data component ! must be freed to avoid a memory leak. */ ! if (e->expr_type == EXPR_FUNCTION ! && CLASS_DATA (e)->attr.allocatable) ! { ! tree zero; ! zero = build_int_cst (TREE_TYPE (parmse.expr), 0); ! tmp = fold_build2_loc (input_location, NE_EXPR, ! logical_type_node, ! parmse.expr, zero); ! tmp = build3_v (COND_EXPR, tmp, ! gfc_call_free (parmse.expr), ! build_empty_stmt (input_location)); ! gfc_add_expr_to_block (&parmse.post, tmp); ! gfc_add_modify (&parmse.post, parmse.expr, zero); ! } ! } /* Wrap scalar variable in a descriptor. We need to convert the address of a pointer back to the pointer itself before, Index: gcc/testsuite/gfortran.dg/class_result_7.f90 =================================================================== *** gcc/testsuite/gfortran.dg/class_result_7.f90 (nonexistent) --- gcc/testsuite/gfortran.dg/class_result_7.f90 (working copy) *************** *** 0 **** --- 1,36 ---- + ! { dg-do compile } + ! { dg-options "-fdump-tree-original" } + ! + ! Test the fix for PR80477 + ! + ! Contributed by Stefano Zaghi + ! + module a_type_m + implicit none + type :: a_type_t + real :: x + endtype + contains + subroutine assign_a_type(lhs, rhs) + type(a_type_t), intent(inout) :: lhs + type(a_type_t), intent(in) :: rhs + lhs%x = rhs%x + end subroutine + + function add_a_type(lhs, rhs) result( res ) + type(a_type_t), intent(in) :: lhs + type(a_type_t), intent(in) :: rhs + class(a_type_t), allocatable :: res + allocate (a_type_t :: res) + res%x = lhs%x + rhs%x + end function + end module + + program polymorphic_operators_memory_leaks + use a_type_m + implicit none + type(a_type_t) :: a = a_type_t(1) , b = a_type_t(2) + call assign_a_type (a, add_a_type(a,b)) ! generated a memory leak + end + ! { dg-final { scan-tree-dump-times "builtin_free" 1 "original" } } + ! { dg-final { scan-tree-dump-times "builtin_malloc" 1 "original" } } Index: gcc/testsuite/gfortran.dg/transfer_class_3.f90 ===================================================================