! { 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

 block ! Start new scoping unit as PROGRAM implies SAVE
  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])) STOP 1
  this = p     ! (2) using a pointer works as well
  that%i = [10, 1]
  !print *,this%i
  if(any (this%i /= [2, -5])) STOP 2
  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])) STOP 3
  this = tab%tbp(that)  ! other case: typebound procedure
  that%i = [8, 9]
  !print *,this%i
  if(any (this%i /= [4, 6])) STOP 4
  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])) STOP 5

 end block
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" 15 "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" 10 "original" } }
!