1! { dg-do run }
2! { dg-options "-fcheck=all" }
3!
4! PR 50225: [OOP] The allocation status for polymorphic allocatable function results is not set properly
5!
6! Contributed by Arjen Markus <arjen.markus895@gmail.com>
7
8module points2d
9
10  implicit none
11
12  type point2d
13      real :: x, y
14  end type
15
16contains
17
18 subroutine print( point )
19   class(point2d) :: point
20   write(*,'(2f10.4)') point%x, point%y
21 end subroutine
22
23 subroutine random_vector( point )
24   class(point2d) :: point
25   call random_number( point%x )
26   call random_number( point%y )
27   point%x = 2.0 * (point%x - 0.5)
28   point%y = 2.0 * (point%y - 0.5)
29 end subroutine
30
31 function add_vector( point, vector )
32   class(point2d), intent(in)  :: point, vector
33   class(point2d), allocatable :: add_vector
34   allocate( add_vector )
35   add_vector%x = point%x + vector%x
36   add_vector%y = point%y + vector%y
37 end function
38
39end module points2d
40
41
42program random_walk
43
44  use points2d
45  implicit none
46
47  type(point2d), target   :: point_2d, vector_2d
48  class(point2d), pointer :: point, vector
49  integer :: i
50
51  point  => point_2d
52  vector => vector_2d
53
54  do i=1,2
55    call random_vector(point)
56    call random_vector(vector)
57    call print(add_vector(point, vector))
58  end do
59
60end program random_walk
61