https://gcc.gnu.org/bugzilla/show_bug.cgi?id=63205
paul.richard.thomas at gmail dot com <paul.richard.thomas at gmail dot com>
changed:
What |Removed |Added
----------------------------------------------------------------------------
Attachment #33995|0 |1
is obsolete| |
--- Comment #6 from paul.richard.thomas at gmail dot com <paul.richard.thomas
at gmail dot com> ---
Created attachment 34234
--> https://gcc.gnu.org/bugzilla/attachment.cgi?id=34234&action=edit
A near final patch
This version runs the testcase below without memory leaks. It also bootstraps
and regtests OK.
It still needs some tidying up but it is nearly there after all the struggles
to eliminate memory leaks and with the scalarizer.
Cheers
Paul
program test
implicit none
type t
integer :: ii
end type t
type, extends(t) :: u
real :: rr
end type u
type, extends(t) :: v
real, allocatable :: rr(:)
end type v
type, extends(v) :: w
real, allocatable :: rrr(:)
end type w
type(t) :: x, y(3)
type(v) :: a, b(3)
x = func1() ! scalar to scalar - no alloc comps
if (x%ii .ne. 77) call abort
y = func2() ! array to array - no alloc comps
if (any (y%ii .ne. [1,2,3])) call abort
y = func1() ! scalar to array - no alloc comps
if (any (y%ii .ne. 77)) call abort
x = func3() ! scalar daughter type to scalar - no alloc comps
if (x%ii .ne. 99) call abort
y = func4() ! array daughter type to array - no alloc comps
if (any (y%ii .ne. [3,4,5])) call abort
a = func5() ! scalar to scalar - alloc comps in parent type
if (any (a%rr .ne. [10.0,20.0])) call abort
b = func6() ! array to array - alloc comps in parent type
if (any (b(3)%rr .ne. [3.0,4.0])) call abort
a = func7() ! scalar daughter type to scalar - alloc comps in parent type
if (any (a%rr .ne. [10.0,20.0])) call abort
b = func8() ! array daughter type to array - alloc comps in parent type
if (any (b(3)%rr .ne. [3.0,4.0])) call abort
! This is an extension of class_to_type_2.f90's test using a daughter type
! instead of the declared type.
if (subpr2_array (g ()) .ne. 99 ) call abort
contains
function func1() result(res)
class(t), allocatable :: res
allocate (res, source = t(77))
end function func1
function func2() result(res)
class(t), allocatable :: res(:)
allocate (res(3), source = [u(1,1.0),u(2,2.0),u(3,3.0)])
end function func2
function func3() result(res)
class(t), allocatable :: res
allocate (res, source = v(99,[99.0,99.0,99.0]))
end function func3
function func4() result(res)
class(t), allocatable :: res(:)
allocate (res(3), source = [v(3,[1.0,2.0]),v(4,[2.0,3.0]),v(5,[3.0,4.0])])
end function func4
function func5() result(res)
class(v), allocatable :: res
allocate (res, source = v(3,[10.0,20.0]))
end function func5
function func6() result(res)
class(v), allocatable :: res(:)
allocate (res(3), source = [v(3,[1.0,2.0]),v(4,[2.0,3.0]),v(5,[3.0,4.0])])
end function func6
function func7() result(res)
class(v), allocatable :: res
allocate (res, source = w(3,[10.0,20.0],[100,200]))
end function func7
function func8() result(res)
class(v), allocatable :: res(:)
allocate (res(3), source =
[w(3,[1.0,2.0],[0.0]),w(4,[2.0,3.0],[0.0]),w(5,[3.0,4.0],[0.0])])
end function func8
integer function subpr2_array (x)
type(t) :: x(:)
if (any(x(:)%ii /= 55)) call abort
subpr2_array = 99
end function
function g () result(res)
integer i
class(t), allocatable :: res(:)
allocate (res(3), source = [(v (1, [1.0,2.0]), i = 1, 3)])
res(:)%ii = 55
end function g
end program test
