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
PR tree-optimization/86415 - strlen() not folded for substrings within constant arrays
[official-gcc.git]
/
gcc
/
testsuite
/
gfortran.dg
/
select_type_5.f03
blob
5b897de21a83f08cb8c2421a447878a24a3ee5dd
1
! { dg-do run }
2
!
3
! SELECT TYPE with associate-name
4
!
5
! Contributed by Janus Weil <janus@gcc.gnu.org>
6
7
type :: t1
8
integer :: i = -1
9
class(t1), pointer :: c
10
end type t1
11
12
type, extends(t1) :: t2
13
integer :: j = -1
14
end type t2
15
16
type(t2), target :: b
17
integer :: aa
18
19
b%c => b
20
aa = 5
21
22
select type (aa => b%c)
23
type is (t1)
24
aa%i = 1
25
type is (t2)
26
aa%j = 2
27
end select
28
29
print *,b%i,b%j
30
if (b%i /= -1) STOP 1
31
if (b%j /= 2) STOP 2
32
33
select type (aa => b%c)
34
type is (t1)
35
aa%i = 4
36
type is (t2)
37
aa%i = 3*aa%j
38
end select
39
40
print *,b%i,b%j
41
if (b%i /= 6) STOP 3
42
if (b%j /= 2) STOP 4
43
44
print *,aa
45
if (aa/=5) STOP 5
46
47
end