@@ -9,242 +9,273 @@ source testHelpers.tcl
9
9
# ###########################################################
10
10
source " forth.tcl"
11
11
12
- test forth-1 " numbers just get pushed onto the stack" -body {
12
+ test forth-1 " parsing and numbers: numbers just get pushed onto the stack" -body {
13
13
evalForth " 1 2 3 4 5"
14
14
} -returnCodes ok -result {1 2 3 4 5}
15
15
16
16
skip forth-2
17
- test forth-2 " pushes negative numbers onto the stack" -body {
17
+ test forth-2 " parsing and numbers: pushes negative numbers onto the stack" -body {
18
18
evalForth " -1 -2 -3 -4 -5"
19
19
} -returnCodes ok -result {-1 -2 -3 -4 -5}
20
20
21
21
skip forth-3
22
- test forth-3 " can add two numbers" -body {
22
+ test forth-3 " addition: can add two numbers" -body {
23
23
evalForth " 1 2 +"
24
24
} -returnCodes ok -result {3}
25
25
26
26
skip forth-4
27
- test forth-4 " errors if there is nothing on the stack" -body {
27
+ test forth-4 " addition: errors if there is nothing on the stack" -body {
28
28
evalForth " +"
29
29
} -returnCodes error -result " empty stack"
30
30
31
31
skip forth-5
32
- test forth-5 " errors if there is only one value on the stack" -body {
32
+ test forth-5 " addition: errors if there is only one value on the stack" -body {
33
33
evalForth " 1 +"
34
34
} -returnCodes error -result " only one value on the stack"
35
35
36
+ skip forth-5a
37
+ test forth-5a " addition: more than one value on the stack" -body {
38
+ evalForth " 1 2 3 +"
39
+ } -returnCodes ok -result {1 5}
40
+
36
41
skip forth-6
37
- test forth-6 " can subtract two numbers" -body {
42
+ test forth-6 " subtraction: can subtract two numbers" -body {
38
43
evalForth " 3 4 -"
39
44
} -returnCodes ok -result {-1}
40
45
41
46
skip forth-7
42
- test forth-7 " errors if there is nothing on the stack" -body {
47
+ test forth-7 " subtraction: errors if there is nothing on the stack" -body {
43
48
evalForth " -"
44
49
} -returnCodes error -result " empty stack"
45
50
46
51
skip forth-8
47
- test forth-8 " errors if there is only one value on the stack" -body {
52
+ test forth-8 " subtraction: errors if there is only one value on the stack" -body {
48
53
evalForth " 1 -"
49
54
} -returnCodes error -result " only one value on the stack"
50
55
56
+ skip forth-8a
57
+ test forth-8a " subtraction: more than one value on the stack" -body {
58
+ evalForth " 1 12 3 -"
59
+ } -returnCodes ok -result {1 9}
60
+
51
61
skip forth-9
52
- test forth-9 " can multiply two numbers" -body {
62
+ test forth-9 " multiplication: can multiply two numbers" -body {
53
63
evalForth " 2 4 *"
54
64
} -returnCodes ok -result {8}
55
65
56
66
skip forth-10
57
- test forth-10 " errors if there is nothing on the stack" -body {
67
+ test forth-10 " multiplication: errors if there is nothing on the stack" -body {
58
68
evalForth " *"
59
69
} -returnCodes error -result " empty stack"
60
70
61
71
skip forth-11
62
- test forth-11 " errors if there is only one value on the stack" -body {
72
+ test forth-11 " multiplication: errors if there is only one value on the stack" -body {
63
73
evalForth " 1 *"
64
74
} -returnCodes error -result " only one value on the stack"
65
75
76
+ skip forth-11a
77
+ test forth-11a " multiplication: more than one value on the stack" -body {
78
+ evalForth " 1 2 3 *"
79
+ } -returnCodes ok -result {1 6}
80
+
66
81
skip forth-12
67
- test forth-12 " can divide two numbers" -body {
82
+ test forth-12 " division: can divide two numbers" -body {
68
83
evalForth " 12 3 /"
69
84
} -returnCodes ok -result {4}
70
85
71
86
skip forth-13
72
- test forth-13 " performs integer division" -body {
87
+ test forth-13 " division: performs integer division" -body {
73
88
evalForth " 8 3 /"
74
89
} -returnCodes ok -result {2}
75
90
76
91
skip forth-14
77
- test forth-14 " errors if dividing by zero" -body {
92
+ test forth-14 " division: errors if dividing by zero" -body {
78
93
evalForth " 4 0 /"
79
94
} -returnCodes error -result " divide by zero"
80
95
81
96
skip forth-15
82
- test forth-15 " errors if there is nothing on the stack" -body {
97
+ test forth-15 " division: errors if there is nothing on the stack" -body {
83
98
evalForth " /"
84
99
} -returnCodes error -result " empty stack"
85
100
86
101
skip forth-16
87
- test forth-16 " errors if there is only one value on the stack" -body {
102
+ test forth-16 " division: errors if there is only one value on the stack" -body {
88
103
evalForth " 1 /"
89
104
} -returnCodes error -result " only one value on the stack"
90
105
106
+ skip forth-16a
107
+ test forth-16a " division: more than one value on the stack" -body {
108
+ evalForth " 1 12 3 /"
109
+ } -returnCodes ok -result {1 4}
110
+
111
+
91
112
skip forth-17
92
- test forth-17 " addition and subtraction" -body {
113
+ test forth-17 " combined arithmetic: addition and subtraction" -body {
93
114
evalForth " 1 2 + 4 -"
94
115
} -returnCodes ok -result {-1}
95
116
96
117
skip forth-18
97
- test forth-18 " multiplication and division" -body {
118
+ test forth-18 " combined arithmetic: multiplication and division" -body {
98
119
evalForth " 2 4 * 3 /"
99
120
} -returnCodes ok -result {2}
100
121
122
+ skip forth-18a
123
+ test forth-18a " combined arithmetic: multiplication and addition" -body {
124
+ evalForth " 1 3 4 * +"
125
+ } -returnCodes ok -result {13}
126
+
127
+ skip forth-18b
128
+ test forth-18b " combined arithmetic: addition and multiplication" -body {
129
+ evalForth " 1 3 4 + *"
130
+ } -returnCodes ok -result {7}
131
+
101
132
skip forth-19
102
- test forth-19 " copies a value on the stack" -body {
133
+ test forth-19 " dup: copies a value on the stack" -body {
103
134
evalForth " 1 dup"
104
135
} -returnCodes ok -result {1 1}
105
136
106
137
skip forth-20
107
- test forth-20 " copies the top value on the stack" -body {
138
+ test forth-20 " dup: copies the top value on the stack" -body {
108
139
evalForth " 1 2 dup"
109
140
} -returnCodes ok -result {1 2 2}
110
141
111
142
skip forth-21
112
- test forth-21 " errors if there is nothing on the stack" -body {
143
+ test forth-21 " dup: errors if there is nothing on the stack" -body {
113
144
evalForth " dup"
114
145
} -returnCodes error -result " empty stack"
115
146
116
147
skip forth-22
117
- test forth-22 " removes the top value on the stack if it is the only one" -body {
148
+ test forth-22 " drop: removes the top value on the stack if it is the only one" -body {
118
149
evalForth " 1 drop"
119
150
} -returnCodes ok -result {}
120
151
121
152
skip forth-23
122
- test forth-23 " removes the top value on the stack if it is not the only one" -body {
153
+ test forth-23 " drop: removes the top value on the stack if it is not the only one" -body {
123
154
evalForth " 1 2 drop"
124
155
} -returnCodes ok -result {1}
125
156
126
157
skip forth-24
127
- test forth-24 " errors if there is nothing on the stack" -body {
158
+ test forth-24 " drop: errors if there is nothing on the stack" -body {
128
159
evalForth " drop"
129
160
} -returnCodes error -result " empty stack"
130
161
131
162
skip forth-25
132
- test forth-25 " swaps the top two values on the stack if they are the only ones" -body {
163
+ test forth-25 " swap: swaps the top two values on the stack if they are the only ones" -body {
133
164
evalForth " 1 2 swap"
134
165
} -returnCodes ok -result {2 1}
135
166
136
167
skip forth-26
137
- test forth-26 " swaps the top two values on the stack if they are not the only ones" -body {
168
+ test forth-26 " swap: swaps the top two values on the stack if they are not the only ones" -body {
138
169
evalForth " 1 2 3 swap"
139
170
} -returnCodes ok -result {1 3 2}
140
171
141
172
skip forth-27
142
- test forth-27 " errors if there is nothing on the stack" -body {
173
+ test forth-27 " swap: errors if there is nothing on the stack" -body {
143
174
evalForth " swap"
144
175
} -returnCodes error -result " empty stack"
145
176
146
177
skip forth-28
147
- test forth-28 " errors if there is only one value on the stack" -body {
178
+ test forth-28 " swap: errors if there is only one value on the stack" -body {
148
179
evalForth " 1 swap"
149
180
} -returnCodes error -result " only one value on the stack"
150
181
151
182
skip forth-29
152
- test forth-29 " copies the second element if there are only two" -body {
183
+ test forth-29 " over: copies the second element if there are only two" -body {
153
184
evalForth " 1 2 over"
154
185
} -returnCodes ok -result {1 2 1}
155
186
156
187
skip forth-30
157
- test forth-30 " copies the second element if there are more than two" -body {
188
+ test forth-30 " over: copies the second element if there are more than two" -body {
158
189
evalForth " 1 2 3 over"
159
190
} -returnCodes ok -result {1 2 3 2}
160
191
161
192
skip forth-31
162
- test forth-31 " errors if there is nothing on the stack" -body {
193
+ test forth-31 " over: errors if there is nothing on the stack" -body {
163
194
evalForth " over"
164
195
} -returnCodes error -result " empty stack"
165
196
166
197
skip forth-32
167
- test forth-32 " errors if there is only one value on the stack" -body {
198
+ test forth-32 " over: errors if there is only one value on the stack" -body {
168
199
evalForth " 1 over"
169
200
} -returnCodes error -result " only one value on the stack"
170
201
171
202
skip forth-33
172
- test forth-33 " can consist of built-in words" -body {
203
+ test forth-33 " user-defined words: can consist of built-in words" -body {
173
204
evalForth " : dup-twice dup dup ;\n 1 dup-twice"
174
205
} -returnCodes ok -result {1 1 1}
175
206
176
207
skip forth-34
177
- test forth-34 " execute in the right order" -body {
208
+ test forth-34 " user-defined words: execute in the right order" -body {
178
209
evalForth " : countup 1 2 3 ;\n countup"
179
210
} -returnCodes ok -result {1 2 3}
180
211
181
212
skip forth-35
182
- test forth-35 " can override other user-defined words" -body {
213
+ test forth-35 " user-defined words: can override other user-defined words" -body {
183
214
evalForth " : foo dup ;\n : foo dup dup ;\n 1 foo"
184
215
} -returnCodes ok -result {1 1 1}
185
216
186
217
skip forth-36
187
- test forth-36 " can override built-in words" -body {
218
+ test forth-36 " user-defined words: can override built-in words" -body {
188
219
evalForth " : swap dup ;\n 1 swap"
189
220
} -returnCodes ok -result {1 1}
190
221
191
222
skip forth-37
192
- test forth-37 " can override built-in operators" -body {
223
+ test forth-37 " user-defined words: can override built-in operators" -body {
193
224
evalForth " : + * ;\n 3 4 +"
194
225
} -returnCodes ok -result {12}
195
226
196
227
skip forth-38
197
- test forth-38 " can use different words with the same name" -body {
228
+ test forth-38 " user-defined words: can use different words with the same name" -body {
198
229
evalForth " : foo 5 ;\n : bar foo ;\n : foo 6 ;\n bar foo"
199
230
} -returnCodes ok -result {5 6}
200
231
201
232
skip forth-39
202
- test forth-39 " can define word that uses word with the same name" -body {
233
+ test forth-39 " user-defined words: can define word that uses word with the same name" -body {
203
234
evalForth " : foo 10 ;\n : foo foo 1 + ;\n foo"
204
235
} -returnCodes ok -result {11}
205
236
206
237
skip forth-40
207
- test forth-40 " cannot redefine non-negative numbers" -body {
238
+ test forth-40 " user-defined words: cannot redefine non-negative numbers" -body {
208
239
evalForth " : 1 2 ;"
209
240
} -returnCodes error -result " illegal operation"
210
241
211
242
skip forth-41
212
- test forth-41 " cannot redefine negative numbers" -body {
243
+ test forth-41 " user-defined words: cannot redefine negative numbers" -body {
213
244
evalForth " : -1 2 ;"
214
245
} -returnCodes error -result " illegal operation"
215
246
216
247
skip forth-42
217
- test forth-42 " errors if executing a non-existent word" -body {
248
+ test forth-42 " user-defined words: errors if executing a non-existent word" -body {
218
249
evalForth " foo"
219
250
} -returnCodes error -result " undefined operation"
220
251
221
252
skip forth-43
222
- test forth-43 " DUP is case-insensitive" -body {
253
+ test forth-43 " case-insensitivity: DUP is case-insensitive" -body {
223
254
evalForth " 1 DUP Dup dup"
224
255
} -returnCodes ok -result {1 1 1 1}
225
256
226
257
skip forth-44
227
- test forth-44 " DROP is case-insensitive" -body {
258
+ test forth-44 " case-insensitivity: DROP is case-insensitive" -body {
228
259
evalForth " 1 2 3 4 DROP Drop drop"
229
260
} -returnCodes ok -result {1}
230
261
231
262
skip forth-45
232
- test forth-45 " SWAP is case-insensitive" -body {
263
+ test forth-45 " case-insensitivity: SWAP is case-insensitive" -body {
233
264
evalForth " 1 2 SWAP 3 Swap 4 swap"
234
265
} -returnCodes ok -result {2 3 4 1}
235
266
236
267
skip forth-46
237
- test forth-46 " OVER is case-insensitive" -body {
268
+ test forth-46 " case-insensitivity: OVER is case-insensitive" -body {
238
269
evalForth " 1 2 OVER Over over"
239
270
} -returnCodes ok -result {1 2 1 2 1}
240
271
241
272
skip forth-47
242
- test forth-47 " user-defined words are case-insensitive" -body {
273
+ test forth-47 " case-insensitivity: user-defined words are case-insensitive" -body {
243
274
evalForth " : foo dup ;\n 1 FOO Foo foo"
244
275
} -returnCodes ok -result {1 1 1 1}
245
276
246
277
skip forth-48
247
- test forth-48 " definitions are case-insensitive" -body {
278
+ test forth-48 " case-insensitivity: definitions are case-insensitive" -body {
248
279
evalForth " : SWAP DUP Dup dup ;\n 1 swap"
249
280
} -returnCodes ok -result {1 1 1 1}
250
281
0 commit comments