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
|
! { dg-do compile }
! { dg-additional-options "-fcoarray=single" }
!
! PR fortran/106856
!
! Contributed by G. Steinmetz
!
subroutine foo
interface
subroutine bar(x)
type(*) :: x
end subroutine bar
end interface
class(*) :: x, y
allocatable :: x
dimension :: x(:), y(:,:)
codimension :: x[:]
pointer :: y
y => null()
if (allocated(x)) then
call bar(x(2)[1])
end if
if (associated(y)) then
call bar(y(2,2))
end if
end subroutine foo
program p
class(*), allocatable :: x, y
y = 'abc'
call s1(x, y)
contains
subroutine s1(x, y)
class(*) :: x, y
end
subroutine s2(x, y)
class(*), allocatable :: x, y
optional :: x
end
end
subroutine s1 (x)
class(*) :: x
allocatable :: x
dimension :: x(:)
if (allocated (x)) print *, size (x)
end
subroutine s2 (x)
class(*) :: x
allocatable :: x(:)
if (allocated (x)) print *, size (x)
end
subroutine s3 (x)
class(*) :: x(:)
allocatable :: x
if (allocated (x)) print *, size (x)
end
subroutine s4 (x)
class(*) :: x
dimension :: x(:)
allocatable :: x
if (allocated (x)) print *, size (x)
end
subroutine c0 (x)
class(*) :: x
allocatable :: x
codimension :: x[:]
dimension :: x(:)
if (allocated (x)) print *, size (x)
end
subroutine c1 (x)
class(*) :: x(:)
allocatable :: x[:]
if (allocated (x)) print *, size (x)
end
subroutine c2 (x)
class(*) :: x[:]
allocatable :: x(:)
if (allocated (x)) print *, size (x)
end
subroutine c3 (x)
class(*) :: x(:)[:]
allocatable :: x
if (allocated (x)) print *, size (x)
end
subroutine c4 (x)
class(*) :: x
dimension :: x(:)
codimension :: x[:]
allocatable :: x
if (allocated (x)) print *, size (x)
end
subroutine p1 (x)
class(*) :: x
pointer :: x
dimension :: x(:)
if (associated (x)) print *, size (x)
end
subroutine p2 (x)
class(*) :: x
pointer :: x(:)
if (associated (x)) print *, size (x)
end
subroutine p3 (x)
class(*) :: x(:)
pointer :: x
if (associated (x)) print *, size (x)
end
subroutine p4 (x)
class(*) :: x
dimension :: x(:)
pointer :: x
if (associated (x)) print *, size (x)
end
! Testcase by Mikael Morin
subroutine mm ()
pointer :: y
dimension :: y(:,:)
class(*) :: y
if (associated (y)) print *, size (y)
end
! Testcase from pr53951
subroutine pr53951 ()
type t
end type t
class(t), pointer :: C
TARGET :: A
class(t), allocatable :: A, B
TARGET :: B
C => A ! Valid
C => B ! Valid, but was rejected
end
|
