blob: 10bc139aabf2e6fdc52e73a5386647d6d5462b58 [file] [log] [blame]
! { dg-do run }
!
! Test the fix for an additional bug found while fixing PR80477
!
! Contributed by Paul Thomas <pault@gcc.gnu.org>
!
module a_type_m
implicit none
type :: a_type_t
real :: x
real, allocatable :: y(:)
endtype
contains
subroutine assign_a_type(lhs, rhs)
type(a_type_t), intent(inout) :: lhs
type(a_type_t), intent(in) :: rhs(:)
lhs%x = rhs(1)%x + rhs(2)%x
lhs%y = rhs(1)%y + rhs(2)%y
end subroutine
function add_a_type(lhs, rhs) result( res )
type(a_type_t), intent(in) :: lhs
type(a_type_t), intent(in) :: rhs
class(a_type_t), allocatable :: res(:)
allocate (a_type_t :: res(2))
allocate (res(1)%y(1), source = [10.0])
allocate (res(2)%y(1), source = [20.0])
res(1)%x = lhs%x + rhs%x
res(2)%x = rhs%x + rhs%x
end function
end module
program polymorphic_operators_memory_leaks
use a_type_m
implicit none
type(a_type_t) :: a = a_type_t(1) , b = a_type_t(2)
class(a_type_t), allocatable :: res(:)
res = add_a_type(a,b) ! Remarkably, this ICEd - found while debugging the PR.
call assign_a_type (a, res)
if (int (res(1)%x + res(2)%x) .ne. int (a%x)) stop 1
if (int (sum (res(1)%y + res(2)%y)) .ne. int (sum (a%y))) stop 1
deallocate (a%y)
deallocate (res)
end