Hi Tobias,
I have attached a memory leak free version of the testcase. I have asked
for Thomas's help to use frontend-passes.c tools to do the same for
compound constructors with allocatable components. My attempts to do the
job in other ways have failed totally.
Cheers
Paul
On Fri, 29 Jan 2021 at 14:56, Tobias Burnus <[email protected]> wrote:
> Hi Paul,
>
> On 29.01.21 15:20, Paul Richard Thomas via Fortran wrote:
> > Regtests on FC33/x86_64
> > OK for master (and maybe for 10-branch?)
>
> The patch by itself looks good to me, but
>
> gfortran-trunk assumed_rank_20.f90 -fsanitize=address,undefined -g
>
> shows three times the warning:
>
> Direct leak of 12 byte(s) in 1 object(s) allocated from:
> #0 0x7f2d5ef6e517 in malloc
> (/usr/lib/x86_64-linux-gnu/libasan.so.6+0xb0517)
> #1 0x404221 in __mod_MOD_get_tuple /dev/shm/assumed_rank_20.f90:60
> #2 0x40ad8e in alloc_rank /dev/shm/assumed_rank_20.f90:78 (+ line 84,
> + line 90)
> #3 0x40d9e7 in main /dev/shm/assumed_rank_20.f90:67
>
> Thus, the function-result temporary does not seem to get deallocated
> when a constructor is used:
>
> 78: output = sel_rank1([get_tuple(x)]) ! This worked OK
> 84: output = sel_rank2([get_tuple(x)]) ! This worked OK
> 90: output = sel_rank3([get_tuple(x)]) ! runtime: segmentation fault
>
> Thanks,
>
> Tobias
>
> > Fortran: Fix memory problems with assumed rank formal args [PR98342].
> >
> > 2021-01-29 Paul Thomas <[email protected]>
> >
> > gcc/fortran
> > PR fortran/98342
> > * trans-expr.c (gfc_conv_derived_to_class): Add optional arg.
> > 'derived_array' to hold the fixed, parmse expr in the case of
> > assumed rank formal arguments. Deal with optional arguments.
> > (gfc_conv_procedure_call): Null 'derived' array for each actual
> > argument. Add its address to the call to gfc_conv_derived_to_
> > class. Access the 'data' field of scalar descriptors before
> > deallocating allocatable components. Also strip NOPs before the
> > calls to gfc_deallocate_alloc_comp. Use 'derived' array as the
> > input to gfc_deallocate_alloc_comp if it is available.
> > * trans.h : Include the optional argument 'derived_array' to
> > the prototype of gfc_conv_derived_to_class. The default value
> > is NULL_TREE.
> >
> > gcc/testsuite/
> > PR fortran/98342
> > * gfortran.dg/assumed_rank_20.f90 : New test.
> -----------------
> Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München /
> Germany
> Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung,
> Alexander Walter
>
--
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein
! { dg-do run }
!
! Test the fix for PR98342.
!
! Contributed by Martin Stein <[email protected]>
!
module mod
implicit none
private
public get_tuple, sel_rank1, sel_rank2, sel_rank3
type, public :: tuple
integer, dimension(:), allocatable :: t
end type tuple
contains
function sel_rank1(x) result(s)
character(len=:), allocatable :: s
type(tuple), dimension(..), intent(in) :: x
select rank (x)
rank (0)
s = '10'
rank (1)
s = '11'
rank default
s = '?'
end select
end function sel_rank1
function sel_rank2(x) result(s)
character(len=:), allocatable :: s
class(tuple), dimension(..), intent(in) :: x
select rank (x)
rank (0)
s = '20'
rank (1)
s = '21'
rank default
s = '?'
end select
end function sel_rank2
function sel_rank3(x) result(s)
character(len=:), allocatable :: s
class(*), dimension(..), intent(in) :: x
select rank (x)
rank (0)
s = '30'
rank (1)
s = '31'
rank default
s = '?'
end select
end function sel_rank3
function get_tuple(t) result(a)
type(tuple) :: a
integer, dimension(:), intent(in) :: t
allocate(a%t, source=t)
end function get_tuple
end module mod
program alloc_rank
use mod
implicit none
integer, dimension(1:3) :: x
character(len=:), allocatable :: output
type(tuple) :: z
x = [1,2,3]
z = get_tuple (x)
! Derived type formal arg
output = sel_rank1(get_tuple (x)) ! runtime: Error in `./alloc_rank.x':
if (output .ne. '10') stop 1
output = sel_rank1([z]) ! This worked OK
if (output .ne. '11') stop 2
! Class formal arg
output = sel_rank2(get_tuple (x)) ! runtime: Error in `./alloc_rank.x':
if (output .ne. '20') stop 3
output = sel_rank2([z]) ! This worked OK
if (output .ne. '21') stop 4
! Unlimited polymorphic formal arg
output = sel_rank3(get_tuple (x)) ! runtime: Error in `./alloc_rank.x':
if (output .ne. '30') stop 5
output = sel_rank3([z]) ! runtime: segmentation fault
if (output .ne. '31') stop 6
deallocate (output)
deallocate (z%t)
end program alloc_rank
