1! { dg-do run }
2! { dg-options "-finit-derived -finit-integer=1" }
3!
4! Make sure -finit-derived works on class variables.
5! Based on class_result_1.f03
6!
7
8module points_2i
9
10  implicit none
11
12  type point2i
13      integer :: x, y
14  end type
15
16contains
17
18 subroutine print( point )
19   class(point2i) :: point
20   write(*,'(2i4)') point%x, point%y
21 end subroutine
22
23 subroutine set_vector( point, rx, ry )
24   class(point2i) :: point
25   integer :: rx, ry
26   point%x = rx
27   point%y = ry
28 end subroutine
29
30 function add_vector( point, vector )
31   class(point2i), intent(in)  :: point, vector
32   class(point2i), allocatable :: add_vector
33   allocate( add_vector )
34   add_vector%x = point%x + vector%x
35   add_vector%y = point%y + vector%y
36 end function
37
38end module
39
40
41program init_flag_15
42
43  use points_2i
44  implicit none
45
46  type(point2i), target   :: point_2i, vector_2i
47  class(point2i), pointer :: point, vector
48  type(point2i) :: vsum
49  integer :: i
50
51  point  => point_2i ! = (1, 1) due to -finit-integer
52  vector => vector_2i
53  call set_vector(vector, 2, 2)
54  vsum = add_vector(point, vector)
55
56  call print(point)
57  call print(vector)
58  call print(vsum)
59
60  if (vsum%x .ne. 3 .or. vsum%y .ne. 3) then
61    STOP 1
62  endif
63
64end program
65