1! { dg-do run }
2!
3! PR fortran/51514
4!
5! Check that passing a CLASS to a TYPE works
6!
7! Based on a test case of Reinhold Bader.
8!
9
10module mod_subpr
11  implicit none
12
13  type :: foo
14    integer :: i = 2
15  end type
16
17  type, extends(foo) :: foo_1
18    real :: r(2)
19  end type
20
21contains
22
23  subroutine subpr (x)
24    type(foo) :: x
25    x%i = 3
26  end subroutine
27
28  elemental subroutine subpr_elem (x)
29    type(foo), intent(inout):: x
30    x%i = 3
31  end subroutine
32
33  subroutine subpr_array (x)
34    type(foo), intent(inout):: x(:)
35    x(:)%i = 3
36  end subroutine
37
38  subroutine subpr2 (x)
39    type(foo) :: x
40    if (x%i /= 55) call abort ()
41  end subroutine
42
43  subroutine subpr2_array (x)
44    type(foo) :: x(:)
45    if (any(x(:)%i /= 55)) call abort ()
46  end subroutine
47
48  function f ()
49    class(foo), allocatable :: f
50    allocate (f)
51    f%i = 55
52  end function f
53
54  function g () result(res)
55    class(foo), allocatable :: res(:)
56    allocate (res(3))
57    res(:)%i = 55
58  end function g
59end module
60
61program prog
62  use mod_subpr
63  implicit none
64  class(foo), allocatable :: xx, yy(:)
65
66  allocate (foo_1 :: xx)
67  xx%i = 33
68  call subpr (xx)
69  if (xx%i /= 3) call abort ()
70
71  xx%i = 33
72  call subpr_elem (xx)
73  if (xx%i /= 3) call abort ()
74
75  call subpr (f ())
76
77  allocate (foo_1 :: yy(2))
78  yy(:)%i = 33
79  call subpr_elem (yy)
80  if (any (yy%i /= 3)) call abort ()
81
82  yy(:)%i = 33
83  call subpr_elem (yy(1))
84  if (yy(1)%i /= 3) call abort ()
85
86  yy(:)%i = 33
87  call subpr_array (yy)
88  if (any (yy%i /= 3)) call abort ()
89
90  yy(:)%i = 33
91  call subpr_array (yy(1:2))
92  if (any (yy(1:2)%i /= 3)) call abort ()
93
94 call subpr2_array (g ())
95end program
96