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
|
! RUN: %S/test_errors.sh %s %t %f18
! Test 15.7 (C1583-C1590, C1592-C1599) constraints and restrictions
! for pure procedures.
! (C1591 is tested in call11.f90; C1594 in call12.f90.)
module m
type :: impureFinal
contains
final :: impure
end type
type :: t
end type
type :: polyAlloc
class(t), allocatable :: a
end type
real, volatile, target :: volatile
contains
subroutine impure(x)
type(impureFinal) :: x
end subroutine
integer impure function notpure(n)
integer, value :: n
notpure = n
end function
pure real function f01(a)
real, intent(in) :: a ! ok
end function
pure real function f02(a)
real, value :: a ! ok
end function
pure real function f03(a) ! C1583
!ERROR: non-POINTER dummy argument of pure function must be INTENT(IN) or VALUE
real :: a
end function
pure real function f03a(a)
real, pointer :: a ! ok
end function
pure real function f04(a) ! C1583
!ERROR: non-POINTER dummy argument of pure function must be INTENT(IN) or VALUE
real, intent(out) :: a
end function
pure real function f04a(a)
real, pointer, intent(out) :: a ! ok if pointer
end function
pure real function f05(a) ! C1583
real, value :: a ! weird, but ok (VALUE without INTENT)
end function
pure function f06() ! C1584
!ERROR: Result of pure function may not have an impure FINAL subroutine
type(impureFinal) :: f06
end function
pure function f07() ! C1585
!ERROR: Result of pure function may not be both polymorphic and ALLOCATABLE
class(t), allocatable :: f07
end function
pure function f08() ! C1585
!ERROR: Result of pure function may not have polymorphic ALLOCATABLE ultimate component '%a'
type(polyAlloc) :: f08
end function
pure subroutine s01(a) ! C1586
!ERROR: non-POINTER dummy argument of pure subroutine must have INTENT() or VALUE attribute
real :: a
end subroutine
pure subroutine s01a(a)
real, pointer :: a
end subroutine
pure subroutine s02(a) ! C1587
!ERROR: An INTENT(OUT) dummy argument of a pure subroutine may not have an impure FINAL subroutine
type(impureFinal), intent(out) :: a
end subroutine
pure subroutine s03(a) ! C1588
!ERROR: An INTENT(OUT) dummy argument of a pure subroutine may not be polymorphic
class(t), intent(out) :: a
end subroutine
pure subroutine s04(a) ! C1588
!ERROR: An INTENT(OUT) dummy argument of a pure subroutine may not have a polymorphic ultimate component
type(polyAlloc), intent(out) :: a
end subroutine
pure subroutine s05 ! C1589
!ERROR: A pure subprogram may not have a variable with the SAVE attribute
real, save :: v1
!ERROR: A pure subprogram may not have a variable with the SAVE attribute
real :: v2 = 0.
!TODO: once we have DATA: !ERROR: A pure subprogram may not have a variable with the SAVE attribute
real :: v3
data v3/0./
!ERROR: A pure subprogram may not have a variable with the SAVE attribute
real :: v4
common /blk/ v4
save /blk/
block
!ERROR: A pure subprogram may not have a variable with the SAVE attribute
real, save :: v5
!ERROR: A pure subprogram may not have a variable with the SAVE attribute
real :: v6 = 0.
end block
end subroutine
pure subroutine s06 ! C1589
!ERROR: A pure subprogram may not have a variable with the VOLATILE attribute
real, volatile :: v1
block
!ERROR: A pure subprogram may not have a variable with the VOLATILE attribute
real, volatile :: v2
end block
end subroutine
pure subroutine s07(p) ! C1590
!ERROR: A dummy procedure of a pure subprogram must be pure
procedure(impure) :: p
end subroutine
! C1591 is tested in call11.f90.
pure subroutine s08 ! C1592
contains
pure subroutine pure ! ok
end subroutine
!ERROR: An internal subprogram of a pure subprogram must also be pure
subroutine impure1
end subroutine
!ERROR: An internal subprogram of a pure subprogram must also be pure
impure subroutine impure2
end subroutine
end subroutine
pure subroutine s09 ! C1593
real :: x
!ERROR: VOLATILE variable 'volatile' may not be referenced in pure subprogram 's09'
x = volatile
end subroutine
! C1594 is tested in call12.f90.
pure subroutine s10 ! C1595
integer :: n
!ERROR: Procedure 'notpure' referenced in pure subprogram 's10' must be pure too
n = notpure(1)
end subroutine
pure subroutine s11(to) ! C1596
! Implicit deallocation at the end of the subroutine
!ERROR: Deallocation of polymorphic object 'auto%a' is not permitted in a pure subprogram
type(polyAlloc) :: auto
type(polyAlloc), intent(in out) :: to
!ERROR: Deallocation of polymorphic non-coarray component '%a' is not permitted in a pure subprogram
to = auto
end subroutine
pure subroutine s12
character(20) :: buff
real :: x
write(buff, *) 1.0 ! ok
read(buff, *) x ! ok
!ERROR: External I/O is not allowed in a pure subprogram
print *, 'hi' ! C1597
!ERROR: External I/O is not allowed in a pure subprogram
open(1, file='launch-codes') ! C1597
!ERROR: External I/O is not allowed in a pure subprogram
close(1) ! C1597
!ERROR: External I/O is not allowed in a pure subprogram
backspace(1) ! C1597
!ERROR: External I/O is not allowed in a pure subprogram
endfile(1) ! C1597
!ERROR: External I/O is not allowed in a pure subprogram
rewind(1) ! C1597
!ERROR: External I/O is not allowed in a pure subprogram
flush(1) ! C1597
!ERROR: External I/O is not allowed in a pure subprogram
wait(1) ! C1597
!ERROR: External I/O is not allowed in a pure subprogram
inquire(1, name=buff) ! C1597
!ERROR: External I/O is not allowed in a pure subprogram
read(5, *) x ! C1598
!ERROR: External I/O is not allowed in a pure subprogram
read(*, *) x ! C1598
!ERROR: External I/O is not allowed in a pure subprogram
write(6, *) ! C1598
!ERROR: External I/O is not allowed in a pure subprogram
write(*, *) ! C1598
end subroutine
pure subroutine s13
!ERROR: An image control statement may not appear in a pure subprogram
sync all ! C1599
end subroutine
pure subroutine s14
integer :: img, nimgs, i[*], tmp
! implicit sync all
!ERROR: Procedure 'this_image' referenced in pure subprogram 's14' must be pure too
img = this_image()
nimgs = num_images()
i = img ! i is ready to use
if ( img .eq. 1 ) then
!ERROR: An image control statement may not appear in a pure subprogram
sync images( nimgs ) ! explicit sync 1 with last img
tmp = i[ nimgs ]
!ERROR: An image control statement may not appear in a pure subprogram
sync images( nimgs ) ! explicit sync 2 with last img
i = tmp
end if
if ( img .eq. nimgs ) then
!ERROR: An image control statement may not appear in a pure subprogram
sync images( 1 ) ! explicit sync 1 with img 1
tmp = i[ 1 ]
!ERROR: An image control statement may not appear in a pure subprogram
sync images( 1 ) ! explicit sync 2 with img 1
i = tmp
end if
!ERROR: External I/O is not allowed in a pure subprogram
write (*,*) img, i
! all other images wait here
! TODO others from 11.6.1 (many)
end subroutine
end module
|
