forked from bonzini/smalltalk
-
Notifications
You must be signed in to change notification settings - Fork 0
/
compiler.st
252 lines (215 loc) · 7.51 KB
/
compiler.st
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
"======================================================================
|
| Regression tests for the compiler
|
|
======================================================================"
"======================================================================
|
| Copyright (C) 2003, 2007, 2008, 2009 Free Software Foundation.
| Written by Paolo Bonzini
|
| This file is part of GNU Smalltalk.
|
| GNU Smalltalk is free software; you can redistribute it and/or modify it
| under the terms of the GNU General Public License as published by the Free
| Software Foundation; either version 2, or (at your option) any later version.
|
| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
| FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
| details.
|
| You should have received a copy of the GNU General Public License along with
| GNU Smalltalk; see the file COPYING. If not, write to the Free Software
| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
======================================================================"
Object subclass: #BugTest
instanceVariableNames: 'value '
classVariableNames: ''
poolDictionaries: ''
category: 'Regression testing'!
!Object methodsFor: 'bugs'!
a: value
^[ undefVariable ]! !
!BugTest methodsFor: 'bugs'!
bugHere
"The scope for the above method isn't popped and a
bogus error is returned here."
value := 42! !
"Here is another one. In this case the temporaries inside the block
were not counted correctly and were overwritten by push bytecodes."
!String methodsFor: 'matching'!
phoneNumber
| s attempted |
attempted := false.
self keysAndValuesDo: [ :k :each |
| skip ok ch |
ok := false.
each = $( ifTrue: [
ok := self size - k >= 13 and: [ (self at: k + 4) = $) ].
skip := 1.
].
each isDigit ifTrue: [
ok := self size - k >= 11.
skip := 0.
].
ok := ok and: [ attempted not ].
attempted := skip notNil.
ok ifTrue: [
skip + k to: skip + 2 + k do: [ :i |
ok := ok and: [ (self at: i) isDigit ]
].
(skip * 2 + k + 4) to: (skip * 2 + k + 6) do: [ :i |
ok := ok and: [ (self at: i) isDigit ]
].
(skip * 2 + k + 8) to: (skip * 2 + k + 11) do: [ :i |
ok := ok and: [ (self at: i) isDigit ]
].
ch := self at: skip * 2 + k + 7.
ok := ok and: [ (ch = $ ) | (ch = $-) ].
ok ifTrue: [ ^{
self copyFrom: k + skip to: k + skip + 2.
self copyFrom: skip * 2 + k + 4 to: skip * 2 + k + 6.
self copyFrom: skip * 2 + k + 8 to: skip * 2 + k + 11.
} ]
].
].
^nil
! !
Eval [ '(111) 111-1111' phoneNumber ]
Eval [ (Object compile: 'foo [ <category: ''bar''> ^5 ]') methodCategory ]
Eval [
a := Undeclared keys size.
1 to: 100 do: [ :i | Object compile: 'a%1 [ ^A%1 ]' % {i} ].
Undeclared keys size - a
]
"Various errors in the recursive-descent parser"
!BugTest class methodsFor: 'bugs'!
c
^'No crashes'!
a
^#[]!
b
^{}!
"The lexer crashed on this because it returned a SYMBOL_LITERAL with
-123 in the ival. This gives a parse error..."
c
#-123!
c
<3 4>
^'foo'! !
"... this does not."
Eval [ #(#-123) size ]
Eval [ BugTest c ]
"Also used to crash."
Object subclass: A [
B := C.
]
"Compiling a method should not capture the current temporaries dictionary."
Eval [
a:=42.
Object compile: 'gotcha [ "shouldn''t compile!" ^a ]'
]
Eval [ nil gotcha ]
"Regression test for a compiler bug. Check that jump threading is
performed correctly (or not performed at all) if the threaded jump
requires extension bytes and the original one had none."
Number extend [
inWords [
| tens part1 part2 |
((self \\ 100) < 20 and: [(self \\ 100) > 10]) ifTrue: [
part1 := ''.
((self \\ 100) = 19) ifTrue: [ part2 := 'nineteen'. ].
] ifFalse: [
((self \\ 10) = 0) ifTrue: [
part1 := ''. ].
((self \\ 10) = 1) ifTrue: [
part1 := 'one'. ].
((self \\ 10) = 2) ifTrue: [
part1 := 'two'. ].
((self \\ 10) = 3) ifTrue: [
part1 := 'three'. ].
((self \\ 10) = 4) ifTrue: [
part1 := 'four'. ].
((self \\ 10) = 5) ifTrue: [
part1 := 'five'. ].
((self \\ 10) = 6) ifTrue: [
part1 := 'six'. ].
((self \\ 10) = 7) ifTrue: [
part1 := 'seven'. ].
((self \\ 10) = 8) ifTrue: [
part1 := 'eight'. ].
((self \\ 10) = 9) ifTrue: [
part1 := 'nine'. ].
tens := tens - (tens \\ 10).
((tens \\ 100) = 10) ifTrue: [ part2 := 'ten'. ].
((tens \\ 100) = 20) ifTrue: [ part2 := 'twenty'. ].
((tens \\ 100) = 30) ifTrue: [ part2 := 'thirty'. ].
((tens \\ 100) = 40) ifTrue: [ part2 := 'forty'. ].
((tens \\ 100) = 50) ifTrue: [ part2 := 'fifty'. ].
((tens \\ 100) = 60) ifTrue: [ part2 := 'sixty'. ].
((tens \\ 100) = 70) ifTrue: [ part2 := 'seventy'. ].
((tens \\ 100) = 80) ifTrue: [ part2 := 'eighty'. ].
((tens \\ 100) = 90) ifTrue: [ part2 := 'ninety'. ].
].
^part2, part1
]
]
"this has a jump of exactly 256 bytes, and was buggy at some point.
reduced with delta, so the code does not totally make sense. :-) "
Object extend [
buggy: packagesList test: aBoolean ifMissing: aBlock [
| toBeLoaded featuresFound pending allPrereq allFeatures package name |
featuresFound := Set withAll: Smalltalk.Features.
[pending notEmpty] whileTrue: [
name := pending removeFirst.
(featuresFound includes: name)
ifFalse:
[package := self at: name ifAbsent: [^aBlock value: name].
allPrereq := package prerequisites asSet.
allFeatures := package features asSet.
(aBoolean and: [package test notNil]) ifTrue: [
allPrereq addAll: package test prerequisites.
allFeatures addAll: package test features].
(allPrereq noneSatisfy: [ :each | pending includes: each ])
ifFalse: [
pending addLast: name]
ifTrue: [
pending removeAll: allPrereq ifAbsent: [:doesNotMatter | ].
pending removeAll: allFeatures ifAbsent: [:doesNotMatter | ].
allPrereq removeAll: allFeatures ifAbsent: [:doesNotMatter | ].
featuresFound addAll: allFeatures.
featuresFound add: name.
toBeLoaded addFirst: name.
pending addAllLast: allPrereq]]].
]
]
Eval [ 19 inWords ]
"test that blocks defined with ##() work properly"
Object extend [
block [ ^##([ 'abc' asUppercase ]) ]
]
Eval [ nil block value ]
"test the limited support for unary minus in literals"
Eval [ 2-2 ]
Eval [ -2 + 2 ]
Eval [ -16r33 + 16r33 ] "Blue Book actually says 16r-33"
Eval [ 16r33 + 16r-33 ] "Blue Book actually says 16r-33"
Eval [ -12345678901234567890123 + 12345678901234567890123 ]
Eval [ -123.0 + 123.0 ]
Eval [ -123s3 printString ]
"test for errors -- we still fail on -16r-0, but that's insane..."
Eval [ Object compile: 'a [ -16r-33 ]' ]
Eval [ Object compile: 'a [ -16r-33.0 ]' ]
Eval [ Object compile: 'a [ -16r-33s3 ]' ]
Eval [ Object compile: 'a [ -16r-12345678901234567890123 ]' ]
"test that streams are correctly associated to FileSegments"
Eval [
(Object >> #addDependent:) descriptor sourceCode class
]
Eval [
'Object extend [ a [ ^5 ] ]' readStream fileIn.
(Object >> #a) descriptor sourceCode class
]