Re: [Patch, fortran] PR66079 - [6 Regression] memory leak with source allocation in internal subprogram

[Paul Richard Thomas <paul.richard.thomas@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 4663 bytes --]

Dear All,

Lets see if I can get it right this time :-)

Note that I have changed the name of the temporary variable in
trans_allocate from 'atmp' to 'expr3' so that it is not confused with
array temporaries. I am not suree how much of the testcase is
pertinent after the reform of the evaluation of expr3 performed by
Andre. However, there were still memory leaks that are fixed by the
attached patch.

Bootstrapped and regtested on a current trunk - OK for trunk?

Paul

2015-05-23  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/66079
    * trans-expr.c (gfc_conv_procedure_call): Allocatable scalar
    function results must be freed and nullified after use. Create
    a temporary to hold the result to prevent duplicate calls.
    * trans-stmt.c (gfc_trans_allocate): Rename temporary variable
    as 'expr3'. Deallocate allocatable components of non-variable
    expr3s.

2015-05-23  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/66079
    * gfortran.dg/allocatable_scalar_13.f90: New test


On 24 May 2015 at 09:51, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> Dear Andre,
>
> I'll put both points right. Thanks for pointing them out.
>
> Cheers
>
> Paul
>
> On 23 May 2015 at 19:52, Andre Vehreschild <vehre@gmx.de> wrote:
>> Hi Paul,
>>
>> does this patch apply to current trunk cleanly? I get an issue with the last
>> hunk, because all of the prerequisites are gone since r223445. The string copy
>> is completely handled by the trans_assignment at the bottom of the if
>> (code->expr3) block. Therefore I doubt the patches last hunk is needed any
>> longer.
>>
>> Do you have an example why this hunk is needed?
>>
>> Index: gcc/fortran/trans-stmt.c
>> ===================================================================
>> *** gcc/fortran/trans-stmt.c    (revision 223233)
>> --- gcc/fortran/trans-stmt.c    (working copy)
>> *************** gfc_trans_allocate (gfc_code * code)
>> *** 5200,5206 ****
>>                 }
>>               /* else expr3 = NULL_TREE set above.  */
>>             }
>> !         else
>>             {
>>               /* In all other cases evaluate the expr3 and create a
>>                  temporary.  */
>> --- 5200,5207 ----
>>                 }
>>               /* else expr3 = NULL_TREE set above.  */
>>             }
>> !         else if (!(code->expr3->ts.type == BT_DERIVED
>> !                    && code->expr3->ts.u.derived->attr.alloc_comp))
>>             {
>>               /* In all other cases evaluate the expr3 and create a
>>                  temporary.  */
>>
>> When I get the code right, than all derived-typed source= expressions that have
>> an allocatable component will not be prepared for copy to the allocated object.
>> This also means, that functions returning an object of such a type are called
>> multiple times. Once for each object to allocate. Is this really desired?
>>
>> I am sorry, that I have to say that, but the check2305.diff file does not bring
>> the testcase with it.
>>
>> Regards,
>>         Andre
>>
>>
>> On Sat, 23 May 2015 14:48:53 +0200
>> Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:
>>
>>> Dear All,
>>>
>>> This patch started out fixing a single source of memory leak and then
>>> went on to fix various other issues that I found upon investigation.
>>>
>>> The fortran ChangeLog entry is sufficiently descripive that I do not
>>> think that there is a need to say more.
>>>
>>> Bootstrapped and regtested on x86_64/FC21 - OK for trunk?
>>>
>>> I am rather sure that some of the issues go further back than 6.0. I
>>> will investigate what should be fixed for 5.2.
>>>
>>> Cheers
>>>
>>> Paul
>>>
>>> 2015-05-23  Paul Thomas  <pault@gcc.gnu.org>
>>>
>>>     PR fortran/66079
>>>     * trans-expr.c (gfc_conv_procedure_call): Allocatable scalar
>>>     function results must be freed and nullified after use. Create
>>>     a temporary to hold the result to prevent duplicate calls.
>>>     * trans-stmt.c (gfc_trans_allocate): Prevent memory leaks by
>>>     not evaluating expr3 for scalar derived types with allocatable
>>>     components. Fixed character length allocatable results and
>>>     dummies need to be dereferenced. Also, if al_len is NULL use
>>>     memsz for the string copy.
>>>
>>> 2015-05-23  Paul Thomas  <pault@gcc.gnu.org>
>>>
>>>     PR fortran/66079
>>>     * gfortran.dg/allocatable_scalar_13.f90: New test
>>
>>
>> --
>> Andre Vehreschild * Email: vehre ad gmx dot de
>
>
>
> --
> Outside of a dog, a book is a man's best friend. Inside of a dog it's
> too dark to read.
>
> Groucho Marx



-- 
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.

Groucho Marx

[-- Attachment #2: submit.diff --]
[-- Type: text/plain, Size: 5355 bytes --]

Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 223641)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5877,5882 ****
--- 5877,5896 ----
    fntype = TREE_TYPE (TREE_TYPE (se->expr));
    se->expr = build_call_vec (TREE_TYPE (fntype), se->expr, arglist);
  
+   /* Allocatable scalar function results must be freed and nullified
+      after use. This necessitates the creation of a temporary to
+      hold the result to prevent duplicate calls.  */
+   if (!byref && sym->ts.type != BT_CHARACTER
+       && sym->attr.allocatable && !sym->attr.dimension)
+     {
+       tmp = gfc_create_var (TREE_TYPE (se->expr), NULL);
+       gfc_add_modify (&se->pre, tmp, se->expr);
+       se->expr = tmp;
+       tmp = gfc_call_free (tmp);
+       gfc_add_expr_to_block (&post, tmp);
+       gfc_add_modify (&post, se->expr, build_int_cst (TREE_TYPE (se->expr), 0));
+     }
+ 
    /* If we have a pointer function, but we don't want a pointer, e.g.
       something like
          x = f()
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c	(revision 223641)
--- gcc/fortran/trans-stmt.c	(working copy)
*************** gfc_trans_allocate (gfc_code * code)
*** 5214,5219 ****
--- 5214,5220 ----
  				     false, false);
  	  gfc_add_block_to_block (&block, &se.pre);
  	  gfc_add_block_to_block (&post, &se.post);
+ 
  	  /* Prevent aliasing, i.e., se.expr may be already a
  		 variable declaration.  */
  	  if (!VAR_P (se.expr))
*************** gfc_trans_allocate (gfc_code * code)
*** 5223,5230 ****
  						 se.expr);
  	      /* We need a regular (non-UID) symbol here, therefore give a
  		 prefix.  */
