/[gcl]/gcl/tests/readtable.tst
ViewVC logotype

Diff of /gcl/tests/readtable.tst

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by camm, Thu Dec 20 20:29:54 2001 UTC revision 1.2 by camm, Sun Feb 3 18:44:08 2002 UTC
# Line 0  Line 1 
1    ;*******************************************************************************
2    ;*      Rosenmueller  tel.340 Testquelle READTABLE.que    23.03.1988
3           *
4    ;*******************************************************************************
5    
6    (prin1-to-string (setq *readtable* (copy-readtable nil)))
7    "#<SYSTEM::%TYPE-READTABLE #<SYSTEM::%TYPE-SIMPLE-VECTOR SYSTEM::%TYPE-UNSIGNED-WORD-POINTER
8     00000000 00000000 00000000 00000000 00040001 00000004 00040004 00000000
9     00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000
10     00010004 011E0075 00010001 02250001 00A50395 0C010401 14010535 00010B41
11     06010601 06010601 06010601 06010601 06010601 00850701 08010001 00010001
12     0D010061 12010E01 00011501 00010001 00010001 00010001 00010001 0F010001
13     00010001 13011101 00010001 00010001 00011001 00010001 00010902 00010001
14     0D010055 12010E01 00011501 00010001 00010001 00010001 00010001 0F010001
15     00010001 13011101 00010001 00010001 00011001 00C50001 00B50A03 00010001>
16    NIL>"
17    
18    (setq $ 23)
19    23
20    
21    (defun single-dollar-reader (stream char)
22           (declare (ignore stream))
23           (intern (string char)))
24    SINGLE-DOLLAR-READER
25    
26    (set-macro-character #\$ #'single-dollar-reader)
27    T
28    
29    $
30    23
31    
32    45
33    45
34                                            ; => 23 => 45
35    (prin1-to-string (get-macro-character #\$))
36    "#<SYSTEM::%TYPE-CLOSURE SINGLE-DOLLAR-READER
37    NIL
38    NIL
39    (LAMBDA (STREAM CHAR) (DECLARE (IGNORE STREAM)) (INTERN (STRING CHAR)))>"
40    
41    
42    (progn (setq *readtable* (copy-readtable nil)) t)
43    t
44    
45    (sys::rt-bitmask-char #\" )
46    117
47    
48    (sys::rt-bitmask-char #\( )
49    917
50    
51    (sys::rt-bitmask-char #\) )
52    165
53    
54    (sys::rt-bitmask-char #\\ )
55    2306
56    
57    (sys::rt-bitmask-char #\x )
58    4097
59    
60    (sys::rt-bitmask-char #\y )
61    1
62    
63    (set-syntax-from-char #\" #\( )
64    T
65    
66    (sys::rt-bitmask-char #\" )
67    917
68    
69    (sys::rt-bitmask-char #\( )
70    917
71    
72    (sys::rt-bitmask-char #\) )
73    165
74    
75    (sys::rt-bitmask-char #\\ )
76    2306
77                    ; *readtable* nil
78                                            ; *readtable* cl-standard
79    (progn (setq doppelquote-liston-readtable (copy-readtable)) t)
80    t
81    
82    (sys::rt-bitmask-char #\" doppelquote-liston-readtable )
83    917
84    
85    (sys::rt-bitmask-char #\( doppelquote-liston-readtable )
86    917
87    
88    (sys::rt-bitmask-char #\) doppelquote-liston-readtable )
89    165
90    
91    (sys::rt-bitmask-char #\\ doppelquote-liston-readtable )
92    2306
93    
94    '"1 2 3)
95    (1 2 3)
96    
97    (set-syntax-from-char #\" #\\ )
98    T
99    
100    (sys::rt-bitmask-char #\" )
101    2306
102    
103    (sys::rt-bitmask-char #\( )
104    917
105    
106    (sys::rt-bitmask-char #\) )
107    165
108    
109    (sys::rt-bitmask-char #\\ )
110    2306
111    
112    (progn (setq doppelquote-backslash-readtable (copy-readtable)) t)
113    T
114    
115    (sys::rt-bitmask-char #\" doppelquote-backslash-readtable )
116    2306
117    
118    (sys::rt-bitmask-char #\\ doppelquote-backslash-readtable )
119    2306
120    
121    (sys::rt-bitmask-char #\( doppelquote-backslash-readtable )
122    917
123    
124    (sys::rt-bitmask-char #\) doppelquote-backslash-readtable )
125    165
126    
127    #"<
128    #\<
129    
130    (progn (setq 2.-doppelquote-backslash-readtable
131                            (copy-readtable doppelquote-backslash-readtable)) t)
132    t
133    
134    (sys::rt-bitmask-char #\" 2.-doppelquote-backslash-readtable )
135    2306
136    
137    (sys::rt-bitmask-char #\\ 2.-doppelquote-backslash-readtable )
138    2306
139    
140    (sys::rt-bitmask-char #\( 2.-doppelquote-backslash-readtable )
141    917
142    
143    (sys::rt-bitmask-char #\) 2.-doppelquote-backslash-readtable )
144    165
145    
146    (progn (setq 2.-doppelquote-liston-readtable
147                            (copy-readtable doppelquote-liston-readtable)) t)
148    t
149    
150    (sys::rt-bitmask-char #\" 2.-doppelquote-liston-readtable )
151    917
152    
153    (sys::rt-bitmask-char #\( 2.-doppelquote-liston-readtable )
154    917
155    
156    (sys::rt-bitmask-char #\) 2.-doppelquote-liston-readtable )
157    165
158    
159    (sys::rt-bitmask-char #\\ 2.-doppelquote-liston-readtable )
160    2306
161    
162    (progn (setq cl-standard-readtable
163                            (copy-readtable nil))
164           (setq *readtable* cl-standard-readtable) t)
165    t
166    
167    (sys::rt-bitmask-char #\" cl-standard-readtable )
168    117
169    
170    (sys::rt-bitmask-char #\( cl-standard-readtable )
171    917
172    
173    (sys::rt-bitmask-char #\) cl-standard-readtable )
174    165
175    
176    (sys::rt-bitmask-char #\\ cl-standard-readtable )
177    2306
178    
179    (sys::rt-bitmask-char #\" )
180    117
181    
182    (sys::rt-bitmask-char #\( )
183    917
184    
185    (sys::rt-bitmask-char #\) )
186    165
187    
188    (sys::rt-bitmask-char #\\ )
189    2306
190    
191    "1234"
192    "1234"
193    
194    (progn (setq *readtable* 2.-doppelquote-liston-readtable) t)
195    t
196    
197    (sys::rt-bitmask-char #\" )
198    917
199    
200    (sys::rt-bitmask-char #\( )
201    917
202    
203    (sys::rt-bitmask-char #\) )
204    165
205    
206    (sys::rt-bitmask-char #\\ )
207    2306
208    
209    '"1 2 3)
210    (1 2 3)
211    
212    (progn (setq *readtable* doppelquote-backslash-readtable) t)
213    T
214    
215    (sys::rt-bitmask-char #\" )
216    2306
217    
218    (sys::rt-bitmask-char #\( )
219    917
220    
221    (sys::rt-bitmask-char #\) )
222    165
223    
224    (sys::rt-bitmask-char #\\ )
225    2306
226    
227    #"<
228    #\<
229    
230    (readtablep 2.-doppelquote-backslash-readtable )
231    T
232    
233    (readtablep 1)
234    NIL
235    
236    
237    (set-syntax-from-char #\" #\" 2.-doppelquote-backslash-readtable )
238    T
239    
240    (sys::rt-bitmask-char #\" 2.-doppelquote-backslash-readtable )
241    117
242    
243    (sys::rt-bitmask-char #\\ 2.-doppelquote-backslash-readtable )
244    2306
245    
246    (sys::rt-bitmask-char #\( 2.-doppelquote-backslash-readtable )
247    917
248    
249    (sys::rt-bitmask-char #\) 2.-doppelquote-backslash-readtable )
250    165
251    
252    
253    (set-syntax-from-char #\) #\( 2.-doppelquote-backslash-readtable )
254    T
255    
256    (sys::rt-bitmask-char #\" 2.-doppelquote-backslash-readtable )
257    117
258    
259    (sys::rt-bitmask-char #\\ 2.-doppelquote-backslash-readtable )
260    2306
261    
262    (sys::rt-bitmask-char #\( 2.-doppelquote-backslash-readtable )
263    917
264    
265    (sys::rt-bitmask-char #\) 2.-doppelquote-backslash-readtable )
266    917
267    
268    
269    (set-syntax-from-char #\( #\) 2.-doppelquote-backslash-readtable )
270    T
271    
272    (sys::rt-bitmask-char #\" 2.-doppelquote-backslash-readtable )
273    117
274    
275    (sys::rt-bitmask-char #\\ 2.-doppelquote-backslash-readtable )
276    2306
277    
278    (sys::rt-bitmask-char #\( 2.-doppelquote-backslash-readtable )
279    165
280    
281    (sys::rt-bitmask-char #\) 2.-doppelquote-backslash-readtable )
282    917
283    
284    
285    (set-syntax-from-char #\( #\( 2.-doppelquote-liston-readtable
286                                  2.-doppelquote-backslash-readtable )
287    T
288    
289    (sys::rt-bitmask-char #\" 2.-doppelquote-liston-readtable )
290    917
291    
292    (sys::rt-bitmask-char #\( 2.-doppelquote-liston-readtable )
293    165
294    
295    (sys::rt-bitmask-char #\) 2.-doppelquote-liston-readtable )
296    165
297    
298    (sys::rt-bitmask-char #\\ 2.-doppelquote-liston-readtable )
299    2306
300    
301    
302    (set-syntax-from-char #\) #\) 2.-doppelquote-liston-readtable
303                                  2.-doppelquote-backslash-readtable )
304    T
305    
306    (sys::rt-bitmask-char #\" 2.-doppelquote-liston-readtable )
307    917
308    
309    (sys::rt-bitmask-char #\( 2.-doppelquote-liston-readtable )
310    165
311    
312    (sys::rt-bitmask-char #\) 2.-doppelquote-liston-readtable )
313    917
314    
315    (sys::rt-bitmask-char #\\ 2.-doppelquote-liston-readtable )
316    2306
317    
318    
319    (progn (setq *readtable* 2.-doppelquote-backslash-readtable ) t)
320    t
321    
322    )sys::rt-bitmask-char #\( (
323    165
324    
325    )sys::rt-bitmask-char #\) (
326    917
327    
328    )sys::rt-bitmask-char #\\ (
329    2306
330    
331    "1234"
332    "1234"
333    
334    ')1 2 3(
335    (1 2 3)
336    
337    )progn )setq *readtable* 2.-doppelquote-liston-readtable ( t(
338    t
339    
340    
341    )sys::rt-bitmask-char #\( (
342    165
343    
344    )sys::rt-bitmask-char #\) (
345    917
346    
347    )sys::rt-bitmask-char #\\ (
348    2306
349    
350    '"1234(
351    (1234)
352    
353    ')1 2 3(
354    (1 2 3)
355                    ; ) muesste listen-anfang-sein
356    )progn )setq *readtable* )copy-readtable nil(( t(
357    t
358    
359    (sys::rt-bitmask-char #\" )
360    117
361    
362    (sys::rt-bitmask-char #\( )
363    917
364    
365    (sys::rt-bitmask-char #\) )
366    165
367    
368    (sys::rt-bitmask-char #\\ )
369    2306
370    
371    (sys::rt-bitmask-char #\x )
372    4097
373    
374    (sys::rt-bitmask-char #\y )
375    1
376    
377    
378    (make-dispatch-macro-character #\x)
379    T
380    
381    (sys::rt-bitmask-char #\x )
382    4109
383    
384    (sys::rt-bitmask-char #\y )
385    1
386    
387    (defun d1 (a b c) (princ "1.dmacro"))
388    D1
389    
390    (d1 1 2 3)
391    "1.dmacro"
392    
393    (set-dispatch-macro-character #\x #\. #'d1)
394    T
395    
396    (sys::rt-bitmask-char #\x )
397    4109
398    
399    (prin1-to-string (get-dispatch-macro-character #\x #\.))
400    "#<SYSTEM::%TYPE-CLOSURE D1
401    NIL
402    NIL
403    (LAMBDA (A B C) (PRINC \"1.dmacro\"))>"
404    
405    (multiple-value-list (read-from-string "123x.45"))
406    (   123 3)
407    
408    (multiple-value-list (read-from-string "123x.45" t nil :start 3))
409    (   "1.dmacro" 5)
410    
411    (multiple-value-list (read-from-string "123x.45" t nil :start 5))
412    (45 7)
413    
414    
415    (make-dispatch-macro-character #\y)
416    T
417    
418    (s\Ys::rt-bitmask-char #\x )
419    4109
420    
421    (s\Ys::rt-bitmask-char #\y )
422    13
423    
424    (defun d2 (a b c) (princ "2.dmacro"))
425    D2
426    
427    (d2 1 2 3)
428    "2.dmacro"
429    
430    (set-dispatch-macro-character #\y #\, #'d2)
431    T
432    
433    (s\Ys::rt-bitmask-char #\x )
434    4109
435    
436    (s\Ys::rt-bitmask-char #\y )
437    13
438    
439    (prin1-to-string (get-dispatch-macro-character #\x #\.))
440    "#<SYSTEM::%TYPE-CLOSURE D1
441    NIL
442    NIL
443    (LAMBDA (A B C) (PRINC \"1.dmacro\"))>"
444    
445    (prin1-to-string (get-dispatch-macro-character #\y #\,))
446    "#<SYSTEM::%TYPE-CLOSURE D2
447    NIL
448    NIL
449    (LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
450    
451    (multiple-value-list (read-from-string "123y,45"))
452    (   123 3)
453    
454    (multiple-value-list (read-from-string "123y,45" t nil :start 3))
455    (   "2.dmacro" 5)
456    
457    (multiple-value-list (read-from-string "123y,45" t nil :start 5))
458    (45 7)
459    
460    (set-dispatch-macro-character #\x #\. #'d2)
461    T
462    
463    (s\Ys::rt-bitmask-char #\x )
464    4109
465    
466    (s\Ys::rt-bitmask-char #\y )
467    13
468    
469    (prin1-to-string (get-dispatch-macro-character #\y #\,))
470    "#<SYSTEM::%TYPE-CLOSURE D2
471    NIL
472    NIL
473    (LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
474    
475    (prin1-to-string (get-dispatch-macro-character #\x #\.))
476    "#<SYSTEM::%TYPE-CLOSURE D2
477    NIL
478    NIL
479    (LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
480    
481    (multiple-value-list (read-from-string "123x.45"))
482    (   123 3)
483    
484    (multiple-value-list (read-from-string "123x.45" t nil :start 3))
485    (   "2.dmacro" 5)
486    
487    (multiple-value-list (read-from-string "123x.45" t nil :start 5))
488    (45 7)
489    
490    (set-dispatch-macro-character #\y #\. #'d1)
491    T
492    
493    (s\Ys::rt-bitmask-char #\x )
494    4109
495    
496    (s\Ys::rt-bitmask-char #\y )
497    13
498    
499    (prin1-to-string (get-dispatch-macro-character #\x #\.))
500    "#<SYSTEM::%TYPE-CLOSURE D2
501    NIL
502    NIL
503    (LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
504    
505    (prin1-to-string (get-dispatch-macro-character #\y #\,))
506    "#<SYSTEM::%TYPE-CLOSURE D2
507    NIL
508    NIL
509    (LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
510    
511    (prin1-to-string (get-dispatch-macro-character #\y #\.))
512    "#<SYSTEM::%TYPE-CLOSURE D1
513    NIL
514    NIL
515    (LAMBDA (A B C) (PRINC \"1.dmacro\"))>"
516    
517    (multiple-value-list (read-from-string "123y.45"))
518    (   123 3)
519    
520    (multiple-value-list (read-from-string "123y.45" t nil :start 3))
521    (   "1.dmacro" 5)
522    
523    (multiple-value-list (read-from-string "123y.45" t nil :start 5))
524    (45 7)
525    
526    (multiple-value-list (read-from-string "123y,45"))
527    (   123 3)
528    
529    (multiple-value-list (read-from-string "123y,45" t nil :start 3))
530    (   "2.dmacro" 5)
531    
532    (multiple-value-list (read-from-string "123y,45" t nil :start 5))
533    (45 7)
534    
535    (progn (setq *readtable* (cop\Y-readtable nil nil)) t)
536    t
537    
538    (sys::rt-bitmask-char #\x )
539    4097
540    
541    (sys::rt-bitmask-char #\y )
542    1
543    
544    (get-dispatch-macro-character #\x #\.)
545    ERROR
546    
547    (get-dispatch-macro-character #\y #\,)
548    ERROR
549    
550    (get-dispatch-macro-character #\y #\.)
551    ERROR
552    
553    (defun |#{-reader| (stream char arg)
554      (declare (ignore char arg))
555      (mapcon #'(lambda (x)
556                  (mapcar #'(lambda (y)(list (car x) y))(cdr x)))
557              (read-delimited-list #\} stream)))
558    |#{|-|reader|
559    
560    (set-dispatch-macro-character #\# #\{ #'|#{-reader|)
561    T
562    
563    ;;      (set-macro-character #\} (get-macro-character #\)) nil))
564    ;;      geht bei uns nicht !
565    ;;      dafuer :
566    (set-syntax-from-char #\} #\) )
567    ;;      nicht notwendig, da superklammer
568    (progn
569    (setq read-st (make-string-input-stream "#{p q z a} #{a b c d}")) t)
570    T
571    
572    (read read-st)
573    ((P Q) (P Z) (P A) (Q Z) (Q A) (Z A))
574    
575    (read read-st)
576    ((A B) (A C) (A D) (B C) (B D) (C D))
577    
578    (progn (setq *readtable* (copy-readtable nil nil))
579           (makunbound 'doppelquote-liston-readtable)
580           (makunbound 'doppelquote-backslash-readtable)
581           (makunbound '2.-doppelquote-liston-readtable)
582           (makunbound '2.-doppelquote-backslash-readtable)
583           (makunbound 'cl-standard-readtable)
584           (makunbound 'read-st)
585           (makunbound '$)
586    t)
587    T
588    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26