! { dg-do run } ! ! Check that reallocation of the lhs is done with the correct memory size. module base_mod type, abstract :: base contains procedure(base_add), deferred :: add generic :: operator(+) => add end type base abstract interface module function base_add(l, r) result(res) class(base), intent(in) :: l integer, intent(in) :: r class(base), allocatable :: res end function base_add end interface contains subroutine foo(x) class(base), intent(inout), allocatable :: x class(base), allocatable :: t t = x + 2 x = t + 40 end subroutine foo end module base_mod module extend_mod use base_mod type, extends(base) :: extend integer :: i contains procedure :: add end type extend contains module function add(l, r) result(res) class(extend), intent(in) :: l integer, intent(in) :: r class(base), allocatable :: res select type (l) class is (extend) res = extend(l%i + r) class default error stop "Unkown class to add to." end select end function end module extend_mod program test_poly_ass use extend_mod use base_mod class(base), allocatable :: obj obj = extend(0) call foo(obj) select type (obj) class is (extend) if (obj%i /= 42) error stop class default error stop "Result's type wrong." end select end program test_poly_ass