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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
! { dg-do run }
!
! Passing CLASS to TYPE
!
implicit none
type t
integer :: A
real, allocatable :: B(:)
end type t
type, extends(t) :: t2
complex :: z = cmplx(3.3, 4.4)
end type t2
integer :: i
class(t), allocatable :: x(:)
allocate(t2 :: x(10))
select type(x)
type is(t2)
if (size (x) /= 10) call abort ()
x = [(t2(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
if (x(i)%z /= cmplx(3.3, 4.4)) call abort()
end do
class default
call abort()
end select
call base(x)
call baseExplicit(x, size(x))
call class(x)
call classExplicit(x, size(x))
contains
subroutine base(y)
type(t) :: y(:)
if (size (y) /= 10) call abort ()
do i = 1, 10
if (y(i)%a /= -i .or. size (y(i)%b) /= 4 &
.or. any (y(i)%b /= [1*i,2*i,3*i,4*i])) then
call abort()
end if
end do
end subroutine base
subroutine baseExplicit(v, n)
integer, intent(in) :: n
type(t) :: v(n)
if (size (v) /= 10) call abort ()
do i = 1, 10
if (v(i)%a /= -i .or. size (v(i)%b) /= 4 &
.or. any (v(i)%b /= [1*i,2*i,3*i,4*i])) then
call abort()
end if
end do
end subroutine baseExplicit
subroutine class(z)
class(t), intent(in) :: z(:)
select type(z)
type is(t2)
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
if (z(i)%z /= cmplx(3.3, 4.4)) call abort()
end do
class default
call abort()
end select
call base(z)
call baseExplicit(z, size(z))
end subroutine class
subroutine classExplicit(u, n)
integer, intent(in) :: n
class(t), intent(in) :: u(n)
select type(u)
type is(t2)
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
if (u(i)%z /= cmplx(3.3, 4.4)) call abort()
end do
class default
call abort()
end select
call base(u)
call baseExplicit(u, n)
end subroutine classExplicit
end
|
