source: trunk/source/tests/ansi-tests/syntax.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 30.0 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Jan  2 08:12:51 2005
4;;;; Contains: Tests of standard syntax
5
6(in-package :cl-test)
7
8(compile-and-load "reader-aux.lsp")
9
10(def-syntax-test syntax.whitespace.1
11  ;; Check that various standard or semistandard characters are whitespace[2]
12  (let ((names '("Tab" "Newline" "Linefeed" "Space" "Return" "Page")))
13    (loop for name in names
14          for c = (name-char name)
15          nconc
16          (when c
17            (let* ((s (concatenate 'string (string c) "123"))
18                   (val (read-from-string s)))
19              (unless (eql val 123)
20                (list (list name c s val)))))))
21  nil)
22
23(def-syntax-test syntax.constituent.1
24  ;; Tests of various characters that they are constituent characters,
25  ;; and parse to symbols
26  (let ((chars (concatenate
27                'string
28                "!$%&*<=>?@[]^_-{}+/"
29                "abcdefghijklmnopqrstuvwxyz"
30                "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
31    (loop for c across chars
32          for s = (string c)
33          for sym = (read-from-string s)
34          unless (string= (symbol-name sym) (string-upcase s))
35          collect (list c sym)))
36  nil)
37
38;;; Backspace is an invalid constituent character
39
40(def-syntax-test syntax.backspace.invalid
41  (let ((c (name-char "Backspace")))
42    (if (not c) t
43      (eval `(signals-error (read-from-string (string ,c)) reader-error))))
44  t)
45
46;;; Rubout is an invalid constituent character
47
48(def-syntax-test syntax.rubout.invalid
49  (let ((c (name-char "Rubout")))
50    (if (not c) t
51      (eval `(signals-error (read-from-string (string ,c)) reader-error))))
52  t)
53
54;;; Digits are alphabetic if >= the read base
55
56(def-syntax-test syntax.digits.alphabetic.1
57  (loop for base from 2 to 9
58        nconc
59        (let ((*read-base* base))
60          (loop for digit-val from base to 9
61                for c = (elt "0123456789" digit-val)
62                for s = (string c)
63                for val = (read-from-string s)
64                unless (and (symbolp val)
65                            (string= s (symbol-name val)))
66                collect (list base digit-val c s val))))
67  nil)
68
69;;; Reading escaped characters
70
71(def-syntax-test syntax.escaped.1
72  (loop for c across +standard-chars+
73        for s0 = (string c)
74        for s = (concatenate 'string "\\" s0)
75        for sym = (read-from-string s)
76        unless (and (symbolp sym)
77                    (string= (symbol-name sym) s0))
78        collect (list c s0 s sym))
79  nil)
80
81(def-syntax-test syntax.escaped.2
82  (let ((count 0))
83    (loop for i from 0 below (min 65536 char-code-limit)
84          for c = (code-char i)
85          for s0 = (and c (string c))
86          for s = (and c (concatenate 'string "\\" s0))
87          for sym = (and c (read-from-string s))
88          unless (or (not c)
89                     (and (symbolp sym)
90                          (string= (symbol-name sym) s0)))
91          collect (progn
92                    (when (> (incf count) 100) (loop-finish))
93                    (list i c s0 s sym))))
94  nil)
95
96(def-syntax-test syntax.escaped.3
97  (loop for i = (random (min char-code-limit (ash 1 24)))
98        for c = (code-char i)
99        for s0 = (and c (string c))
100        for s = (and c (concatenate 'string "\\" s0))
101        for sym = (and c (read-from-string s))
102        repeat 1000
103        unless (or (not c)
104                   (and (symbolp sym)
105                        (string= (symbol-name sym) s0)))
106        collect (list i c s0 s sym))
107  nil)
108
109(def-syntax-test syntax.escaped.4
110  (loop for c across +standard-chars+
111        for bad = (find c "\\|")
112        for s0 = (string c)
113        for s = (concatenate 'string "|" s0 "|")
114        for sym = (and (not bad) (read-from-string s))
115        unless (or bad
116                   (and (symbolp sym)
117                        (string= (symbol-name sym) s0)))
118        collect (list c s0 s sym))
119  nil)
120
121(def-syntax-test syntax.escaped.5
122  (let ((count 0))
123    (loop for i from 0 below (min 65536 char-code-limit)
124          for c = (code-char i)
125          for bad = (or (not c) (find c "\\|"))
126          for s0 = (and c (string c))
127          for s = (and c (concatenate 'string "|" s0 "|"))
128          for sym = (and c (not bad) (read-from-string s))
129          unless (or bad
130                     (and (symbolp sym)
131                          (string= (symbol-name sym) s0)))
132          collect (progn
133                    (when (> (incf count) 100) (loop-finish))
134                    (list c s0 s sym))))
135  nil)
136
137(def-syntax-test syntax.escaped.6
138  (loop for i = (random (min char-code-limit (ash 1 24)))
139        for c = (code-char i)
140        for bad = (or (not c) (find c "\\|"))
141        for s0 = (and c (string c))
142        for s = (and c (concatenate 'string "|" s0 "|"))
143        for sym = (and (not bad) (read-from-string s))
144        repeat 1000
145        unless (or bad
146                   (and (symbolp sym)
147                        (string= (symbol-name sym) s0)))
148        collect (list c s0 s sym))
149  nil)
150
151(def-syntax-test syntax.escape.whitespace.1
152  (let ((names '("Tab" "Newline" "Linefeed" "Space" "Return" "Page"
153                 "Rubout" "Backspace")))
154    (loop for name in names
155          for c = (name-char name)
156          nconc
157          (when c
158            (let* ((s (concatenate 'string "\\" (string c)))
159                   (val (read-from-string s)))
160              (unless (eql val (intern (string c)))
161                (list (list name c s val)))))))
162  nil)
163
164;;;
165;;; CLtS appears to be inconsistent on the next test.
166;;; Compare the definition of 'invalid' with the specification
167;;; of the token reading algorithm.
168;;;
169(def-syntax-test syntax.escape.whitespace.2
170  (let ((names '("Tab" "Newline" "Linefeed" "Space" "Return" "Page")))
171    (loop for name in names
172          for c = (name-char name)
173          nconc
174          (when c
175            (let* ((s (concatenate 'string "|" (string c) "|"))
176                   (val (read-from-string s)))
177              (unless (eql val (intern (string c)))
178                (list (list name c s val)))))))
179  nil)
180
181#|
182(def-syntax-test syntax.multiple-escape.invalid.backspace
183  (let ((c (name-char "Backspace")))
184    (or (not c)
185        (let ((s (concatenate 'string "|" (string c) "|")))
186          (eval `(signals-error (read-from-string ',s) reader-error)))))
187  t)
188
189(def-syntax-test syntax.multiple-escape.invalid.rubout
190  (let ((c (name-char "Rubout")))
191    (or (not c)
192        (let ((s (concatenate 'string "|" (string c) "|")))
193          (eval `(signals-error (read-from-string ',s) reader-error)))))
194  t)
195|#
196
197
198;;; Tests of #\
199
200(def-syntax-test syntax.sharp-backslash.1
201  (loop for c across +standard-chars+
202        for s = (concatenate 'string "#\\" (string c))
203        for c2 = (read-from-string s)
204        unless (eql c c2)
205        collect (list c s c2))
206  nil)
207
208(def-syntax-test syntax.sharp-backslash.2
209  (let ((count 0))
210    (loop for i below (min 65536 char-code-limit)
211          for c = (code-char i)
212          for s = (and c (concatenate 'string "#\\" (string c)))
213          for c2 = (and c (read-from-string s))
214          unless (eql c c2)
215          collect (progn (when (> (incf count) 100) (loop-finish))
216                         (list c s c2))))
217  nil)
218
219(def-syntax-test syntax.sharp-backslash.3
220  (loop for i = (random (min (ash 1 24) char-code-limit))
221        for c = (code-char i)
222        for s = (and c (concatenate 'string "#\\" (string c)))
223        for c2 = (and c (read-from-string s))
224        repeat 1000
225        unless (eql c c2)
226        collect (list i c s c2))
227  nil)
228
229(def-syntax-test syntax.sharp-backslash.4
230  (flet ((%f (s) (read-from-string (concatenate 'string "#\\" s))))
231    (loop for s in '("SPACE" "NEWLINE" "TAB" "RUBOUT" "BACKSPACE" "PAGE" "LINEFEED" "RETURN")
232          for c = (name-char s)
233          unless (or (null c)
234                     (and (eql (%f s) c)
235                          (eql (%f (string-downcase s)) c)
236                          (eql (%f (string-capitalize s)) c)))
237          collect (list s c)))
238  nil)
239
240(def-syntax-test syntax.sharp-backslash.5
241  (flet ((%f (s) (read-from-string (concatenate 'string "#\\" s))))
242    (let ((good-chars (concatenate 'string +alphanumeric-chars+
243                                   "<,.>\"':/?[]{}~`!@#$%^&*_-+=")))
244      (loop for c across +standard-chars+
245            for name = (char-name c)
246            unless (or (null name)
247                       (string/= "" (string-trim good-chars name))
248                       (and (eql (%f name) c)
249                            (eql (%f (string-downcase name)) c)
250                            (eql (%f (string-upcase name)) c)
251                            (eql (%f (string-capitalize name)) c)))
252            collect (list c name))))
253  nil)
254
255(def-syntax-test syntax.sharp-backslash.6
256  (flet ((%f (s) (read-from-string (concatenate 'string "#\\" s))))
257    (let ((good-chars (concatenate 'string +alphanumeric-chars+
258                                   "<,.>\"':/?[]{}~`!@#$%^&*_-+=")))
259      (loop for i below (min 65536 char-code-limit)
260            for c = (code-char i)
261            for name = (and c (char-name c))
262            unless (or (null name)
263                       (string/= "" (string-trim good-chars name))
264                       (and (eql (%f name) c)
265                            (eql (%f (string-downcase name)) c)
266                            (eql (%f (string-upcase name)) c)
267                            (eql (%f (string-capitalize name)) c)))
268            collect (list i c name))))
269  nil)
270
271(def-syntax-test syntax.sharp-backslash.7
272  (flet ((%f (s) (read-from-string (concatenate 'string "#\\" s))))
273    (let ((good-chars (concatenate 'string +alphanumeric-chars+
274                                   "<,.>\"':/?[]{}~`!@#$%^&*_-+=")))
275      (loop for i = (random (min (ash 1 24) char-code-limit))
276            for c = (code-char i)
277            for name = (and c (char-name c))
278            repeat 1000
279            unless (or (null name)
280                       (string/= "" (string-trim good-chars name))
281                       (and (eql (%f name) c)
282                            (eql (%f (string-downcase name)) c)
283                            (eql (%f (string-upcase name)) c)
284                            (eql (%f (string-capitalize name)) c)))
285            collect (list i c name))))
286  nil)
287
288
289;;; Tests of #'
290
291(def-syntax-test syntax.sharp-quote.1
292  (read-from-string "#'X")
293  (function |X|) 3)
294
295(def-syntax-test syntax.sharp-quote.2
296  (read-from-string "#':X")
297  (function :|X|) 4)
298
299(def-syntax-test syntax.sharp-quote.3
300  (read-from-string "#'17")
301  (function 17) 4)
302
303(def-syntax-test syntax.sharp-quote.error.1
304  (signals-error (read-from-string "#'") end-of-file)
305  t)
306
307(def-syntax-test syntax.sharp-quote.error.2
308  (signals-error (read-from-string "(#'" nil nil) end-of-file)
309  t)
310
311;;; Tess of #(...)
312
313(def-syntax-vector-test syntax.sharp-left-paren.1
314  "#()")
315
316(def-syntax-vector-test syntax.sharp-left-paren.2
317  "#0()")
318
319(def-syntax-vector-test syntax.sharp-left-paren.3
320  "#(a)" a)
321
322(def-syntax-vector-test syntax.sharp-left-paren.4
323  "#(a b c)" a b c)
324
325(def-syntax-vector-test syntax.sharp-left-paren.5
326  "#2(a)" a a)
327
328(def-syntax-vector-test syntax.sharp-left-paren.6
329  "#5(a b)" a b b b b)
330
331(def-syntax-vector-test syntax.sharp-left-paren.7
332  "#5(a b c d e)" a b c d e)
333
334(def-syntax-vector-test syntax.sharp-left-paren.8
335  "#9(a b c d e)" a b c d e e e e e)
336
337(def-syntax-test syntax.sharp-left-paren.9
338  (let ((*read-base* 2))
339    (read-from-string "#10(a)"))
340  #(a a a a a a a a a a)
341  6)
342
343(def-syntax-test syntax.sharp-left-paren.error.1
344  (signals-error (read-from-string "#(") end-of-file)
345  t)
346
347(def-syntax-test syntax.sharp-left-paren.error.2
348  (signals-error (read-from-string "(#(" nil nil) end-of-file)
349  t)
350
351;;; Tests of #*
352
353(def-syntax-bit-vector-test syntax.sharp-asterisk.1
354  "#*")
355
356(def-syntax-bit-vector-test syntax.sharp-asterisk.2
357  "#0*")
358
359(def-syntax-bit-vector-test syntax.sharp-asterisk.3
360  "#1*0" 0)
361
362(def-syntax-bit-vector-test syntax.sharp-asterisk.4
363  "#1*1" 1)
364
365(def-syntax-bit-vector-test syntax.sharp-asterisk.5
366  "#2*1" 1 1)
367
368(def-syntax-bit-vector-test syntax.sharp-asterisk.6
369  "#2*0" 0 0)
370
371(def-syntax-bit-vector-test syntax.sharp-asterisk.7
372  "#5*010" 0 1 0 0 0)
373
374(def-syntax-bit-vector-test syntax.sharp-asterisk.8
375  "#7*0101" 0 1 0 1 1 1 1)
376
377(def-syntax-bit-vector-test syntax.sharp-asterisk.9
378  "#10*01010" 0 1 0 1 0 0 0 0 0 0)
379
380(def-syntax-test syntax.sharp-asterisk.10
381  (let ((*read-base* 3))
382    (read-from-string "#10*01"))
383  #*0111111111
384  6)
385
386(def-syntax-test syntax.sharp-asterisk.11
387  (let ((*read-suppress* t))
388    (values (read-from-string "#1* ")))
389  nil)
390
391(def-syntax-test syntax.sharp-asterisk.12
392  (let ((*read-suppress* t))
393    (values (read-from-string "#1*00")))
394  nil)
395
396(def-syntax-test syntax.sharp-asterisk.13
397  (let ((*read-suppress* t))
398    (values (read-from-string "#*012")))
399  nil)
400
401(def-syntax-test syntax.sharp-asterisk.error.1
402  (signals-error (read-from-string "#1* X") reader-error)
403  t)
404
405(def-syntax-test syntax.sharp-asterisk.error.2
406  (signals-error (read-from-string "#2*011") reader-error)
407  t)
408
409(def-syntax-test syntax.sharp-asterisk.error.3
410  (signals-error (read-from-string "#*012") reader-error)
411  t)
412
413;;; Tests of #: ...
414
415; (def-syntax-unintern-test syntax.sharp-colon.1 "")
416; (def-syntax-unintern-test syntax.sharp-colon.2 "#")
417(def-syntax-unintern-test syntax.sharp-colon.3 "a")
418(def-syntax-unintern-test syntax.sharp-colon.4 "A")
419(def-syntax-unintern-test syntax.sharp-colon.5 "NIL")
420(def-syntax-unintern-test syntax.sharp-colon.6 "T")
421(def-syntax-unintern-test syntax.sharp-colon.7 ".")
422
423
424;;; Tests of #.
425
426(def-syntax-test syntax.sharp-dot.1
427  (read-from-string "#.(+ 1 2)")
428  3 9)
429
430(def-syntax-test syntax.sharp-dot.2
431  (read-from-string "#.'X")
432  X 4)
433
434(def-syntax-test syntax.sharp-dot.error.1
435  (signals-error (read-from-string "#.") end-of-file)
436  t)
437
438(def-syntax-test syntax.sharp-dot.error.2
439  (signals-error (read-from-string "(#." nil nil) end-of-file)
440  t)
441
442(def-syntax-test syntax.sharp-dot.error.3
443  (signals-error (let ((*read-eval* nil)) (read-from-string "#.1")) reader-error)
444  t)
445
446;;; Tests of #B
447
448(def-syntax-test syntax.sharp-b.1
449  (read-from-string "#b0")
450  0 3)
451
452(def-syntax-test syntax.sharp-b.2
453  (read-from-string "#B1")
454  1 3)
455
456(def-syntax-test syntax.sharp-b.3
457  (read-from-string "#b101101")
458  45 8)
459
460(def-syntax-test syntax.sharp-b.4
461  (read-from-string "#B101101")
462  45 8)
463
464(def-syntax-test syntax.sharp-b.5
465  (read-from-string "#b010001/100")
466  17/4 12)
467
468(def-syntax-test syntax.sharp-b.6
469  (read-from-string "#b-10011")
470  -19 8)
471
472(def-syntax-test syntax.sharp-b.7
473  (read-from-string "#B-1/10")
474  -1/2 7)
475
476(def-syntax-test syntax.sharp-b.8
477  (read-from-string "#B-0/10")
478  0 7)
479
480(def-syntax-test syntax.sharp-b.9
481  (read-from-string "#b0/111")
482  0 7)
483
484(def-syntax-test syntax.sharp-b.10
485  (let ((*read-eval* nil))
486    (read-from-string "#b-10/11"))
487  -2/3 8)
488
489;;; Tests of #O
490
491(def-syntax-test syntax.sharp-o.1
492  (read-from-string "#o0")
493  0 3)
494
495(def-syntax-test syntax.sharp-o.2
496  (read-from-string "#O7")
497  7 3)
498
499(def-syntax-test syntax.sharp-o.3
500  (read-from-string "#o10")
501  8 4)
502
503(def-syntax-test syntax.sharp-o.4
504  (read-from-string "#O011")
505  9 5)
506
507(def-syntax-test syntax.sharp-o.5
508  (read-from-string "#o-0")
509  0 4)
510
511(def-syntax-test syntax.sharp-o.6
512  (read-from-string "#O-1")
513  -1 4)
514
515(def-syntax-test syntax.sharp-o.7
516  (read-from-string "#O11/10")
517  9/8 7)
518
519(def-syntax-test syntax.sharp-o.8
520  (read-from-string "#o-1/10")
521  -1/8 7)
522
523(def-syntax-test syntax.sharp-o.9
524  (read-from-string "#O0/10")
525  0 6)
526
527(def-syntax-test syntax.sharp-o.10
528  (let ((*read-eval* nil))
529    (read-from-string "#o-10/11"))
530  -8/9 8)
531
532;;; Tests of #X
533
534(def-syntax-test syntax.sharp-x.1
535  (read-from-string "#x0")
536  0 3)
537
538(def-syntax-test syntax.sharp-x.2
539  (read-from-string "#X1")
540  1 3)
541
542(def-syntax-test syntax.sharp-x.3
543  (read-from-string "#xa")
544  10 3)
545
546(def-syntax-test syntax.sharp-x.4
547  (read-from-string "#Xb")
548  11 3)
549
550(def-syntax-test syntax.sharp-x.5
551  (read-from-string "#XC")
552  12 3)
553
554(def-syntax-test syntax.sharp-x.6
555  (read-from-string "#xD")
556  13 3)
557
558(def-syntax-test syntax.sharp-x.7
559  (read-from-string "#xe")
560  14 3)
561
562(def-syntax-test syntax.sharp-x.8
563  (read-from-string "#Xf")
564  15 3)
565
566(def-syntax-test syntax.sharp-x.9
567  (read-from-string "#x10")
568  16 4)
569
570(def-syntax-test syntax.sharp-x.10
571  (read-from-string "#X1ab")
572  427 5)
573
574(def-syntax-test syntax.sharp-x.11
575  (read-from-string "#x-1")
576  -1 4)
577
578(def-syntax-test syntax.sharp-x.12
579  (read-from-string "#X-0")
580  0 4)
581
582(def-syntax-test syntax.sharp-x.13
583  (read-from-string "#xa/B")
584  10/11 5)
585
586(def-syntax-test syntax.sharp-x.14
587  (read-from-string "#X-1/1c")
588  -1/28 7)
589
590(def-syntax-test syntax.sharp-x.15
591  (let ((*read-eval* nil))
592    (read-from-string "#x-10/11"))
593  -16/17 8)
594
595;;; Tests of #nR
596
597(def-syntax-test syntax.sharp-r.1
598  (loop for i = (random (ash 1 (+ 2 (random 32))))
599        for base = (+ 2 (random 35))
600        for s = (write-to-string i :radix nil :base base :readably nil)
601        for c = (random-from-seq "rR")
602        for s2 = (format nil "#~d~c~a" base c s)
603        for s3 = (rcase (1 (string-upcase s2))
604                        (1 (string-downcase s2))
605                        (1 (string-capitalize s2))
606                        (1 s2))
607        for base2 = (+ 2 (random 35))
608        for vals = (let ((*read-base* base2))
609                     (multiple-value-list
610                      (read-from-string s3)))
611        repeat 1000
612        unless (equal vals (list i (length s3) ))
613        collect (list i base s c s2 s3 base2 vals))
614  nil)
615
616(def-syntax-test syntax.sharp-r.2
617  (read-from-string "#2r0")
618  0 4)
619
620(def-syntax-test syntax.sharp-r.3
621  (read-from-string "#36r0")
622  0 5)
623
624(def-syntax-test syntax.sharp-r.4
625  (read-from-string "#29R-0")
626  0 6)
627
628(def-syntax-test syntax.sharp-r.5
629  (read-from-string "#23r-1")
630  -1 6)
631
632(def-syntax-test syntax.sharp-r.6
633  (read-from-string "#17r11")
634  18 6)
635
636(def-syntax-test syntax.sharp-t.7
637  (read-from-string "#3r10/11")
638  3/4 8)
639
640(def-syntax-test syntax.sharp-t.8
641  (read-from-string "#5R-10/11")
642  -5/6 9)
643
644;;; Tests of #c
645
646(def-syntax-test syntax.sharp-c.1
647  (read-from-string "#c(1 1)")
648  #.(complex 1 1) 7)
649
650(def-syntax-test syntax.sharp-c.2
651  (read-from-string "#C(1 0)")
652  1 7)
653
654(def-syntax-test syntax.sharp-c.3
655  (read-from-string "#c(0 1)")
656  #.(complex 0 1) 7)
657
658(def-syntax-test syntax.sharp-c.4
659  (read-from-string "#c(-1/2 1)")
660  #.(complex -1/2 1) 10)
661
662(def-syntax-test syntax.sharp-c.5
663  (read-from-string "#c (1 1)")
664  #.(complex 1 1) 8)
665
666(def-syntax-test syntax.sharp-c.6
667  (loop for format in '(short-float single-float double-float long-float)
668        for c = (let ((*read-default-float-format* format))
669                  (read-from-string "#c(1.0 0.0)"))
670        unless (eql c (complex (coerce 1 format)
671                               (coerce 0 format)))
672        collect (list format c))
673  nil)
674
675(def-syntax-test syntax.sharp-c.7
676  (loop for format in '(short-float single-float double-float long-float)
677        for c = (let ((*read-default-float-format* format))
678                  (read-from-string "#C(0.0 1.0)"))
679        unless (eql c (complex (coerce 0 format)
680                               (coerce 1 format)))
681        collect (list format c))
682  nil)
683
684;;; Tests of #a
685
686(def-syntax-array-test syntax.sharp-a.1
687  "#0anil"
688  (make-array nil :initial-element nil))
689
690(def-syntax-array-test syntax.sharp-a.2
691  "#0a1"
692  (make-array nil :initial-element 1))
693
694(def-syntax-array-test syntax.sharp-a.3
695  "#1a(1 2 3 5)"
696  (make-array '(4) :initial-contents '(1 2 3 5)))
697
698(def-syntax-array-test syntax.sharp-a.4
699  "#1a\"abcd\""
700  (make-array '(4) :initial-contents '(#\a #\b #\c #\d)))
701
702(def-syntax-array-test syntax.sharp-a.5
703  "#1a#1a(:a :b :c)"
704  (make-array '(3) :initial-contents '(:a :b :c)))
705
706(def-syntax-array-test syntax.sharp-a.6
707  "#1a#.(coerce \"abcd\" 'simple-base-string)"
708  (make-array '(4) :initial-contents '(#\a #\b #\c #\d)))
709
710(def-syntax-array-test syntax.sharp-a.7
711  "#1a#*000110"
712  (make-array '(6) :initial-contents '(0 0 0 1 1 0)))
713
714(def-syntax-array-test syntax.sharp-a.8
715  "#1a#.(make-array 4 :element-type '(unsigned-byte 8)
716                      :initial-contents '(1 2 3 5))"
717  (make-array '(4) :initial-contents '(1 2 3 5)))
718
719(def-syntax-array-test syntax.sharp-a.9
720  "#1a#.(make-array 4 :element-type '(unsigned-byte 4)
721                      :initial-contents '(1 2 3 5))"
722  (make-array '(4) :initial-contents '(1 2 3 5)))
723
724(def-syntax-array-test syntax.sharp-a.10
725  "#1a#.(make-array 4 :element-type '(signed-byte 4)
726                      :initial-contents '(1 2 3 5))"
727  (make-array '(4) :initial-contents '(1 2 3 5)))
728
729(def-syntax-array-test syntax.sharp-a.11
730  "#1a#.(make-array 4 :element-type '(signed-byte 8)
731                      :initial-contents '(1 2 3 5))"
732  (make-array '(4) :initial-contents '(1 2 3 5)))
733
734(def-syntax-array-test syntax.sharp-a.12
735  "#1a#.(make-array 4 :element-type '(unsigned-byte 16)
736                      :initial-contents '(1 2 3 5))"
737  (make-array '(4) :initial-contents '(1 2 3 5)))
738
739(def-syntax-array-test syntax.sharp-a.13
740  "#1a#.(make-array 4 :element-type '(signed-byte 16)
741                      :initial-contents '(1 2 3 5))"
742  (make-array '(4) :initial-contents '(1 2 3 5)))
743
744(def-syntax-array-test syntax.sharp-a.14
745  "#1a#.(make-array 4 :element-type '(unsigned-byte 32)
746                      :initial-contents '(1 2 3 5))"
747  (make-array '(4) :initial-contents '(1 2 3 5)))
748
749(def-syntax-array-test syntax.sharp-a.15
750  "#1a#.(make-array 4 :element-type '(signed-byte 32)
751                      :initial-contents '(1 2 3 5))"
752  (make-array '(4) :initial-contents '(1 2 3 5)))
753
754(def-syntax-array-test syntax.sharp-a.16
755  "#1a#.(make-array 4 :element-type 'fixnum
756                      :initial-contents '(1 2 3 5))"
757  (make-array '(4) :initial-contents '(1 2 3 5)))
758
759(def-syntax-array-test syntax.sharp-a.17
760  "#1anil"
761  (make-array '(0)))
762
763(def-syntax-array-test syntax.sharp-a.18
764  "#2anil"
765  (make-array '(0 0)))
766
767(def-syntax-array-test syntax.sharp-a.19
768  "#2a((2))"
769  (make-array '(1 1) :initial-element 2))
770
771(def-syntax-array-test syntax.sharp-a.20
772  "#2a((1 2 3)(4 5 6))"
773  (make-array '(2 3) :initial-contents #(#(1 2 3) #(4 5 6))))
774
775(def-syntax-array-test syntax.sharp-a.21
776  "#2a#(#(1 2 3)#(4 5 6))"
777  (make-array '(2 3) :initial-contents '((1 2 3) (4 5 6))))
778
779(def-syntax-array-test syntax.sharp-a.22
780  "#2a\"\""
781  (make-array '(0 0)))
782
783(def-syntax-array-test syntax.sharp-a.23
784  "#2a#*"
785  (make-array '(0 0)))
786
787(def-syntax-array-test syntax.sharp-a.24
788  "#1a#.(make-array '(10) :fill-pointer 5 :initial-element 17)"
789  (make-array '(5) :initial-contents '(17 17 17 17 17)))
790
791(def-syntax-array-test syntax.sharp-a.25
792  "#1a#.(make-array '(5) :adjustable t :initial-element 17)"
793  (make-array '(5) :initial-contents '(17 17 17 17 17)))
794
795(def-syntax-array-test syntax.sharp-a.26
796  "#1A#.(let ((x (make-array '(10) :adjustable t
797                      :initial-contents '(1 2 3 4 5 6 7 8 9 10))))
798           (make-array '(5) :displaced-to x :displaced-index-offset 2))"
799  (make-array '(5) :initial-contents '(3 4 5 6 7)))
800
801;;; Tests of #S
802
803(unless (find-class 'syntax-test-struct-1 nil)
804  (defstruct syntax-test-struct-1
805    a b c))
806
807(def-syntax-test syntax.sharp-s.1
808  (let ((v (read-from-string "#s(syntax-test-struct-1)")))
809    (values
810     (notnot (typep v 'syntax-test-struct-1))
811     (syntax-test-struct-1-a v)
812     (syntax-test-struct-1-b v)
813     (syntax-test-struct-1-c v)))
814  t nil nil nil)
815
816(def-syntax-test syntax.sharp-s.2
817  (let ((v (read-from-string "#S(syntax-test-struct-1 :a x :c y :b z)")))
818    (values
819     (notnot (typep v 'syntax-test-struct-1))
820     (syntax-test-struct-1-a v)
821     (syntax-test-struct-1-b v)
822     (syntax-test-struct-1-c v)))
823  t x z y)
824
825(def-syntax-test syntax.sharp-s.3
826  (let ((v (read-from-string "#s(syntax-test-struct-1 \"A\" x)")))
827    (values
828     (notnot (typep v 'syntax-test-struct-1))
829     (syntax-test-struct-1-a v)
830     (syntax-test-struct-1-b v)
831     (syntax-test-struct-1-c v)))
832  t x nil nil)
833
834(def-syntax-test syntax.sharp-s.4
835  (let ((v (read-from-string "#S(syntax-test-struct-1 #\\A x)")))
836    (values
837     (notnot (typep v 'syntax-test-struct-1))
838     (syntax-test-struct-1-a v)
839     (syntax-test-struct-1-b v)
840     (syntax-test-struct-1-c v)))
841  t x nil nil)
842
843(def-syntax-test syntax.sharp-s.5
844  (let ((v (read-from-string "#s(syntax-test-struct-1 :a x :a y)")))
845    (values
846     (notnot (typep v 'syntax-test-struct-1))
847     (syntax-test-struct-1-a v)
848     (syntax-test-struct-1-b v)
849     (syntax-test-struct-1-c v)))
850  t x nil nil)
851
852(def-syntax-test syntax.sharp-s.6
853  (let ((v (read-from-string "#S(syntax-test-struct-1 :a x :allow-other-keys 1)")))
854    (values
855     (notnot (typep v 'syntax-test-struct-1))
856     (syntax-test-struct-1-a v)
857     (syntax-test-struct-1-b v)
858     (syntax-test-struct-1-c v)))
859  t x nil nil)
860
861(def-syntax-test syntax.sharp-s.7
862  (let ((v (read-from-string "#s(syntax-test-struct-1 :b z :allow-other-keys nil)")))
863    (values
864     (notnot (typep v 'syntax-test-struct-1))
865     (syntax-test-struct-1-a v)
866     (syntax-test-struct-1-b v)
867     (syntax-test-struct-1-c v)))
868  t nil z nil)
869
870
871(def-syntax-test syntax.sharp-s.8
872  (let ((v (read-from-string "#S(syntax-test-struct-1 :b z :allow-other-keys t :a x :foo bar)")))
873    (values
874     (notnot (typep v 'syntax-test-struct-1))
875     (syntax-test-struct-1-a v)
876     (syntax-test-struct-1-b v)
877     (syntax-test-struct-1-c v)))
878  t x z nil)
879
880(def-syntax-test syntax.sharp-s.9
881  (let ((v (read-from-string "#s(syntax-test-struct-1 a x c y b z :a :bad :b bad2 :c bad3)")))
882    (values
883     (notnot (typep v 'syntax-test-struct-1))
884     (syntax-test-struct-1-a v)
885     (syntax-test-struct-1-b v)
886     (syntax-test-struct-1-c v)))
887  t x z y)
888
889(def-syntax-test syntax.sharp-s.10
890  (let ((v (read-from-string "#S(syntax-test-struct-1 #:a x #:c y #:b z)")))
891    (values
892     (notnot (typep v 'syntax-test-struct-1))
893     (syntax-test-struct-1-a v)
894     (syntax-test-struct-1-b v)
895     (syntax-test-struct-1-c v)))
896  t x z y)
897
898;; (Put more tests of this in the structure tests)
899
900;;; Tests of #P
901
902(def-syntax-test syntax.sharp-p.1
903  (read-from-string "#p\"\"")
904  #.(parse-namestring "") 4)
905
906(def-syntax-test syntax.sharp-p.2
907  (read-from-string "#P\"syntax.lsp\"")
908  #.(parse-namestring "syntax.lsp") 14)
909
910(def-syntax-test syntax.sharp-p.3
911  (read-from-string "#P \"syntax.lsp\"")
912  #.(parse-namestring "syntax.lsp") 15)
913
914(def-syntax-test syntax.sharp-p.4
915  (let ((*read-eval* nil))
916    (read-from-string "#p\"syntax.lsp\""))
917  #.(parse-namestring "syntax.lsp") 14)
918
919(def-syntax-test syntax.sharp-p.5
920  (read-from-string "#P#.(make-array '(10) :initial-contents \"syntax.lsp\" :element-type 'base-char)")
921  #.(parse-namestring "syntax.lsp") 78)
922
923;;; #<number># and #<number>=
924
925(def-syntax-test syntax.sharp-circle.1
926  (let ((x (read-from-string "(#1=(17) #1#)")))
927    (assert (eq (car x) (cadr x)))
928    x)
929  ((17) (17)))
930
931(def-syntax-test syntax.sharp-circle.2
932  (let ((x (read-from-string "(#0=(17) #0#)")))
933    (assert (eq (car x) (cadr x)))
934    x)
935  ((17) (17)))
936
937(def-syntax-test syntax.sharp-circle.3
938  (let ((x (read-from-string "(#123456789123456789=(17) #123456789123456789#)")))
939    (assert (eq (car x) (cadr x)))
940    x)
941  ((17) (17)))
942
943(def-syntax-test syntax.sharp-circle.4
944  (let ((x (read-from-string "#1=(A B . #1#)")))
945    (assert (eq (cddr x) x))
946    (values (car x) (cadr x)))
947  a b)
948
949(def-syntax-test syntax.sharp-circle.5
950  (let ((x (read-from-string "#1=#(A B #1#)")))
951    (assert (typep x '(simple-vector 3)))
952    (assert (eq (elt x 2) x))
953    (values (elt x 0) (elt x 1)))
954  a b)
955
956(def-syntax-test syntax.sharp-circle.6
957  (let ((x (read-from-string "((#1=(17)) #1#)")))
958    (assert (eq (caar x) (cadr x)))
959    x)
960  (((17)) (17)))
961
962(def-syntax-test syntax.sharp-circle.7
963  (let ((x (read-from-string "((#1=#2=(:x)) #1# #2#)")))
964    (assert (eq (caar x) (cadr x)))
965    (assert (eq (caar x) (caddr x)))
966    x)
967  (((:x)) (:x) (:x)))
968
969;;; #+
970
971(def-syntax-test syntax.sharp-plus.1
972  (let ((*features* nil))
973    (read-from-string "#+X :bad :good"))
974  :good 14)
975
976(def-syntax-test syntax.sharp-plus.2
977  (let ((*features* '(:a :x :b)))
978    (read-from-string "#+X :good :bad"))
979  :good 10)
980
981(def-syntax-test syntax.sharp-plus.3
982  (let ((*features* '(:a :x :b)))
983    (read-from-string "#+:x :good :bad"))
984  :good 11)
985
986(def-syntax-test syntax.sharp-plus.4
987  (let ((*features* '(:a :x :b)))
988    (read-from-string "#+(and):good :bad"))
989  :good 13)
990
991(def-syntax-test syntax.sharp-plus.5
992  (let ((*features* '(:a :x :b)))
993    (read-from-string "#+(:and):good :bad"))
994  :good 14)
995
996(def-syntax-test syntax.sharp-plus.6
997  (let ((*features* '(:a :x :b)))
998    (read-from-string "#+(or) :bad :good"))
999  :good 17)
1000
1001(def-syntax-test syntax.sharp-plus.7
1002  (let ((*features* '(:a :x :b)))
1003    (read-from-string "#+(:or) :bad :good"))
1004  :good 18)
1005
1006(def-syntax-test syntax.sharp-plus.8
1007  (let ((*features* '(x)))
1008    (read-from-string "#+X :bad :good"))
1009  :good 14)
1010
1011(def-syntax-test syntax.sharp-plus.9
1012  (let ((*features* '(x)))
1013    (read-from-string "#+CL-TEST::X :good :bad"))
1014  :good 19)
1015
1016(def-syntax-test syntax.sharp-plus.10
1017  (let ((*features* nil))
1018    (read-from-string "#+(not x) :good :bad"))
1019  :good 16)
1020
1021(def-syntax-test syntax.sharp-plus.11
1022  (let ((*features* '(:x)))
1023    (read-from-string "#+(not x) :bad :good"))
1024  :good 20)
1025
1026(def-syntax-test syntax.sharp-plus.12
1027  (let ((*features* nil))
1028    (read-from-string "#+(:not :x) :good :bad"))
1029  :good 18)
1030
1031(def-syntax-test syntax.sharp-plus.13
1032  (let ((*features* '(:a :x :b)))
1033    (read-from-string "#+(and a b) :good :bad"))
1034  :good 18)
1035
1036(def-syntax-test syntax.sharp-plus.14
1037  (let ((*features* '(:a :x :b)))
1038    (read-from-string "#+(and a c) :bad :good"))
1039  :good 22)
1040
1041(def-syntax-test syntax.sharp-plus.15
1042  (let ((*features* '(:a :x :b)))
1043    (read-from-string "#+(or c b) :good :bad"))
1044  :good 17)
1045
1046(def-syntax-test syntax.sharp-plus.16
1047  (let ((*features* '(:a :x :b)))
1048    (read-from-string "#+(or c d) :bad :good"))
1049  :good 21)
1050
1051;;; Tests of #| |#
1052
1053(def-syntax-test syntax.sharp-bar.1
1054  (read-from-string "#||#1")
1055  1 5)
1056
1057(def-syntax-test syntax.sharp-bar.2
1058  (read-from-string "1#||#2")
1059  |1##2| 6)
1060
1061(def-syntax-test syntax.sharp-bar.3
1062  (read-from-string "#| #| |# |#1")
1063  1 12)
1064
1065(def-syntax-test syntax.sharp-bar.4
1066  (read-from-string "#| ; |#1")
1067  1 8)
1068
1069(def-syntax-test syntax.sharp-bar.5
1070  (read-from-string "#| ( |#1")
1071  1 8)
1072
1073(def-syntax-test syntax.sharp-bar.6
1074  (read-from-string "#| # |#1")
1075  1 8)
1076
1077(def-syntax-test syntax.sharp-bar.7
1078  (read-from-string "#| .. |#1")
1079  1 9)
1080
1081(def-syntax-test syntax.sharp-bar.8
1082  (loop for c across +standard-chars+
1083        for s = (concatenate 'string "\#| " (string c) " |\#1")
1084        for vals = (multiple-value-list (read-from-string s))
1085        unless (equal vals '(1 8))
1086        collect (list c s vals))
1087  nil)
1088
1089(def-syntax-test syntax.sharp-bar.9
1090  (loop for i below (min (ash 1 16) char-code-limit)
1091        for c = (code-char i)
1092        for s = (and c (concatenate 'string "\#| " (string c) " |\#1"))
1093        for vals = (and c (multiple-value-list (read-from-string s)))
1094        unless (or (not c) (equal vals '(1 8)))
1095        collect (list i c s vals))
1096  nil)
1097
1098(def-syntax-test syntax.sharp-bar.10
1099  (loop for i = (random (min (ash 1 24) char-code-limit))
1100        for c = (code-char i)
1101        for s = (and c (concatenate 'string "\#| " (string c) " |\#1"))
1102        for vals = (and c (multiple-value-list (read-from-string s)))
1103        repeat 1000
1104        unless (or (not c) (equal vals '(1 8)))
1105        collect (list i c s vals))
1106  nil)
1107
1108;;;; Various error cases
1109
1110(def-syntax-test syntax.sharp-whitespace.1
1111  (let ((names '("Tab" "Newline" "Linefeed" "Space" "Return" "Page")))
1112    (loop for name in names
1113          for c = (name-char name)
1114          when c
1115          nconc
1116          (let* ((form `(signals-error
1117                         (read-from-string ,(concatenate 'string "#" (string c)))
1118                         reader-error))
1119                 (vals (multiple-value-list (eval form))))
1120            (unless (equal vals '(t))
1121              (list (list name c form vals))))))
1122  nil)
1123
1124(def-syntax-test syntax.sharp-less-than.1
1125  (signals-error (read-from-string "#<" nil nil) reader-error)
1126  t)
1127
1128
1129(def-syntax-test syntax.sharp-close-paren.1
1130  (signals-error (read-from-string "#)" nil nil) reader-error)
1131  t)
1132
1133(def-syntax-test syntax.single-escape-eof.1
1134  (signals-error (read-from-string "\\") end-of-file)
1135  t)
1136
1137(def-syntax-test syntax.single-escape-eof.2
1138  (signals-error (read-from-string "\\" nil nil) end-of-file)
1139  t)
1140
1141(def-syntax-test syntax.multiple-escape-eof.1
1142  (signals-error (read-from-string "|") end-of-file)
1143  t)
1144
1145(def-syntax-test syntax.multiple-escape-eof.2
1146  (signals-error (read-from-string "|" nil nil) end-of-file)
1147  t)
1148
Note: See TracBrowser for help on using the repository browser.