repo.or.cz
/
official-gcc.git
/
blob
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
log
|
graphiclog1
|
graphiclog2
|
commit
|
commitdiff
|
tree
|
refs
|
edit
|
fork
blame
|
history
|
raw
|
HEAD
aarch64: Add missing ACLE macro for NEON-SVE Bridge
[official-gcc.git]
/
gcc
/
testsuite
/
gfortran.dg
/
select_type_8.f03
blob
996e98129585825985b25df38d92a22abc4d44b8
1
! { dg-do run }
2
!
3
! executing SELECT TYPE statements with CLASS IS blocks
4
!
5
! Contributed by Janus Weil <janus@gcc.gnu.org>
6
7
implicit none
8
9
type :: t1
10
integer :: i
11
end type t1
12
13
type, extends(t1) :: t2
14
integer :: j
15
end type t2
16
17
type, extends(t2) :: t3
18
real :: r
19
end type
20
21
class(t1), pointer :: cp
22
type(t1), target :: a
23
type(t2), target :: b
24
type(t3), target :: c
25
integer :: i
26
27
cp => c
28
i = 0
29
select type (cp)
30
type is (t1)
31
i = 1
32
type is (t2)
33
i = 2
34
class is (t1)
35
i = 3
36
class default
37
i = 4
38
end select
39
print *,i
40
if (i /= 3) STOP 1
41
42
cp => a
43
select type (cp)
44
type is (t1)
45
i = 1
46
type is (t2)
47
i = 2
48
class is (t1)
49
i = 3
50
end select
51
print *,i
52
if (i /= 1) STOP 2
53
54
cp => b
55
select type (cp)
56
type is (t1)
57
i = 1
58
class is (t3)
59
i = 3
60
class is (t2)
61
i = 4
62
class is (t1)
63
i = 5
64
end select
65
print *,i
66
if (i /= 4) STOP 3
67
68
cp => b
69
select type (cp)
70
type is (t1)
71
i = 1
72
class is (t1)
73
i = 5
74
class is (t2)
75
i = 4
76
class is (t3)
77
i = 3
78
end select
79
print *,i
80
if (i /= 4) STOP 4
81
82
cp => a
83
select type (cp)
84
type is (t2)
85
i = 1
86
class is (t2)
87
i = 2
88
class default
89
i = 3
90
class is (t3)
91
i = 4
92
type is (t3)
93
i = 5
94
end select
95
print *,i
96
if (i /= 3) STOP 5
97
98
end