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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
|
implicit none
type t2
integer :: x
end type t2
type, extends(t2) :: t2e
integer :: y
end type t2e
type t
class(*), allocatable :: au, au2(:,:)
class(t2), allocatable :: at, at2(:,:)
end type t
type(t), target :: var, var0, var2(4), var2a(4)
class(*), allocatable :: au, au2(:,:)
class(t2), allocatable :: at, at2(:,:)
if (same_type_as (var%au, var%at)) error stop 1
if (same_type_as (var%au2, var%at)) error stop 2
if (same_type_as (var%au, var%at)) error stop 3
! Note: class(*) has no declared type, hence .false.
if (same_type_as (var%au, var0%au)) error stop 4
if (same_type_as (var%au2, var0%au2)) error stop 5
if (same_type_as (var%au, var0%au2)) error stop 6
call c1(var%au, var%au, var%au2)
if (.not.same_type_as (var%at, var%at)) error stop 7
if (.not.same_type_as (var%at2, var%at)) error stop 8
if (.not.same_type_as (var%at, var%at2)) error stop 9
if (.not.extends_type_of (var%at, var%at)) error stop 10
if (.not.extends_type_of (var%at2, var%at)) error stop 11
if (.not.extends_type_of (var%at, var%at2)) error stop 12
if (same_type_as (var%at, var0%au)) error stop 13
if (same_type_as (var%at2, var0%au2)) error stop 14
if (same_type_as (var%at, var0%au2)) error stop 15
call c2(var%at, var%at, var%at2)
if (same_type_as (au, var%at)) error stop 16
if (same_type_as (au2, var%at)) error stop 17
if (same_type_as (au, var%at)) error stop 18
! Note: class(*) has no declared type, hence .false.
if (same_type_as (au, var0%au)) error stop 19
if (same_type_as (au2, var0%au2)) error stop 20
if (same_type_as (au, var0%au2)) error stop 21
call c1(au, var%au, var%au2)
if (.not.same_type_as (at, var%at)) error stop 22
if (.not.same_type_as (at2, var%at)) error stop 23
if (.not.same_type_as (at, var%at2)) error stop 24
if (.not.extends_type_of (at, var%at)) error stop 25
if (.not.extends_type_of (at2, var%at)) error stop 26
if (.not.extends_type_of (at, var%at2)) error stop 27
if (same_type_as (at, var0%au)) error stop 28
if (same_type_as (at2, var0%au2)) error stop 29
if (same_type_as (at, var0%au2)) error stop 30
call c2(var%at, var%at, var%at2)
if (same_type_as (var%au, at)) error stop 31
if (same_type_as (var%au2, at)) error stop 32
if (same_type_as (var%au, at)) error stop 33
! Note: class(*) has no declared type, hence .false.
if (same_type_as (var%au, au)) error stop 34
if (same_type_as (var%au2, au2)) error stop 35
if (same_type_as (var%au, au2)) error stop 36
call c1(var%au, var%au, au2)
if (.not.same_type_as (var%at, at)) error stop 37
if (.not.same_type_as (var%at2, at)) error stop 38
if (.not.same_type_as (var%at, at2)) error stop 39
if (.not.extends_type_of (var%at, at)) error stop 40
if (.not.extends_type_of (var%at2, at)) error stop 41
if (.not.extends_type_of (var%at, at2)) error stop 42
if (same_type_as (var%at, au)) error stop 43
if (same_type_as (var%at2, au2)) error stop 44
if (same_type_as (var%at, au2)) error stop 45
call c2(var%at, var%at, at2)
allocate(t2e :: var0%at, var0%at2(4,4))
allocate(t2 :: var0%au, var0%au2(4,4))
if (.not.same_type_as (var0%au, var%at)) error stop 46
if (.not.same_type_as (var0%au2, var%at)) error stop 47
if (.not.same_type_as (var0%au, var%at)) error stop 48
if (.not.same_type_as (var0%au, var0%au2)) error stop 49
if (.not.same_type_as (var0%au2, var0%au2)) error stop 50
if (.not.same_type_as (var0%au, var0%au2)) error stop 51
if (.not.extends_type_of (var0%au, var%at)) error stop 52
if (.not.extends_type_of (var0%au2, var%at)) error stop 53
if (.not.extends_type_of (var0%au, var%at)) error stop 54
if (.not.extends_type_of (var0%au, var0%au2)) error stop 55
if (.not.extends_type_of (var0%au2, var0%au2)) error stop 56
if (.not.extends_type_of (var0%au, var0%au2)) error stop 57
if (.not.same_type_as (var0%au, at)) error stop 58
if (.not.same_type_as (var0%au2, at)) error stop 59
if (.not.same_type_as (var0%au, at2)) error stop 60
if (.not.extends_type_of (var0%au, at)) error stop 61
if (.not.extends_type_of (var0%au2, at)) error stop 62
if (.not.extends_type_of (var0%au, at2)) error stop 63
if (same_type_as (var0%at, var%at)) error stop 64
if (same_type_as (var0%at2, var%at)) error stop 65
if (same_type_as (var0%at, var%at)) error stop 66
if (same_type_as (var0%at, var0%au2)) error stop 67
if (same_type_as (var0%at2, var0%au2)) error stop 68
if (same_type_as (var0%at, var0%au2)) error stop 69
if (.not.extends_type_of (var0%at, var%at)) error stop 70
if (.not.extends_type_of (var0%at2, var%at)) error stop 71
if (.not.extends_type_of (var0%at, var%at)) error stop 72
if (.not.extends_type_of (var0%at, var0%au2)) error stop 73
if (.not.extends_type_of (var0%at2, var0%au2)) error stop 74
if (.not.extends_type_of (var0%at, var0%au2)) error stop 75
if (same_type_as (var0%at, at)) error stop 76
if (same_type_as (var0%at2, at)) error stop 77
if (same_type_as (var0%at, at2)) error stop 78
if (.not.extends_type_of (var0%at, at)) error stop 79
if (.not.extends_type_of (var0%at2, at)) error stop 80
if (.not.extends_type_of (var0%at, at2)) error stop 81
call c3(var0%au, var0%au2, var0%at, var0%at2)
call c4(var0%au, var0%au2, var0%at, var0%at2)
contains
subroutine c1(x, y, z)
class(*) :: x, y(..), z(..)
if (same_type_as (x, var0%at)) error stop 82
if (same_type_as (y, var0%at)) error stop 83
if (same_type_as (z, var0%at)) error stop 84
if (same_type_as (x, var%au)) error stop 85
if (same_type_as (y, var%au2)) error stop 86
if (same_type_as (z, var%au2)) error stop 87
if (same_type_as (x, at)) error stop 88
if (same_type_as (y, at)) error stop 89
if (same_type_as (z, at)) error stop 90
if (same_type_as (x, au)) error stop 91
if (same_type_as (y, au2)) error stop 92
if (same_type_as (z, au2)) error stop 93
end
subroutine c2(x, y, z)
class(*) :: x, y(..), z(..)
if (.not.same_type_as (x, var0%at)) error stop 94
if (.not.same_type_as (y, var0%at)) error stop 95
if (.not.same_type_as (z, var0%at)) error stop 96
if (.not.extends_type_of (x, var0%at)) error stop 97
if (.not.extends_type_of (y, var0%at)) error stop 98
if (.not.extends_type_of (z, var0%at)) error stop 99
if (same_type_as (x, var%au)) error stop 100
if (same_type_as (y, var%au2)) error stop 101
if (same_type_as (z, var%au2)) error stop 102
if (.not.same_type_as (x, at)) error stop 103
if (.not.same_type_as (y, at)) error stop 104
if (.not.same_type_as (z, at)) error stop 105
if (.not.extends_type_of (x, at)) error stop 106
if (.not.extends_type_of (y, at)) error stop 107
if (.not.extends_type_of (z, at)) error stop 108
if (same_type_as (x, au)) error stop 109
if (same_type_as (y, au2)) error stop 110
if (same_type_as (z, au2)) error stop 111
end
subroutine c3(mau, mau2, mat, mat2)
class(*) :: mau, mau2(:,:), mat, mat2(:,:)
if (.not.same_type_as (mau, var%at)) error stop 112
if (.not.same_type_as (mau2, var%at)) error stop 113
if (.not.same_type_as (mau, var%at)) error stop 114
if (.not.same_type_as (mau, var0%au2)) error stop 115
if (.not.same_type_as (mau2, var0%au2)) error stop 116
if (.not.same_type_as (mau, var0%au2)) error stop 117
if (.not.extends_type_of (mau, var%at)) error stop 118
if (.not.extends_type_of (mau2, var%at)) error stop 119
if (.not.extends_type_of (mau, var%at)) error stop 120
if (.not.extends_type_of (mau, var0%au2)) error stop 121
if (.not.extends_type_of (mau2, var0%au2)) error stop 122
if (.not.extends_type_of (mau, var0%au2)) error stop 123
if (.not.same_type_as (mau, at)) error stop 124
if (.not.same_type_as (mau2, at)) error stop 125
if (.not.same_type_as (mau, at2)) error stop 126
if (.not.extends_type_of (mau, at)) error stop 127
if (.not.extends_type_of (mau2, at)) error stop 128
if (.not.extends_type_of (mau, at2)) error stop 129
if (same_type_as (mat, var%at)) error stop 130
if (same_type_as (mat2, var%at)) error stop 131
if (same_type_as (mat, var%at)) error stop 132
if (same_type_as (mat, var0%au2)) error stop 133
if (same_type_as (mat2, var0%au2)) error stop 134
if (same_type_as (mat, var0%au2)) error stop 135
if (.not.extends_type_of (mat, var%at)) error stop 136
if (.not.extends_type_of (mat2, var%at)) error stop 137
if (.not.extends_type_of (mat, var%at)) error stop 138
if (.not.extends_type_of (mat, var0%au2)) error stop 139
if (.not.extends_type_of (mat2, var0%au2)) error stop 140
if (.not.extends_type_of (mat, var0%au2)) error stop 141
if (same_type_as (mat, at)) error stop 142
if (same_type_as (mat2, at)) error stop 143
if (same_type_as (mat, at2)) error stop 144
if (.not.extends_type_of (mat, at)) error stop 145
if (.not.extends_type_of (mat2, at)) error stop 147
if (.not.extends_type_of (mat, at2)) error stop 148
end
subroutine c4(mau, mau2, mat, mat2)
class(*) :: mau(..), mau2(..), mat(..), mat2(..)
if (.not.same_type_as (mau, var%at)) error stop 149
if (.not.same_type_as (mau2, var%at)) error stop 150
if (.not.same_type_as (mau, var%at)) error stop 151
if (.not.same_type_as (mau, var0%au2)) error stop 152
if (.not.same_type_as (mau2, var0%au2)) error stop 153
if (.not.same_type_as (mau, var0%au2)) error stop 154
if (.not.extends_type_of (mau, var%at)) error stop 155
if (.not.extends_type_of (mau2, var%at)) error stop 156
if (.not.extends_type_of (mau, var%at)) error stop 157
if (.not.extends_type_of (mau, var0%au2)) error stop 158
if (.not.extends_type_of (mau2, var0%au2)) error stop 159
if (.not.extends_type_of (mau, var0%au2)) error stop 160
if (.not.same_type_as (mau, at)) error stop 161
if (.not.same_type_as (mau2, at)) error stop 162
if (.not.same_type_as (mau, at2)) error stop 163
if (.not.extends_type_of (mau, at)) error stop 164
if (.not.extends_type_of (mau2, at)) error stop 165
if (.not.extends_type_of (mau, at2)) error stop 166
if (same_type_as (mat, var%at)) error stop 167
if (same_type_as (mat2, var%at)) error stop 168
if (same_type_as (mat, var%at)) error stop 169
if (same_type_as (mat, var0%au2)) error stop 170
if (same_type_as (mat2, var0%au2)) error stop 171
if (same_type_as (mat, var0%au2)) error stop 172
if (.not.extends_type_of (mat, var%at)) error stop 173
if (.not.extends_type_of (mat2, var%at)) error stop 174
if (.not.extends_type_of (mat, var%at)) error stop 175
if (.not.extends_type_of (mat, var0%au2)) error stop 176
if (.not.extends_type_of (mat2, var0%au2)) error stop 178
if (.not.extends_type_of (mat, var0%au2)) error stop 179
if (same_type_as (mat, at)) error stop 180
if (same_type_as (mat2, at)) error stop 181
if (same_type_as (mat, at2)) error stop 182
if (.not.extends_type_of (mat, at)) error stop 183
if (.not.extends_type_of (mat2, at)) error stop 184
if (.not.extends_type_of (mat, at2)) error stop 185
end
end
|
