Hello world,
the patch below fixes a far-reaching wrong-code regression. Regression
tested. OK for trunk and backport as far as possible?
(I particularly want to get this into gcc 13 while there still is time)
Best regards
Thomas
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.diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 2f14e8c3f6c..5e4529e2a4a 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5724,7 +5724,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 00000000000..ee040f86658
--- /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
