Possible patch for fortran/69955

[Louis Krupp]

After wasting hours in an unsuccessful attempt to figure out why memory allocated for derived type components wasn't being freed, I looked why the allocation was done in the first place.  The attached patch seems to fix the problem without breaking any other tests.

The test for this patch needs to query virtual memory usage and is therefore target-dependent.

Louis Krupp

-------------- next part --------------
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(revision 240723)
+++ gcc/fortran/trans-array.c	(working copy)
@@ -6963,6 +6963,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *ex
       /* TODO: Optimize passing function return values.  */
       gfc_se lse;
       gfc_se rse;
+      bool deep_copy;
 
       /* Start the copying loops.  */
       gfc_mark_ss_chain_used (loop.temp_ss, 1);
@@ -6993,9 +6994,12 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *ex
       gfc_add_block_to_block (&block, &lse.pre);
 
       lse.string_length = rse.string_length;
+
+      deep_copy = !se->data_not_needed
+		  && (expr->expr_type == EXPR_VARIABLE
+		      || expr->expr_type == EXPR_ARRAY);
       tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts,
-				     expr->expr_type == EXPR_VARIABLE
-				     || expr->expr_type == EXPR_ARRAY, false);
+				     deep_copy, false);
       gfc_add_expr_to_block (&block, tmp);
 
       /* Finish the copying loops.  */
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(revision 240723)
+++ gcc/fortran/ChangeLog	(working copy)
@@ -1,3 +1,9 @@
+2016-10-02  Louis Krupp  <louis.krupp@zoho.com>
+
+	PR fortran/69955
+	* trans-array.c (gfc_conv_expr_descriptor): Don't allocate
+	components if it's not necessary.
+
 2016-09-30  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/66643
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(revision 240723)
+++ gcc/testsuite/ChangeLog	(working copy)
@@ -1,3 +1,7 @@
+2016-10-02  Louis Krupp <louis.krupp@zoho.com>
+
+	* gfortran.dg/pr69955.f90: New test.
+
 2016-10-03  Senthil Kumar Selvaraj  <senthil_kumar.selvaraj@atmel.com>
 
 	* gcc.target/avr/torture/builtins-error.c: Add -ffat-lto-objects
Index: gcc/testsuite/gfortran.dg/pr69955.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr69955.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr69955.f90	(working copy)
@@ -0,0 +1,78 @@
+! { dg-do run { target x86_64-*-linux* } }
+!
+! On Linux, this test reads /proc/<PID>/statm to retrieve the current
+! virtual memory size.  Other platforms might have something similar.
+
+program p
+  implicit none
+
+  type :: t1
+    integer, allocatable :: t(:)
+  end type t1
+
+  type :: t2
+    type(t1), allocatable :: x1(:)
+  end type t2
+
+  type(t2) :: var(10)
+
+  integer :: i
+  integer :: vm_after_short_run, vm_after_long_run
+
+  do i= 1, 10
+    allocate(var(i)%x1(100))
+    allocate(var(i)%x1(1)%t(100))
+  enddo
+
+  open(unit = 37, file = "/dev/null", status = "old")
+
+  call s(100)
+
+  vm_after_short_run = vm_usage()
+
+  call s(100000)
+
+  vm_after_long_run = vm_usage()
+
+  ! Has VM usage gone up significantly?  A test without the patch
+  ! showed an increase of a factor of 4.
+  if (vm_after_long_run > vm_after_short_run * 1.1) then
+    print '("vm after short run: ", i0, ", after long run: ", i0)', &
+            vm_after_short_run, vm_after_long_run
+    call abort
+  endif
+
+  close(unit = 37)
+
+  do i=1,10
+    deallocate(var(i)%x1)
+  enddo
+
+contains
+
+  subroutine s(counter)
+    implicit none
+    integer, intent(in) :: counter
+    integer :: i, j, n
+
+    do j=1, counter
+      n = size( [ ( var(i)%x1 , i = 1, size(var) ) ] )
+      write(unit = 37, fmt = '(i5)') n
+    enddo
+  end subroutine
+
+  function vm_usage()
+    implicit none
+    integer vm_usage
+    character(len=20) :: statm_name
+    integer, dimension(7) :: statm_info
+
+    write(statm_name, '("/proc/", i0, "/statm")') getpid()
+    open(unit = 21, file = statm_name, status = 'old')
+    read(21, *) statm_info(:)
+    close(unit = 21)
+
+    vm_usage = statm_info(1) ! VmSize
+  end function
+
+end program p