From 43c11931acc50f3a44efb485b03e6a8d44df97e0 Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Wed, 26 Feb 2025 14:30:13 +0100 Subject: Fortran: Fix regression on double free on elemental function [PR118747] Fix a regression were adding a temporary variable inserted a copy of the argument to the elemental function. That copy was then later used to free allocated memory, but the freeing was not tracked in the source array correctly. PR fortran/118747 gcc/fortran/ChangeLog: * trans-array.cc (gfc_trans_array_ctor_element): Remove copy to temporary variable. * trans-expr.cc (gfc_conv_procedure_call): Use references to array members instead of copies when freeing after use. Formatting fix. gcc/testsuite/ChangeLog: * gfortran.dg/alloc_comp_auto_array_4.f90: New test. --- gcc/fortran/trans-expr.cc | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/trans-expr.cc') diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index ab55940..e619013 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6999,6 +6999,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if ((fsym && fsym->attr.value) || (ulim_copy && (argc == 2 || argc == 3))) gfc_conv_expr (&parmse, e); + else if (e->expr_type == EXPR_ARRAY) + { + gfc_conv_expr (&parmse, e); + if (e->ts.type != BT_CHARACTER) + parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr); + } else gfc_conv_expr_reference (&parmse, e); @@ -7930,11 +7936,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* It is known the e returns a structure type with at least one allocatable component. When e is a function, ensure that the function is called once only by using a temporary variable. */ - if (!DECL_P (parmse.expr)) + if (!DECL_P (parmse.expr) && e->expr_type == EXPR_FUNCTION) parmse.expr = gfc_evaluate_now_loc (input_location, parmse.expr, &se->pre); - if (fsym && fsym->attr.value) + if ((fsym && fsym->attr.value) || e->expr_type == EXPR_ARRAY) tmp = parmse.expr; else tmp = build_fold_indirect_ref_loc (input_location, @@ -7993,7 +7999,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* Scalars passed to an assumed rank argument are converted to a descriptor. Obtain the data field before deallocating any allocatable components. */ - if (parm_rank == 0 && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))) + if (parm_rank == 0 && e->expr_type != EXPR_ARRAY + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))) tmp = gfc_conv_descriptor_data_get (tmp); if (scalar_res_outside_loop) -- cgit v1.1