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