1! { dg-do run }
2!
3! Passing TYPE to CLASS
4!
5implicit none
6type t
7  integer :: A
8  real, allocatable :: B(:)
9end type t
10
11type(t), allocatable :: x(:)
12type(t) :: y(10)
13integer :: i
14
15allocate(x(10))
16if (size (x) /= 10) call abort ()
17x = [(t(a=-i, B=[1*i,2*i,3*i,4*i]), i = 1, 10)]
18do i = 1, 10
19  if (x(i)%a /= -i .or. size (x(i)%b) /= 4 &
20      .or. any (x(i)%b /= [1*i,2*i,3*i,4*i])) then
21      call abort()
22  end if
23end do
24
25y = x ! TODO: Segfaults in runtime without 'y' being set
26
27call class(x)
28call classExplicit(x, size(x))
29call class(y)
30call classExplicit(y, size(y))
31
32contains
33  subroutine class(z)
34    class(t), intent(in) :: z(:)
35    select type(z)
36     type is(t)
37      if (size (z) /= 10) call abort ()
38      do i = 1, 10
39        if (z(i)%a /= -i .or. size (z(i)%b) /= 4 &
40            .or. any (z(i)%b /= [1*i,2*i,3*i,4*i])) then
41            call abort()
42        end if
43      end do
44      class default
45        call abort()
46    end select
47  end subroutine class
48  subroutine classExplicit(u, n)
49    integer, intent(in) :: n
50    class(t), intent(in) :: u(n)
51    select type(u)
52     type is(t)
53      if (size (u) /= 10) call abort ()
54      do i = 1, 10
55        if (u(i)%a /= -i .or. size (u(i)%b) /= 4 &
56            .or. any (u(i)%b /= [1*i,2*i,3*i,4*i])) then
57            call abort()
58        end if
59      end do
60      class default
61        call abort()
62    end select
63  end subroutine classExplicit
64end
65
66