Patchwork [fortran] PR 47586 Missing deep copy when assigning from a function returning a pointer.

login
register
mail settings
Submitter Mikael Morin
Date Aug. 13, 2012, 2:32 p.m.
Message ID <50290FFE.9000105@sfr.fr>
Download mbox | patch
Permalink /patch/176958/
State New
Headers show

Comments

Mikael Morin - Aug. 13, 2012, 2:32 p.m.
Hello,

here is a fix for PR47586: missing deep copy for the case:

dt_w_alloc = ptr_func(arg)

where dt_w_alloc is of derived type with allocatable components, and
ptr_func returns a data pointer.
The fix tweaks expr_is_variable so that gfc_trans_scalar_assign is
called with the flag enabling deep copy set.

I added a few fixes loosely related before, so that the patches are as
follows:

1/4: gfc_is_proc_ptr_comp interface change,
2/4: gfc_is_scalar_ptr deep_copy flag lengthy explanation,
3/4: regression fix,
4/4: patch fixing the PR.

Regression-tested on x86_64-unknown-linux-gnu. OK for trunk?

Mikael
! { dg-do run }
! { dg-options "-fdump-tree-original" }
! 
! PR fortran/47586
! Missing deep copy for data pointer returning functions when the type
! has allocatable components
!
! Original testcase by Thomas Henlich  <thenlich@users.sourceforge.net>
! Reduced by Tobias Burnus  <burnus@net-b.de>
!

module m
  type :: tx
    integer, dimension(:), allocatable :: i
  end type tx
  type proc_t
    procedure(find_x), nopass, pointer :: ppc => null()
   contains
    procedure, nopass :: tbp => find_x
  end type proc_t

contains

  function find_x(that)
    type(tx), target  :: that
    type(tx), pointer :: find_x
    find_x => that
  end function find_x

end module m

program prog

  use m

  type(tx) :: this
  type(tx), target :: that
  type(tx), pointer :: p

  type(proc_t) :: tab

  allocate(that%i(2))
  that%i = [3, 7]
  p => that
  this = that  ! (1) direct assignment: works (deep copy)
  that%i = [2, -5]
  !print *,this%i
  if(any (this%i /= [3, 7])) call abort()
  this = p     ! (2) using a pointer works as well
  that%i = [10, 1]
  !print *,this%i
  if(any (this%i /= [2, -5])) call abort()
  this = find_x(that)  ! (3) pointer function: used to fail (deep copy missing)
  that%i = [4, 6]
  !print *,this%i
  if(any (this%i /= [10, 1])) call abort()
  this = tab%tbp(that)  ! other case: typebound procedure
  that%i = [8, 9]
  !print *,this%i
  if(any (this%i /= [4, 6])) call abort()
  tab%ppc => find_x
  this = tab%ppc(that)  ! other case: procedure pointer component
  that%i = [-1, 2]
  !print *,this%i
  if(any (this%i /= [8, 9])) call abort()

end program prog

!
! We add another check for deep copy by looking at the dump.
! We use realloc on assignment here: if we do a deep copy  for the assignment
! to `this', we have a reallocation of `this%i'.
! Thus, the total number of malloc calls should be the number of assignment to
! `that%i' + the number of assignments to `this' + the number of allocate
! statements.
! It is assumed that if the number of allocate is right, the number of
! deep copies is right too.
! { dg-final { scan-tree-dump-times "__builtin_malloc" 12 "original" } }

!
! Realloc are only used for assignments to `that%i'.  Don't know why.
! { dg-final { scan-tree-dump-times "__builtin_realloc" 6 "original" } }
! 

! No leak: Only assignments to `this' use malloc.  Assignments to `that%i'
! take the realloc path after the first assignment, so don't count as a malloc.
! { dg-final { scan-tree-dump-times "__builtin_free" 7 "original" } }
!
! { dg-final { cleanup-tree-dump "original" } }
Tobias Burnus - Aug. 14, 2012, 12:37 p.m.
On 08/13/2012 04:32 PM, Mikael Morin wrote:
> here is a fix for PR47586: missing deep copy for the case:
> dt_w_alloc = ptr_func(arg)

The patch set looks okay. I am not 100% sure how compatible your changes 
are with regards to finalization and coarray components, but I have the 
impression they don't make thinks worse.

Regarding the comment:
   "A data-pointer-returning function should be considered as a variable 
too."

That's actually true according to the standard, which since F2008 allows:
   f() = 7
where f() returns a pointer. Well, gfortran doesn't support this yet and 
there are also some issues if the LHS is an operator expression (see 
current interpretation request discussions), but I thought I mention it 
for completeness.

Thanks for the patch! - And for the thorough patch reviews!

Tobias

Patch

2012-08-13  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/47586
	* gfortran.dg/typebound_proc_20.f90: Enable runtime test.
	* gfortran.dg/typebound_proc_26.f03: New test.

diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_20.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_20.f90
index b63daf9..47c131c 100644
--- a/gcc/testsuite/gfortran.dg/typebound_proc_20.f90
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_20.f90
@@ -1,5 +1,4 @@ 
-! { dg-do compile }
-! TODO: make runtime testcase once bug is fixed
+! { dg-do run }
 !
 ! PR fortran/47455
 !