! 	      var = gfc_create_var (TREE_TYPE (tmp), "atmp");
  	      gfc_add_modify_loc (input_location, &block, var, tmp);
  	      tmp = var;
  	    }
  	  else
--- 5224,5243 ----
  						 se.expr);
  	      /* We need a regular (non-UID) symbol here, therefore give a
  		 prefix.  */
! 	      var = gfc_create_var (TREE_TYPE (tmp), "expr3");
  	      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);
+ 		}
+ 
  	      tmp = var;
  	    }
  	  else
Index: gcc/testsuite/gfortran.dg/allocatable_scalar_13.f90
===================================================================
*** gcc/testsuite/gfortran.dg/allocatable_scalar_13.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/allocatable_scalar_13.f90	(working copy)
***************
*** 0 ****
--- 1,70 ----
+ ! { dg-do run }
+ ! { dg-options "-fdump-tree-original" }
+ !
+ ! Test the fix for PR66079. The original problem was with the first
+ ! allocate statement. The rest of this testcase fixes problems found
+ ! whilst working on it!
+ !
+ ! Reported by Damian Rouson  <damian@sourceryinstitute.org>
+ !
+   type subdata
+     integer, allocatable :: b
+   endtype
+ !  block
+     call newRealVec
+ !  end block
+ contains
+   subroutine newRealVec
+     type(subdata), allocatable :: d, e, f
+     character(:), allocatable :: g, h, i
+     character(8), allocatable :: j
+     allocate(d,source=subdata(1)) ! memory was lost, now OK
+     allocate(e,source=d) ! OK
+     allocate(f,source=create (99)) ! memory was lost, now OK
+     if (d%b .ne. 1) call abort
+     if (e%b .ne. 1) call abort
+     if (f%b .ne. 99) call abort
+     allocate (g, source = greeting1("good day"))
+     if (g .ne. "good day") call abort
+     allocate (h, source = greeting2("hello"))
+     if (h .ne. "hello") call abort
+     allocate (i, source = greeting3("hiya!"))
+     if (i .ne. "hiya!") call abort
+     call greeting4 (j, "Goodbye ") ! Test that dummy arguments are OK
+     if (j .ne. "Goodbye ") call abort
+   end subroutine
+ 
+   function create (arg) result(res)
+     integer :: arg
+     type(subdata), allocatable :: res, res1
+     allocate(res, res1, source = subdata(arg))
+   end function
+ 
+   function greeting1 (arg) result(res) ! memory was lost, now OK
+     character(*) :: arg
+     Character(:), allocatable :: res
+     allocate(res, source = arg)
+   end function
+ 
+   function greeting2 (arg) result(res)
+     character(5) :: arg
+     Character(:), allocatable :: res
+     allocate(res, source = arg)
+   end function
+ 
+   function greeting3 (arg) result(res)
+     character(5) :: arg
+     Character(5), allocatable :: res, res1
+     allocate(res, res1, source = arg) ! Caused an ICE
+     if (res1 .ne. res) call abort
+   end function
+ 
+   subroutine greeting4 (res, arg)
+     character(8), intent(in) :: arg
+     Character(8), allocatable, intent(out) :: res
+     allocate(res, source = arg) ! Caused an ICE
+   end subroutine
+ end
+ ! { dg-final { scan-tree-dump-times "builtin_malloc" 20 "original" } }
+ ! { dg-final { scan-tree-dump-times "builtin_free" 21 "original" } }
+ ! { dg-final { cleanup-tree-dump "original" } }