https://gcc.gnu.org/g:f2b1a0cae33adbd4942eb1ee966bb2d1f3768ffc
commit r13-10333-gf2b1a0cae33adbd4942eb1ee966bb2d1f3768ffc Author: Thomas Koenig <[email protected]> Date: Tue May 19 14:09:35 2026 +0200 PR fortran/115260 - fix data corruption on inline packing/unpacking This patch fixes a data corruption occuring when a non-contiguous slice of an allocatable array component was passed to a procedure expecting a g77-style argument. The problem was the inline packing (PR fortran/88821) which went astray gfc_trans_scalar_assign was told to deallocate the argument upon return. The solution was to not pass that argument if passing a g77-style array, in effect a one-liner. This is a regression which goes back to all supported releases. gcc/fortran/ChangeLog: PR fortran/115260 * trans-expr.cc (gfc_conv_subref_array_arg): Pass false to dealloc argument of gfc_trans_scalar_assign if we are converting a g77-style argument. gcc/testsuite/ChangeLog: PR fortran/115260 * gfortran.dg/pr115260.f90: New test. (cherry picked from commit d81f2cb42b418484050599906f41978ed5005eaa) Diff: --- gcc/fortran/trans-expr.cc | 4 +++- gcc/testsuite/gfortran.dg/pr115260.f90 | 35 ++++++++++++++++++++++++++++++++++ 2 files changed, 38 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 8a1e044e708a..01d3c3c7f021 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -5197,7 +5197,9 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr, int g77, gcc_assert (lse.ss == gfc_ss_terminator); - tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, false, true); + /* Do not do deallocations when we are looking at a g77-style argument. */ + + tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, false, !g77); gfc_add_expr_to_block (&body, tmp); /* Generate the copying loops. */ diff --git a/gcc/testsuite/gfortran.dg/pr115260.f90 b/gcc/testsuite/gfortran.dg/pr115260.f90 new file mode 100644 index 000000000000..ee040f86658e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr115260.f90 @@ -0,0 +1,35 @@ +! { dg-do run } +! PR 115260 - this got corrupted output. +! Original test case by Steve Mullerworth + +program usegnufields + implicit none + type :: field_type + real, allocatable :: data(:) + integer, allocatable :: idata(:) + end type field_type + type :: fieldholder + type(field_type) :: fieldset(2,4) + end type fieldholder + type(fieldholder) :: myfields + + allocate(myfields%fieldset(2,1)%data(3)) + allocate(myfields%fieldset(2,1)%idata(3)) + myfields%fieldset(2,1)%data =1.0 + myfields%fieldset(2,1)%idata=2 + + call setfields (myfields%fieldset(2,1:4)) +! print *,'After calling setfields with fieldset(2,1:4)' +! print *,myfields%fieldset(2,1)%data +! print *,myfields%fieldset(2,1)%idata + if (any (myfields%fieldset(2,1)%data /= 1.0)) stop 1 + if (any (myfields%fieldset(2,1)%idata /= 2 )) stop 2 + +contains + subroutine setfields (fieldset) + type(field_type), intent(inout) :: fieldset(1:4) ! corruption with -O +! print *,'In setfields:' +! print *,fieldset(1)%data +! print *,fieldset(1)%idata + end subroutine setfields +end
