blob: 011878e958719bc9817fd2e4ca25219f90c6ab92 [file] [log] [blame]
! { dg-do run }
! { dg-options "-fcheck=all" }
!
! PR 50225: [OOP] The allocation status for polymorphic allocatable function results is not set properly
!
! Contributed by Arjen Markus <arjen.markus895@gmail.com>
module points2d
implicit none
type point2d
real :: x, y
end type
contains
subroutine print( point )
class(point2d) :: point
write(*,'(2f10.4)') point%x, point%y
end subroutine
subroutine random_vector( point )
class(point2d) :: point
call random_number( point%x )
call random_number( point%y )
point%x = 2.0 * (point%x - 0.5)
point%y = 2.0 * (point%y - 0.5)
end subroutine
function add_vector( point, vector )
class(point2d), intent(in) :: point, vector
class(point2d), allocatable :: add_vector
allocate( add_vector )
add_vector%x = point%x + vector%x
add_vector%y = point%y + vector%y
end function
end module points2d
program random_walk
use points2d
implicit none
type(point2d), target :: point_2d, vector_2d
class(point2d), pointer :: point, vector
integer :: i
point => point_2d
vector => vector_2d
do i=1,2
call random_vector(point)
call random_vector(vector)
call print(add_vector(point, vector))
end do
end program random_walk