Subversion Repositories openrisc

! { 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 

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

! { dg-final { cleanup-modules "points2d" } }