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
61
62
63
64
65
|
! { dg-do run }
!
! Passing TYPE to CLASS
!
implicit none
type t
integer :: A
real, allocatable :: B(:)
end type t
type(t), allocatable :: x(:)
type(t) :: y(10)
integer :: i
allocate(x(10))
if (size (x) /= 10) call abort ()
x = [(t(a=-i, B=[1*i,2*i,3*i,4*i]), i = 1, 10)]
do i = 1, 10
if (x(i)%a /= -i .or. size (x(i)%b) /= 4 &
.or. any (x(i)%b /= [1*i,2*i,3*i,4*i])) then
call abort()
end if
end do
y = x ! TODO: Segfaults in runtime without 'y' being set
call class(x)
call classExplicit(x, size(x))
call class(y)
call classExplicit(y, size(y))
contains
subroutine class(z)
class(t), intent(in) :: z(:)
select type(z)
type is(t)
if (size (z) /= 10) call abort ()
do i = 1, 10
if (z(i)%a /= -i .or. size (z(i)%b) /= 4 &
.or. any (z(i)%b /= [1*i,2*i,3*i,4*i])) then
call abort()
end if
end do
class default
call abort()
end select
end subroutine class
subroutine classExplicit(u, n)
integer, intent(in) :: n
class(t), intent(in) :: u(n)
select type(u)
type is(t)
if (size (u) /= 10) call abort ()
do i = 1, 10
if (u(i)%a /= -i .or. size (u(i)%b) /= 4 &
.or. any (u(i)%b /= [1*i,2*i,3*i,4*i])) then
call abort()
end if
end do
class default
call abort()
end select
end subroutine classExplicit
end
|
