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
|
! RUN: %python %S/test_errors.py %s %flang_fc1
! Check for semantic errors in ALLOCATE statements
subroutine C945_a(srca, srcb, srcc, src_complex, src_logical, &
srca2, srcb2, srcc2, src_complex2, srcx, srcx2)
! If type-spec appears, it shall specify a type with which each
! allocate-object is type compatible.
!second part C945, specific to SOURCE, is not checked here.
type A
integer i
end type
type, extends(A) :: B
real, allocatable :: x(:)
end type
type, extends(B) :: C
character(5) s
end type
type Unrelated
class(A), allocatable :: polymorph
type(A), allocatable :: notpolymorph
end type
real srcx, srcx2(6)
class(A) srca, srca2(5)
type(B) srcb, srcb2(6)
class(C) srcc, srcc2(7)
complex src_complex, src_complex2(8)
complex src_logical(5)
real, allocatable :: x1, x2(:)
class(A), allocatable :: aa1, aa2(:)
class(B), pointer :: bp1, bp2(:)
class(C), allocatable :: ca1, ca2(:)
class(*), pointer :: up1, up2(:)
type(A), allocatable :: npaa1, npaa2(:)
type(B), pointer :: npbp1, npbp2(:)
type(C), allocatable :: npca1, npca2(:)
class(Unrelated), allocatable :: unrelat
allocate(x1, source=srcx)
allocate(x2, mold=srcx2)
allocate(bp2(3)%x, source=srcx2)
!OK, type-compatible with A
allocate(aa1, up1, unrelat%polymorph, unrelat%notpolymorph, &
npaa1, source=srca)
allocate(aa2, up2, npaa2, source=srca2)
!OK, type compatible with B
allocate(aa1, up1, unrelat%polymorph, bp1, npbp1, mold=srcb)
allocate(aa2, up2, bp2, npbp2, mold=srcb2)
!OK, type compatible with C
allocate(aa1, up1, unrelat%polymorph, bp1, ca1, npca1, mold=srcc)
allocate(aa2, up2, bp2, ca2, npca2, source=srcc2)
!ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
allocate(x1, mold=src_complex)
!ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
allocate(x2(2), source=src_complex2)
!ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
allocate(bp2(3)%x, mold=src_logical)
!ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
allocate(unrelat, mold=srca)
!ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
allocate(unrelat%notpolymorph, source=srcb)
!ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
allocate(npaa1, mold=srcb)
!ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
allocate(npaa2, source=srcb2)
!ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
allocate(npca1, bp1, npbp1, mold=srcc)
end subroutine
module m
type :: t
real x(100)
contains
procedure :: f
end type
contains
function f(this) result (x)
class(t) :: this
class(t), allocatable :: x
end function
subroutine bar
type(t) :: o
type(t), allocatable :: p
real, allocatable :: rp
allocate(p, source=o%f())
!ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
allocate(rp, source=o%f())
end subroutine
end module
module mod1
type, bind(C) :: t
integer :: n
end type
type(t), allocatable :: x
end
module mod2
type, bind(C) :: t
integer :: n
end type
type(t), allocatable :: x
end
module mod3
type, bind(C) :: t
real :: a
end type
type(t), allocatable :: x
end
subroutine same_type
use mod1, only: a => x
use mod2, only: b => x
use mod3, only: c => x
allocate(a)
allocate(b, source=a) ! ok
deallocate(a)
allocate(a, source=b) ! ok
!ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
allocate(c, source=a)
deallocate(a)
!ERROR: Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE
allocate(a, source=c)
end
! Related to C945, check typeless expression are caught
subroutine sub
end subroutine
function func() result(x)
real :: x
end function
program test_typeless
class(*), allocatable :: x
interface
subroutine sub
end subroutine
real function func()
end function
end interface
procedure (sub), pointer :: subp => sub
procedure (func), pointer :: funcp => func
! OK
allocate(x, mold=func())
allocate(x, source=funcp())
!ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE
allocate(x, mold=x'1')
!ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE
allocate(x, mold=sub)
!ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE
allocate(x, source=subp)
!ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE
allocate(x, mold=func)
!ERROR: Typeless item not allowed as SOURCE or MOLD in ALLOCATE
allocate(x, source=funcp)
end program
|
