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
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
|
! RUN: bbc -pft-test -o %t %s | FileCheck %s
! Test Pre-FIR Tree captures all the intended nodes from the parse-tree
! Coarray and OpenMP related nodes are tested in other files.
! CHECK: Program test_prog
program test_prog
! Check specification part is not part of the tree.
interface
subroutine incr(i)
integer, intent(inout) :: i
end subroutine
end interface
integer :: i, j, k
real, allocatable, target :: x(:)
real :: y(100)
! CHECK-NOT: node
! CHECK: <<DoConstruct>>
! CHECK: NonLabelDoStmt
do i=1,5
! CHECK: PrintStmt
print *, "hey"
! CHECK: <<DoConstruct>>
! CHECK: NonLabelDoStmt
do j=1,5
! CHECK: PrintStmt
print *, "hello", i, j
! CHECK: EndDoStmt
end do
! CHECK: <<End DoConstruct>>
! CHECK: EndDoStmt
end do
! CHECK: <<End DoConstruct>>
! CHECK: <<AssociateConstruct>>
! CHECK: AssociateStmt
associate (k => i + j)
! CHECK: AllocateStmt
allocate(x(k))
! CHECK: EndAssociateStmt
end associate
! CHECK: <<End AssociateConstruct>>
! CHECK: <<BlockConstruct!>>
! CHECK: BlockStmt
block
integer :: k, l
real, pointer :: p(:)
! CHECK: PointerAssignmentStmt
p => x
! CHECK: AssignmentStmt
k = size(p)
! CHECK: AssignmentStmt
l = 1
! CHECK: <<CaseConstruct!>>
! CHECK: SelectCaseStmt
select case (k)
! CHECK: CaseStmt
case (:0)
! CHECK: NullifyStmt
nullify(p)
! CHECK: CaseStmt
case (1)
! CHECK: <<IfConstruct>>
! CHECK: IfThenStmt
if (p(1)>0.) then
! CHECK: PrintStmt
print *, "+"
! CHECK: ElseIfStmt
else if (p(1)==0.) then
! CHECK: PrintStmt
print *, "0."
! CHECK: ElseStmt
else
! CHECK: PrintStmt
print *, "-"
! CHECK: EndIfStmt
end if
! CHECK: <<End IfConstruct>>
! CHECK: CaseStmt
case (2:10)
! CHECK: CaseStmt
case default
! Note: label-do-loop are canonicalized into do constructs
! CHECK: <<DoConstruct!>>
! CHECK: NonLabelDoStmt
do 22 while(l<=k)
! CHECK: IfStmt
if (p(l)<0.) p(l)=cos(p(l))
! CHECK: CallStmt
22 call incr(l)
! CHECK: EndDoStmt
! CHECK: <<End DoConstruct!>>
! CHECK: CaseStmt
case (100:)
! CHECK: EndSelectStmt
end select
! CHECK: <<End CaseConstruct!>>
! CHECK: EndBlockStmt
end block
! CHECK: <<End BlockConstruct!>>
! CHECK-NOT: WhereConstruct
! CHECK: WhereStmt
where (x > 1.) x = x/2.
! CHECK: <<WhereConstruct>>
! CHECK: WhereConstructStmt
where (x == 0.)
! CHECK: AssignmentStmt
x = 0.01
! CHECK: MaskedElsewhereStmt
elsewhere (x < 0.5)
! CHECK: AssignmentStmt
x = x*2.
! CHECK: <<WhereConstruct>>
where (y > 0.4)
! CHECK: AssignmentStmt
y = y/2.
end where
! CHECK: <<End WhereConstruct>>
! CHECK: ElsewhereStmt
elsewhere
! CHECK: AssignmentStmt
x = x + 1.
! CHECK: EndWhereStmt
end where
! CHECK: <<End WhereConstruct>>
! CHECK-NOT: ForAllConstruct
! CHECK: ForallStmt
forall (i = 1:5) x(i) = y(i)
! CHECK: <<ForallConstruct>>
! CHECK: ForallConstructStmt
forall (i = 1:5)
! CHECK: AssignmentStmt
x(i) = x(i) + y(10*i)
! CHECK: EndForallStmt
end forall
! CHECK: <<End ForallConstruct>>
! CHECK: DeallocateStmt
deallocate(x)
end
! CHECK: Module test
module test
!! When derived type processing is implemented, remove all instances of:
!! - !![disable]
!! - COM:
!![disable]type :: a_type
!![disable] integer :: x
!![disable]end type
!![disable]type, extends(a_type) :: b_type
!![disable] integer :: y
!![disable]end type
interface
subroutine ss(aa)
! CHECK: CompilerDirective
!DIR$ IGNORE_TKR aa
integer :: aa
end subroutine ss
end interface
contains
! CHECK: Function foo
function foo(x)
real x(..)
integer :: foo
! CHECK: <<SelectRankConstruct!>>
! CHECK: SelectRankStmt
select rank(x)
! CHECK: SelectRankCaseStmt
rank (0)
! CHECK: AssignmentStmt
foo = 0
! CHECK: SelectRankCaseStmt
rank (*)
! CHECK: AssignmentStmt
foo = -1
! CHECK: SelectRankCaseStmt
rank (1)
! CHECK: AssignmentStmt
foo = 1
! CHECK: SelectRankCaseStmt
rank default
! CHECK: AssignmentStmt
foo = 2
! CHECK: EndSelectStmt
end select
! CHECK: <<End SelectRankConstruct!>>
end function
! CHECK: Function bar
function bar(x)
class(*) :: x
! CHECK: <<SelectTypeConstruct!>>
! CHECK: SelectTypeStmt
select type(x)
! CHECK: TypeGuardStmt
type is (integer)
! CHECK: AssignmentStmt
bar = 0
!![disable]! COM: CHECK: TypeGuardStmt
!![disable]class is (a_type)
!![disable] ! COM: CHECK: AssignmentStmt
!![disable] bar = 1
!![disable] ! COM: CHECK: ReturnStmt
!![disable] return
! CHECK: TypeGuardStmt
class default
! CHECK: AssignmentStmt
bar = -1
! CHECK: EndSelectStmt
end select
! CHECK: <<End SelectTypeConstruct!>>
end function
! CHECK: Subroutine sub
subroutine sub(a)
real(4):: a
! CHECK: CompilerDirective
!DIR$ IGNORE_TKR a
end subroutine
end module
! CHECK: Subroutine altreturn
subroutine altreturn(i, j, *, *)
! CHECK: <<IfConstruct!>>
if (i>j) then
! CHECK: ReturnStmt
return 1
else
! CHECK: ReturnStmt
return 2
end if
! CHECK: <<End IfConstruct!>>
end subroutine
! Remaining TODO
! CHECK: Subroutine iostmts
subroutine iostmts(filename, a, b, c)
character(*) :: filename
integer :: length
logical :: file_is_opened
real, a, b ,c
! CHECK: InquireStmt
inquire(file=filename, opened=file_is_opened)
! CHECK: <<IfConstruct>>
if (file_is_opened) then
! CHECK: OpenStmt
open(10, FILE=filename)
end if
! CHECK: <<End IfConstruct>>
! CHECK: ReadStmt
read(10, *) length
! CHECK: RewindStmt
rewind 10
! CHECK-NOT: NamelistStmt
namelist /nlist/ a, b, c
! CHECK: WriteStmt
write(10, NML=nlist)
! CHECK: BackspaceStmt
backspace(10)
! CHECK: FormatStmt
1 format (1PE12.4)
! CHECK: WriteStmt
write (10, 1) a
! CHECK: EndfileStmt
endfile 10
! CHECK: FlushStmt
flush 10
! CHECK: WaitStmt
wait(10)
! CHECK: CloseStmt
close(10)
end subroutine
! CHECK: Subroutine sub2
subroutine sub2()
integer :: i, j, k, l
i = 0
1 j = i
! CHECK: ContinueStmt
2 continue
i = i+1
3 j = j+1
! CHECK: ArithmeticIfStmt
if (j-i) 3, 4, 5
! CHECK: GotoStmt
4 goto 6
! FIXME: is name resolution on assigned goto broken/todo ?
! WILLCHECK: AssignStmt
!55 assign 6 to label
! WILLCHECK: AssignedGotoStmt
!66 go to label (5, 6)
! CHECK: ComputedGotoStmt
go to (5, 6), 1 + mod(i, 2)
5 j = j + 1
6 i = i + j/2
! CHECK: <<DoConstruct!>>
do1: do k=1,10
! CHECK: <<DoConstruct!>>
do2: do l=5,20
! CHECK: CycleStmt
cycle do1
! CHECK: ExitStmt
exit do2
end do do2
! CHECK: <<End DoConstruct!>>
end do do1
! CHECK: <<End DoConstruct!>>
! CHECK: PauseStmt
pause 7
! CHECK: StopStmt
stop
end subroutine
! CHECK: Subroutine sub3
subroutine sub3()
print *, "normal"
! CHECK: EntryStmt
entry sub4entry()
print *, "test"
end subroutine
! CHECK: Subroutine sub4
subroutine sub4()
integer :: i
print*, "test"
data i /1/
end subroutine
|
