77 |
(set-syntax-from-char c #\\) |
(set-syntax-from-char c #\\) |
78 |
(read-from-string (concatenate 'string (list c #\Z)))))) |
(read-from-string (concatenate 'string (list c #\Z)))))) |
79 |
(unless (equal results '(t |Z|)) |
(unless (equal results '(t |Z|)) |
80 |
(list c results)))))) |
(list (list c results))))))) |
81 |
nil) |
nil) |
82 |
|
|
83 |
(deftest set-syntax-from-char.multiple-escape |
(deftest set-syntax-from-char.multiple-escape |
99 |
(read-from-string (concatenate 'string (list #\| #\Z c))) |
(read-from-string (concatenate 'string (list #\| #\Z c))) |
100 |
(error (c) c))))) |
(error (c) c))))) |
101 |
(unless (or (eql c #\Z) (eql c #\z) (equal results '(t |Z| |z| |Z|))) |
(unless (or (eql c #\Z) (eql c #\z) (equal results '(t |Z| |z| |Z|))) |
102 |
(list c results)))))) |
(list (list c results))))))) |
103 |
nil) |
nil) |
104 |
|
|
105 |
(deftest set-syntax-from-char.semicolon |
(deftest set-syntax-from-char.semicolon |
123 |
(read-from-string (concatenate 'string (list c #\2 #\Newline c2))) |
(read-from-string (concatenate 'string (list c #\2 #\Newline c2))) |
124 |
(error (c) c))))) |
(error (c) c))))) |
125 |
(unless (equal results (list t expected expected expected)) |
(unless (equal results (list t expected expected expected)) |
126 |
(list c results)))))) |
(list (list c results))))))) |
127 |
nil) |
nil) |
|
|
|
128 |
|
|
129 |
|
(deftest set-syntax-from-char.left-paren |
130 |
|
(loop for c across +standard-chars+ |
131 |
|
unless (find c ")") |
132 |
|
nconc |
133 |
|
(with-standard-io-syntax |
134 |
|
(let ((*readtable* (copy-readtable nil)) |
135 |
|
(*package* (find-package "CL-TEST")) |
136 |
|
(expected (if (eql c #\0) '(1) '(0))) |
137 |
|
(c2 (if (eql c #\0) #\1 #\0))) |
138 |
|
(let ((results |
139 |
|
(list |
140 |
|
(set-syntax-from-char c #\() |
141 |
|
(handler-case |
142 |
|
(read-from-string (concatenate 'string (list c) ")")) |
143 |
|
(error (c) c)) |
144 |
|
(handler-case |
145 |
|
(read-from-string (concatenate 'string (list c c2) ")2" (list #\Newline #\3))) |
146 |
|
(error (c) c)) |
147 |
|
(handler-case |
148 |
|
(read-from-string (concatenate 'string (list c c2) ")")) |
149 |
|
(error (c) c))))) |
150 |
|
(unless (equal results (list t nil expected expected)) |
151 |
|
(list (list c results))))))) |
152 |
|
nil) |
153 |
|
|
154 |
|
(deftest set-syntax-from-char.right-paren |
155 |
|
(loop for c across +standard-chars+ |
156 |
|
nconc |
157 |
|
(with-standard-io-syntax |
158 |
|
(let ((*readtable* (copy-readtable nil)) |
159 |
|
(*package* (find-package "CL-TEST"))) |
160 |
|
(let ((results |
161 |
|
(list |
162 |
|
(set-syntax-from-char c #\)) |
163 |
|
(handler-case |
164 |
|
(read-from-string (string c) nil nil) |
165 |
|
(reader-error (c) :good) |
166 |
|
(error (c) c))))) |
167 |
|
(unless (equal results '(t :good)) |
168 |
|
(list (list c results))))))) |
169 |
|
nil) |
170 |
|
|
171 |
|
(deftest set-syntax-from-char.single-quote |
172 |
|
(loop for c across +standard-chars+ |
173 |
|
nconc |
174 |
|
(with-standard-io-syntax |
175 |
|
(let ((*readtable* (copy-readtable nil)) |
176 |
|
(*package* (find-package "CL-TEST")) |
177 |
|
(expected (if (eql c #\0) ''1 ''0)) |
178 |
|
(c2 (if (eql c #\0) #\1 #\0))) |
179 |
|
(let ((results |
180 |
|
(list |
181 |
|
(set-syntax-from-char c #\') |
182 |
|
(handler-case |
183 |
|
(read-from-string (concatenate 'string (list c c2))) |
184 |
|
(error (c) c)) |
185 |
|
(handler-case |
186 |
|
(read-from-string (concatenate 'string (list c c2) " 2")) |
187 |
|
(error (c) c)) |
188 |
|
(handler-case |
189 |
|
(read-from-string (concatenate 'string (list c c2) ")")) |
190 |
|
(error (c) c))))) |
191 |
|
(unless (equal results (list t expected expected expected)) |
192 |
|
(list (list c results))))))) |
193 |
|
nil) |
194 |
|
|
195 |
|
;;; I do not test that setting syntax from #\" allows the character to be |
196 |
|
;;; used as the terminator of a double quoted string. It is not clear that |
197 |
|
;;; the standard implies this. |
198 |
|
|
199 |
|
(deftest set-syntax-from-char.double-quote |
200 |
|
(loop for c across +standard-chars+ |
201 |
|
nconc |
202 |
|
(with-standard-io-syntax |
203 |
|
(let ((*readtable* (copy-readtable nil)) |
204 |
|
(*package* (find-package "CL-TEST")) |
205 |
|
(expected (if (eql c #\0) "1" "0")) |
206 |
|
(c2 (if (eql c #\0) #\1 #\0))) |
207 |
|
(let ((results |
208 |
|
(list |
209 |
|
(set-syntax-from-char c #\") |
210 |
|
(handler-case |
211 |
|
(read-from-string |
212 |
|
(concatenate 'string (list c c2 #\"))) |
213 |
|
(error (c) c)) |
214 |
|
(handler-case |
215 |
|
(read-from-string |
216 |
|
(concatenate 'string (list c c2 #\" #\2))) |
217 |
|
(error (c) c)) |
218 |
|
(handler-case |
219 |
|
(read-from-string (concatenate 'string (list c c2) "\")")) |
220 |
|
(error (c) c))))) |
221 |
|
(unless (equal results (list t expected expected expected)) |
222 |
|
(list (list c results))))))) |
223 |
|
nil) |
224 |
|
|
225 |
|
(deftest set-syntax-from-char.backquote |
226 |
|
(loop for c across +standard-chars+ |
227 |
|
unless (find c ",x") |
228 |
|
nconc |
229 |
|
(with-standard-io-syntax |
230 |
|
(let* ((*readtable* (copy-readtable nil)) |
231 |
|
(*package* (find-package "CL-TEST")) |
232 |
|
(c2 (if (eql c #\Space) #\Newline #\Space)) |
233 |
|
(results |
234 |
|
(list |
235 |
|
(set-syntax-from-char c #\`) |
236 |
|
(handler-case |
237 |
|
(eval `(let ((x 0)) |
238 |
|
,(read-from-string |
239 |
|
(concatenate 'string (list c #\, #\x))))) |
240 |
|
(error (c) c)) |
241 |
|
(handler-case |
242 |
|
(eval `(let ((x 0)) |
243 |
|
,(read-from-string |
244 |
|
(concatenate 'string (list c #\, #\x c2))))) |
245 |
|
(error (c) c)) |
246 |
|
(handler-case |
247 |
|
(eval `(let ((x 0)) |
248 |
|
,(read-from-string |
249 |
|
(concatenate 'string (list c c2 #\, #\x c2))))) |
250 |
|
(error (c) c))))) |
251 |
|
(unless (equal results '(t 0 0 0)) |
252 |
|
(list (list c results)))))) |
253 |
|
nil) |
254 |
|
|
255 |
|
(deftest set-syntax-from-char.comma |
256 |
|
(loop for c across +standard-chars+ |
257 |
|
unless (find c "`x") |
258 |
|
nconc |
259 |
|
(with-standard-io-syntax |
260 |
|
(let* ((*readtable* (copy-readtable nil)) |
261 |
|
(*package* (find-package "CL-TEST")) |
262 |
|
(c2 (if (eql c #\Space) #\Newline #\Space)) |
263 |
|
(results |
264 |
|
(list |
265 |
|
(set-syntax-from-char c #\,) |
266 |
|
(handler-case |
267 |
|
(read-from-string (string c)) |
268 |
|
(reader-error (c) :good) |
269 |
|
(error (c) c)) |
270 |
|
(handler-case |
271 |
|
(eval `(let ((x 0)) |
272 |
|
,(read-from-string |
273 |
|
(concatenate 'string "`" (list c) "x")))) |
274 |
|
(error (c) c))))) |
275 |
|
(unless (equal results '(t :good 0)) |
276 |
|
(list (list c results)))))) |
277 |
|
nil) |
278 |
|
|
279 |
|
;;; Tests of set-syntax-from-char on #\# |
280 |
|
|
281 |
|
(deftest set-syntax-from-char.sharp.1 |
282 |
|
(loop for c across +standard-chars+ |
283 |
|
nconc |
284 |
|
(with-standard-io-syntax |
285 |
|
(let* ((*readtable* (copy-readtable nil)) |
286 |
|
(*package* (find-package "CL-TEST")) |
287 |
|
(results |
288 |
|
(list |
289 |
|
(set-syntax-from-char c #\#) |
290 |
|
(if (not (eql c #\Space)) |
291 |
|
(handler-case |
292 |
|
(read-from-string |
293 |
|
(concatenate 'string (list c #\Space))) |
294 |
|
(reader-error () :good) |
295 |
|
(error (c) c)) |
296 |
|
:good) |
297 |
|
(if (not (find c "'X")) |
298 |
|
(handler-case |
299 |
|
(read-from-string |
300 |
|
(concatenate 'string (list c) "'X")) |
301 |
|
(error (c) c)) |
302 |
|
'#'|X|) |
303 |
|
(if (not (find c "(X)")) |
304 |
|
(handler-case |
305 |
|
(read-from-string |
306 |
|
(concatenate 'string (list c) "(X)")) |
307 |
|
(error (c) c)) |
308 |
|
#(|X|)) |
309 |
|
(if (not (find c ")")) |
310 |
|
(handler-case |
311 |
|
(read-from-string |
312 |
|
(concatenate 'string (list c) ")")) |
313 |
|
(reader-error (c) :good) |
314 |
|
(error (c) c)) |
315 |
|
:good) |
316 |
|
(if (not (find c "*")) |
317 |
|
(handler-case |
318 |
|
(read-from-string |
319 |
|
(concatenate 'string (list c #\*))) |
320 |
|
(error (c) c)) |
321 |
|
#*) |
322 |
|
(if (not (find c ":|")) |
323 |
|
(handler-case |
324 |
|
(let ((sym (read-from-string |
325 |
|
(concatenate 'string (list c) ":||")))) |
326 |
|
(and (symbolp sym) |
327 |
|
(null (symbol-package sym)) |
328 |
|
(symbol-name sym))) |
329 |
|
(error (c) c)) |
330 |
|
"") |
331 |
|
(handler-case |
332 |
|
(read-from-string |
333 |
|
(concatenate 'string (list c #\<))) |
334 |
|
(reader-error (c) :good) |
335 |
|
(error (c) c)) |
336 |
|
(handler-case |
337 |
|
(read-from-string |
338 |
|
(concatenate 'string (list c #\\ #\X))) |
339 |
|
(error (c) c)) |
340 |
|
(if (not (find c "1")) |
341 |
|
(handler-case |
342 |
|
(read-from-string |
343 |
|
(concatenate 'string (list c) "|1111|#1")) |
344 |
|
(error (c) c)) |
345 |
|
1) |
346 |
|
(if (not (find c "1")) |
347 |
|
(handler-case |
348 |
|
(read-from-string |
349 |
|
(concatenate 'string (list c) "|11#|111|#11|#1")) |
350 |
|
(error (c) c)) |
351 |
|
1) |
352 |
|
))) |
353 |
|
(unless (equalp results '(t :good #'|X| #(|X|) :good #* "" :good #\X 1 1)) |
354 |
|
(list (list c results)))))) |
355 |
|
nil) |
356 |
|
|
357 |
|
(deftest set-syntax-from-char.sharp.2 |
358 |
|
(loop for c across +standard-chars+ |
359 |
|
nconc |
360 |
|
(with-standard-io-syntax |
361 |
|
(let* ((*readtable* (copy-readtable nil)) |
362 |
|
(*package* (find-package "CL-TEST")) |
363 |
|
(results |
364 |
|
(list |
365 |
|
(set-syntax-from-char c #\#) |
366 |
|
(if (not (find c "+XC ")) |
367 |
|
(handler-case |
368 |
|
(let ((*features* (cons ':X *features*))) |
369 |
|
(read-from-string |
370 |
|
(concatenate 'string (list c) "+X C"))) |
371 |
|
(error (c) c)) |
372 |
|
'c) |
373 |
|
(if (not (find c "-(OR)")) |
374 |
|
(handler-case |
375 |
|
(read-from-string |
376 |
|
(concatenate 'string (list c) "-(OR)R")) |
377 |
|
(error (c) c)) |
378 |
|
'r) |
379 |
|
(if (not (find c ".1")) |
380 |
|
(handler-case |
381 |
|
(read-from-string |
382 |
|
(concatenate 'string (list c) ".1")) |
383 |
|
(error (c) c)) |
384 |
|
1) |
385 |
|
(if (not (find c "01aA")) |
386 |
|
(handler-case |
387 |
|
(list |
388 |
|
(read-from-string |
389 |
|
(concatenate 'string (list c) "0a1")) |
390 |
|
(read-from-string |
391 |
|
(concatenate 'string (list c) "0A1"))) |
392 |
|
(error (c) c)) |
393 |
|
'(#0a1 #0a1)) |
394 |
|
(if (not (find c "01bB")) |
395 |
|
(handler-case |
396 |
|
(list |
397 |
|
(read-from-string |
398 |
|
(concatenate 'string (list c) "b101")) |
399 |
|
(read-from-string |
400 |
|
(concatenate 'string (list c) "B011"))) |
401 |
|
(error (c) c)) |
402 |
|
'(5 3)) |
403 |
|
(if (not (find c "cC()12 ")) |
404 |
|
(handler-case |
405 |
|
(list |
406 |
|
(read-from-string |
407 |
|
(concatenate 'string (list c) "c(1 2)")) |
408 |
|
(read-from-string |
409 |
|
(concatenate 'string (list c) "C(2 1)"))) |
410 |
|
(error (c) c)) |
411 |
|
'(#c(1 2) #c(2 1))) |
412 |
|
(if (not (find c "oO0127")) |
413 |
|
(handler-case |
414 |
|
(list |
415 |
|
(read-from-string |
416 |
|
(concatenate 'string (list c) "o172")) |
417 |
|
(read-from-string |
418 |
|
(concatenate 'string (list c) "O7721"))) |
419 |
|
(error (c) c)) |
420 |
|
'(#o172 #o7721)) |
421 |
|
(if (not (find c "pP\"")) |
422 |
|
(handler-case |
423 |
|
(list |
424 |
|
(read-from-string |
425 |
|
(concatenate 'string (list c) "p\"\"")) |
426 |
|
(read-from-string |
427 |
|
(concatenate 'string (list c) "P\"\""))) |
428 |
|
(error (c) c)) |
429 |
|
'(#p"" #p"")) |
430 |
|
(if (not (find c "rR0123")) |
431 |
|
(handler-case |
432 |
|
(list |
433 |
|
(read-from-string |
434 |
|
(concatenate 'string (list c) "3r210")) |
435 |
|
(read-from-string |
436 |
|
(concatenate 'string (list c) "3R1111"))) |
437 |
|
(error (c) c)) |
438 |
|
'(#3r210 #3r1111)) |
439 |
|
;;; Add #s test here |
440 |
|
(if (not (find c "xX04dF")) |
441 |
|
(handler-case |
442 |
|
(list |
443 |
|
(read-from-string |
444 |
|
(concatenate 'string (list c) "x40Fd")) |
445 |
|
(read-from-string |
446 |
|
(concatenate 'string (list c) "XFd04"))) |
447 |
|
(error (c) c)) |
448 |
|
'(#x40fd #xfd04)) |
449 |
|
))) |
450 |
|
(unless (equalp results |
451 |
|
'(t c r 1 (#0a1 #0a1) (5 3) (#c(1 2) #c(2 1)) |
452 |
|
(#o172 #o7721) (#p"" #p"") (#3r210 #3r1111) |
453 |
|
(#x40fd #xfd04))) |
454 |
|
(list (list c results))) |
455 |
|
))) |
456 |
|
nil) |
457 |
|
|
458 |
|
|