Hi all,
on this regression I had to chew a longer time. Assume this Fortran:
type T
integer, allocatable:: a
end type T
result(type T) function bar()
allocate(bar%a)
end function
call foo([bar()])
That Fortran fragment was translated to something like (pseudo code):
T temp;
T arr[];
temp = bar();
arr[0]= temp;
foo(arr);
if (temp.a) { free(temp.a); temp.a= NULL;}
for (i in size(arr))
if (arr[i].a) { free(arr[i].a]; <-- double free here
arr[i].a = NULL;
}
I.e., when the derived type result of a function was used in an array
constructor that was used a function argument, then the temporary used to
evaluate the function only ones was declared to be of value. When the derived
type now had allocatable components, freeing those would be done on the value
typed temporary (here temp). But later on the array would also be freed. Now a
doulbe free occured, because the temporary variable was already freed. The
patch fixes this, by preventing the temporary when not necessary, or using a
temporary that is reference into the array, i.e., the memory freed (and marked
as such) is stored at the same location.
So after the patch this looks like this:
T *temp; // Now a pointer!
T arr[];
arr[0] = bar();
temp = &arr[0];
... Now we're safe, because freeing temp->a sets arr[0].a to NULL and the
following loop is safe.
Regtests ok on x86_64-pc-linux-gnu / F41. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From e9fd144ed6b72ddeb37c629a710bebbfba918e19 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Wed, 26 Feb 2025 14:30:13 +0100
Subject: [PATCH] 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-array.cc | 11 +++-----
gcc/fortran/trans-expr.cc | 13 ++++++---
.../gfortran.dg/alloc_comp_auto_array_4.f90 | 27 +++++++++++++++++++
3 files changed, 41 insertions(+), 10 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/alloc_comp_auto_array_4.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8f76870b286..6a00d26cb2f 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2002,13 +2002,10 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
if (expr->expr_type == EXPR_FUNCTION && expr->ts.type == BT_DERIVED
&& expr->ts.u.derived->attr.alloc_comp)
- {
- if (!VAR_P (se->expr))
- se->expr = gfc_evaluate_now (se->expr, &se->pre);
- gfc_add_expr_to_block (&se->finalblock,
- gfc_deallocate_alloc_comp_no_caf (
- expr->ts.u.derived, se->expr, expr->rank, true));
- }
+ gfc_add_expr_to_block (&se->finalblock,
+ gfc_deallocate_alloc_comp_no_caf (expr->ts.u.derived,
+ tmp, expr->rank,
+ true));
if (expr->ts.type == BT_CHARACTER)
{
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index ab55940638e..e619013f261 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)
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_4.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_4.f90
new file mode 100644
index 00000000000..06bd8b50b96
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_4.f90
@@ -0,0 +1,27 @@
+!{ dg-do run }
+
+! Check freeing derived typed result's allocatable components is not done twice.
+! Contributed by Damian Rouson <damian@archaeologic.codes>
+
+program pr118747
+ implicit none
+
+ type string_t
+ character(len=:), allocatable :: string_
+ end type
+
+ call check_allocation([foo(), foo()])
+
+contains
+
+ type(string_t) function foo()
+ foo%string_ = "foo"
+ end function
+
+ elemental subroutine check_allocation(string)
+ type(string_t), intent(in) :: string
+ if (.not. allocated(string%string_)) error stop "unallocated"
+ end subroutine
+
+end program
+
--
2.48.1
