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 2f14e8c3f6cd0e993cba8b1460dbb320ea0bd502..5e4529e2a4a48b38966391af5a27a7fdb0949291 100644 (file)
--- 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 (file)
index 0000000..ee040f8
--- /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