blob: e6181a4d337f8ae634c691e9603de16320b4e6bb (
plain)
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
|
! { dg-do run }
!
! PR fortran/51514
!
! Check that passing a CLASS to a TYPE works
!
! Based on a test case of Reinhold Bader.
!
module mod_subpr
implicit none
type :: foo
integer :: i = 2
end type
type, extends(foo) :: foo_1
real :: r(2)
end type
contains
subroutine subpr (x)
type(foo) :: x
x%i = 3
end subroutine
elemental subroutine subpr_elem (x)
type(foo), intent(inout):: x
x%i = 3
end subroutine
subroutine subpr_array (x)
type(foo), intent(inout):: x(:)
x(:)%i = 3
end subroutine
subroutine subpr2 (x)
type(foo) :: x
if (x%i /= 55) call abort ()
end subroutine
subroutine subpr2_array (x)
type(foo) :: x(:)
if (any(x(:)%i /= 55)) call abort ()
end subroutine
function f ()
class(foo), allocatable :: f
allocate (f)
f%i = 55
end function f
function g () result(res)
class(foo), allocatable :: res(:)
allocate (res(3))
res(:)%i = 55
end function g
end module
program prog
use mod_subpr
implicit none
class(foo), allocatable :: xx, yy(:)
allocate (foo_1 :: xx)
xx%i = 33
call subpr (xx)
if (xx%i /= 3) call abort ()
xx%i = 33
call subpr_elem (xx)
if (xx%i /= 3) call abort ()
call subpr (f ())
allocate (foo_1 :: yy(2))
yy(:)%i = 33
call subpr_elem (yy)
if (any (yy%i /= 3)) call abort ()
yy(:)%i = 33
call subpr_elem (yy(1))
if (yy(1)%i /= 3) call abort ()
yy(:)%i = 33
call subpr_array (yy)
if (any (yy%i /= 3)) call abort ()
yy(:)%i = 33
call subpr_array (yy(1:2))
if (any (yy(1:2)%i /= 3)) call abort ()
call subpr2_array (g ())
end program
|
