https://gcc.gnu.org/g:d1750d8df75f292a0111e94dda82664c988bcc60
commit r16-9101-gd1750d8df75f292a0111e94dda82664c988bcc60 Author: Jerry DeLisle <[email protected]> Date: Fri Jun 5 13:20:05 2026 -0700 fortran: wrong-code for implied-do with allocatable-component derived type When a nested implied-do array constructor called a transformational intrinsic (e.g. RESHAPE) whose result type has allocatable components, the argument temporaries were freed before the result's allocatable components were deep-copied, causing a heap-use-after-free and wrong runtime values. The root cause: in gfc_conv_procedure_call, the call to gfc_add_block_to_block (&se->pre, &post) — which frees the allocatable components of argument temporaries — was issued before the deep-copy loop for the result's allocatable components. Transformational library functions such as RESHAPE do a shallow byte-copy of the source array into the result, so the result's component pointers alias those of the argument temporaries. Freeing the temporaries first and then copying yielded use-after-free. Fix: move gfc_add_block_to_block (&se->pre, &post) to after the deep-copy loop, so that the result's allocatable components are copied while the source storage is still live. PR fortran/125535 Assisted-by: Claude Sonnet 4.6 gcc/fortran/ChangeLog: PR fortran/125535 * trans-expr.cc (gfc_conv_procedure_call): Move post block append to after the deep copy of allocatable components for transformational intrinsics, so that argument temporaries are not freed before the result components are copied. gcc/testsuite/ChangeLog: PR fortran/125535 * gfortran.dg/implied_do_alloc_comp_1.f90: New test. (cherry picked from commit a0d7e1c3639a6e19f4413bf53bb1e994494ec77f) Diff: --- gcc/fortran/trans-expr.cc | 10 +++--- .../gfortran.dg/implied_do_alloc_comp_1.f90 | 39 ++++++++++++++++++++++ 2 files changed, 44 insertions(+), 5 deletions(-) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 5e4529e2a4a4..c1f8b9b54d42 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -9037,12 +9037,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* Follow the function call with the argument post block. */ if (byref) { - gfc_add_block_to_block (&se->pre, &post); - /* Transformational functions of derived types with allocatable - components must have the result allocatable components copied when the - argument is actually given. This is unnecessry for REDUCE because the - wrapper for the OPERATION function takes care of this. */ + components must have the result allocatable components copied + BEFORE the argument post block is appended. Copying the result + first, then freeing the argument, gives the correct order. */ arg = expr->value.function.actual; if (result && arg && expr->rank && isym && isym->transformational @@ -9070,6 +9068,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, NULL, GFC_CAF_COARRAY_NOCOARRAY); gfc_add_expr_to_block (&se->pre, tmp); } + + gfc_add_block_to_block (&se->pre, &post); } else { diff --git a/gcc/testsuite/gfortran.dg/implied_do_alloc_comp_1.f90 b/gcc/testsuite/gfortran.dg/implied_do_alloc_comp_1.f90 new file mode 100644 index 000000000000..8f0ae4976d83 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implied_do_alloc_comp_1.f90 @@ -0,0 +1,39 @@ +! { dg-do run } +! Test that a nested implied-do array constructor with a derived-type +! constructor whose argument uses an outer loop variable produces correct +! results when the derived type has an allocatable component. +! +! PR fortran/125535 + +module m + implicit none + type :: t + real, allocatable :: v(:) + end type +contains + pure function make(x) result(r) + real, intent(in) :: x(:) + type(t) :: r + r%v = x + end function +end module + +program implied_do_alloc_comp + use m + implicit none + integer, parameter :: n=3, k=2 + type(t), allocatable :: a(:,:) + real :: h(k, n) + integer :: i, j + + h(1,:) = [10., 20., 30.] + h(2,:) = [11., 21., 31.] + + ! Nested implied-do where inner DT constructor uses outer variable i. + ! Without the fix this produces heap-use-after-free and wrong values. + a = reshape([([(make(h(:,i)), j=1,1)], i=1,n)], [1,n]) + + if (any(a(1,1)%v /= h(:,1))) stop 1 + if (any(a(1,2)%v /= h(:,2))) stop 2 + if (any(a(1,3)%v /= h(:,3))) stop 3 +end program
