aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/gfortran.dg/class_result_1.f03
blob: 011878e958719bc9817fd2e4ca25219f90c6ab92 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
! { 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