[Patch, fortran] PR78293 - - [5/6/7 Regression] SIGABRT with function result used as argument

[Paul Richard Thomas]

Dear All,

Andre put me to shame with a devastatingly simple replacement for a
horribly complicated and wrong patch that I was getting into.

The part of the patch in trans-expr.c fixes the PR and the part in
trans-stmt.c fixes a memory leak in function 'tt'. This latter fixes
half of the memory leaks in class_array_15.f03. I have noted the rest
of this problem in PR38319 with which it is associated.

Bootstraps and regtests on FC21/x86_64 - OK for trunk and, later
5-branch and 6-branch?

Cheers

Paul

2016-11-24  Andre Vehreschild  <vehre@gcc.gnu.org>

    PR fortran/78293
    * trans-expr.c (gfc_conv_procedure_call): Prepend deallocation
    of alloctable components to post, rather than adding to
    se->post.
    * trans-stmt.c (gfc_trans_allocate): Move deallocation of expr3
    allocatable components so that all expr3s are visited.

2016-11-24  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/78293
    * gfortran.dg/allocatable_function_10.f90: New test.
    * gfortran.dg/class_array_15.f03: Increase builtin_free count
    from 11 to 12.
-------------- next part --------------
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 242620)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5568,5574 ****
  
  	  tmp = gfc_deallocate_alloc_comp (e->ts.u.derived, tmp, parm_rank);
  
! 	  gfc_add_expr_to_block (&se->post, tmp);
          }
  
        /* Add argument checking of passing an unallocated/NULL actual to
--- 5568,5574 ----
  
  	  tmp = gfc_deallocate_alloc_comp (e->ts.u.derived, tmp, parm_rank);
  
! 	  gfc_prepend_expr_to_block (&post, tmp);
          }
  
        /* Add argument checking of passing an unallocated/NULL actual to
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c	(revision 242620)
--- gcc/fortran/trans-stmt.c	(working copy)
*************** gfc_trans_allocate (gfc_code * code)
*** 5684,5700 ****
  	    }
  	  gfc_add_modify_loc (input_location, &block, var, tmp);
  
- 	  /* Deallocate any allocatable components after all the allocations
- 	     and assignments of expr3 have been completed.  */
- 	  if (code->expr3->ts.type == BT_DERIVED
- 	      && code->expr3->rank == 0
- 	      && code->expr3->ts.u.derived->attr.alloc_comp)
- 	    {
- 	      tmp = gfc_deallocate_alloc_comp (code->expr3->ts.u.derived,
- 					       var, 0);
- 	      gfc_add_expr_to_block (&post, tmp);
- 	    }
- 
  	  expr3 = var;
  	  if (se.string_length)
  	    /* Evaluate it assuming that it also is complicated like expr3.  */
--- 5684,5689 ----
*************** gfc_trans_allocate (gfc_code * code)
*** 5705,5710 ****
--- 5694,5712 ----
  	  expr3 = se.expr;
  	  expr3_len = se.string_length;
  	}
+ 
+       /* Deallocate any allocatable components after all the allocations
+ 	 and assignments of expr3 have been completed.  */
+       if ((code->expr3->ts.type == BT_DERIVED
+ 	   || code->expr3->ts.type == BT_CLASS)
+ 	  && (code->expr3->expr_type != EXPR_VARIABLE || temp_var_needed)
+ 	  && code->expr3->ts.u.derived->attr.alloc_comp)
+ 	{
+ 	  tmp = gfc_deallocate_alloc_comp (code->expr3->ts.u.derived,
+ 					   expr3, code->expr3->rank);
+ 	  gfc_prepend_expr_to_block (&post, tmp);
+ 	}
+ 
        /* Store what the expr3 is to be used for.  */
        if (e3_is == E3_UNSET)
  	e3_is = expr3 != NULL_TREE ?
Index: gcc/testsuite/gfortran.dg/allocatable_function_10.f90
===================================================================
*** gcc/testsuite/gfortran.dg/allocatable_function_10.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/allocatable_function_10.f90	(working copy)
***************
*** 0 ****
--- 1,46 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR78293. The deallocations are present at the
+ ! end of the main programme to aid memory leak searching. The
+ ! allocation in 'tt' leaked memory from an intermediate temporary
+ ! for the array constructor.
+ !
+ ! Contributed by Andrew Benson  <abensonca@gmail.com>
+ !
+ module m
+   implicit none
+ 
+   type t
+      integer, allocatable, dimension(:) :: r
+   end type t
+ 
+ contains
+ 
+   function tt(a,b)
+     implicit none
+     type(t), allocatable, dimension(:) :: tt
+     type(t), intent(in), dimension(:) :: a,b
+     allocate(tt, source = [a,b])
+   end function tt
+ 
+   function ts(arg)
+     implicit none
+     type(t), allocatable, dimension(:) :: ts
+     integer, intent(in) :: arg(:)
+     allocate(ts(1))
+     allocate(ts(1)%r, source = arg)
+     return
+   end function ts
+ 
+ end module m
+ 
+ program p
+   use m
+   implicit none
+   type(t), dimension(2) :: c
+   c=tt(ts([99,199,1999]),ts([42,142]))
+   if (any (c(1)%r .ne. [99,199,1999])) call abort
+   if (any (c(2)%r .ne. [42,142])) call abort
+   deallocate(c(1)%r)
+   deallocate(c(2)%r)
+ end program p
Index: gcc/testsuite/gfortran.dg/class_array_15.f03
===================================================================
*** gcc/testsuite/gfortran.dg/class_array_15.f03	(revision 242620)
--- gcc/testsuite/gfortran.dg/class_array_15.f03	(working copy)
*************** subroutine pr54992  ! This test remains
*** 115,118 ****
    bh => bhGet(b,instance=2)
    if (loc (b) .ne. loc(bh%hostNode)) call abort
  end
! ! { dg-final { scan-tree-dump-times "builtin_free" 11 "original" } }
--- 115,118 ----
    bh => bhGet(b,instance=2)
    if (loc (b) .ne. loc(bh%hostNode)) call abort
  end
! ! { dg-final { scan-tree-dump-times "builtin_free" 12 "original" } }