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

Diff of /gcl/tests/iofkts.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    ;*      Test der I/O-Funktionen                                                *
3    ;*******************************************************************************
4    
5    (PROGN (IN-PACKAGE (QUOTE SYS)) T)
6    T
7    
8    ;--- let test ------------------------------------------------------------------
9    ; ewiger compiler-fehler
10    ;
11    
12    (progn (setq bs (make-broadcast-stream)) t)
13    T
14    
15    #+XCL *cur-broadcast-stream*
16    #+XCL NIL
17    
18    (print 123. bs)
19    123.
20    
21    #+XCL *cur-broadcast-stream*
22    #+XCL NIL
23    
24    ;-------------------------------------------------------------------------------
25    ; Unread test mit structure-stream
26    ;
27    
28    (SETQ STR1 "test 123456")   "test 123456"
29    
30    (PROGN (SETQ S1 (make-two-way-stream (MAKE-STRING-INPUT-STREAM STR1)
31                                         *standard-output*)) T)
32    T
33    
34    (READ S1)   TEST
35    
36    (READ-CHAR S1)   #\1
37    
38    (READ-CHAR S1)   #\2
39    
40    (UNREAD-CHAR #\2 S1)   NIL
41    
42    (READ-CHAR S1)   #\2
43    
44    (READ-CHAR S1)   #\3
45    
46    (READ-CHAR S1)   #\4
47    
48    (UNREAD-CHAR #\A S1)   ERROR
49    
50    (READ-CHAR S1)   #\5
51    
52    (READ-CHAR S1)   #\6
53    
54    (CLOSE S1)   T
55    
56    STR1   "test 123456"
57    
58    
59    ;-------------------------------------------------------------------------------
60    
61    (MULTIPLE-VALUE-LIST (PARSE-INTEGER "abc"))
62    ERROR
63    
64    (MULTIPLE-VALUE-LIST (PARSE-INTEGER "  abc  "))
65    ERROR
66    
67    (MULTIPLE-VALUE-LIST (PARSE-INTEGER "123"))
68    (123 3)
69    
70    (MULTIPLE-VALUE-LIST (PARSE-INTEGER "  123  "))
71    (123 7)
72    
73    (MULTIPLE-VALUE-LIST (PARSE-INTEGER "123 t"))
74    ERROR
75    
76    (MULTIPLE-VALUE-LIST (PARSE-INTEGER "  123   t  "))
77    ERROR
78    
79    (MULTIPLE-VALUE-LIST (PARSE-INTEGER " ( 12 ) 43   t  "))
80    ERROR
81    
82    (MULTIPLE-VALUE-LIST (PARSE-INTEGER "  abc  " :JUNK-ALLOWED T))
83    (NIL 2)
84    
85    (MULTIPLE-VALUE-LIST (PARSE-INTEGER "123" :JUNK-ALLOWED T))
86    (123 3)
87    
88    (MULTIPLE-VALUE-LIST (PARSE-INTEGER "  123  " :JUNK-ALLOWED T))
89    (123 #+XCL 7 #+CLISP 5)
90    
91    (MULTIPLE-VALUE-LIST (PARSE-INTEGER "123 t" :JUNK-ALLOWED T))
92    (123 #+XCL 4 #+CLISP 3)
93    
94    (MULTIPLE-VALUE-LIST (PARSE-INTEGER "  123   t  " :JUNK-ALLOWED T))
95    (123 #+XCL 8 #+CLISP 5)
96    
97    (MULTIPLE-VALUE-LIST (PARSE-INTEGER " ( 12 ) 43   t  " :JUNK-ALLOWED
98    T))
99    (NIL 1)
100    
101    (SETQ A "q w e 1 2 r 4 d : :;;;")
102    "q w e 1 2 r 4 d : :;;;"
103    
104    (SETQ B "1 2 3 4 5 6 7")
105    "1 2 3 4 5 6 7"
106    
107    (SETQ C "1.3 4.223")
108    "1.3 4.223"
109    
110    (SETQ D "q w e r t z")
111    "q w e r t z"
112    
113    (MULTIPLE-VALUE-LIST (PARSE-INTEGER A))
114    ERROR
115    
116    (MULTIPLE-VALUE-LIST (PARSE-INTEGER B))
117    ERROR
118    
119    (MULTIPLE-VALUE-LIST (PARSE-INTEGER C))
120    ERROR
121    
122    (MULTIPLE-VALUE-LIST (PARSE-INTEGER D))
123    ERROR
124    
125    (MULTIPLE-VALUE-LIST (PARSE-INTEGER A :START 4 :END 6))
126    ERROR
127    
128    (MULTIPLE-VALUE-LIST (PARSE-INTEGER B :START 2 :END 3))
129    (2 3)
130    
131    (MULTIPLE-VALUE-LIST (PARSE-INTEGER C :START 1))
132    ERROR
133    
134    (MULTIPLE-VALUE-LIST (PARSE-INTEGER D :START 6))
135    ERROR
136    
137    (MULTIPLE-VALUE-LIST (PARSE-INTEGER A :END 4))
138    ERROR
139    
140    (MULTIPLE-VALUE-LIST (PARSE-INTEGER B :END 3))
141    ERROR
142    
143    (MULTIPLE-VALUE-LIST (PARSE-INTEGER C :END 3))
144    ERROR
145    
146    (MULTIPLE-VALUE-LIST (PARSE-INTEGER D :END 1))
147    ERROR
148    
149    (MULTIPLE-VALUE-LIST (PARSE-INTEGER A :RADIX 1))
150    ERROR
151    
152    (MULTIPLE-VALUE-LIST (PARSE-INTEGER B :RADIX 10))
153    ERROR
154    
155    (MULTIPLE-VALUE-LIST (PARSE-INTEGER C :RADIX 20))
156    ERROR
157    
158    (MULTIPLE-VALUE-LIST (PARSE-INTEGER D :RADIX 40))
159    ERROR
160    
161    (MULTIPLE-VALUE-LIST (PARSE-INTEGER A :JUNK-ALLOWED T))
162    (NIL 0)
163    
164    (MULTIPLE-VALUE-LIST (PARSE-INTEGER B :JUNK-ALLOWED T))
165    (1 #+XCL 2 #+CLISP 1)
166    
167    (MULTIPLE-VALUE-LIST (PARSE-INTEGER C :JUNK-ALLOWED T))
168    (1 1)
169    
170    (MULTIPLE-VALUE-LIST (PARSE-INTEGER D :JUNK-ALLOWED T))
171    (NIL 0)
172    
173    (STREAM-ELEMENT-TYPE #+XCL STDIN #-XCL *TERMINAL-IO*)
174    STRING-CHAR
175    
176    (PROGN (SETQ A (MAKE-STRING-INPUT-STREAM "aaa bbb")) T)
177    T
178    
179    (READ A)
180    AAA
181    
182    #+XCL (B-CLEAR-INPUT A)
183    #+XCL NIL
184    
185    (READ A)
186    #+XCL ERROR
187    #-XCL BBB
188    
189    (PROGN (SETQ A (MAKE-STRING-OUTPUT-STREAM))
190           (SETQ B (MAKE-STRING-OUTPUT-STREAM))
191           (SETQ C (MAKE-BROADCAST-STREAM A B)) T)
192    T
193    
194    (PRINT "xxx" C)
195    "xxx"
196    
197    (CLEAR-OUTPUT C)
198    NIL
199    
200    (FINISH-OUTPUT C)
201    #+XCL T
202    #-XCL NIL
203    
204    (GET-OUTPUT-STREAM-STRING A)
205    "
206    \"xxx\" "
207    
208    (GET-OUTPUT-STREAM-STRING B)
209    "
210    \"xxx\" "
211    
212    (PRINT "yyy" C)
213    "yyy"
214    
215    (CLEAR-OUTPUT C)
216    NIL
217    
218    (FINISH-OUTPUT C)
219    #+XCL T
220    #-XCL NIL
221    
222    (PRINT "zzz" A)
223    "zzz"
224    
225    (CLEAR-OUTPUT A)
226    NIL
227    
228    (FINISH-OUTPUT A)
229    #+XCL T
230    #-XCL NIL
231    
232    (GET-OUTPUT-STREAM-STRING A)
233    #+XCL ""
234    #-XCL "
235    \"yyy\"
236    \"zzz\" "
237    
238    (GET-OUTPUT-STREAM-STRING B)
239    "
240    \"yyy\" "
241    
242    (PROGN (SETQ A (MAKE-STRING-INPUT-STREAM "123")) T)
243    T
244    
245    (LISTEN A)
246    T
247    
248    (READ A)
249    123
250    
251    (listen a)
252    NIL
253    
254    *PRINT-CASE*
255    :UPCASE
256    
257    *PRINT-GENSYM*
258    T
259    
260    *PRINT-LEVEL*
261    NIL
262    
263    *PRINT-LENGTH*
264    NIL
265    
266    *PRINT-ARRAY*
267    T
268    
269    *PRINT-ESCAPE*
270    T
271    
272    *PRINT-PRETTY*
273    NIL
274    
275    *PRINT-CIRCLE*
276    NIL
277    
278    *PRINT-BASE*
279    10
280    
281    *PRINT-RADIX*
282    NIL
283    
284    (SETQ STRING1 "Das ist ein Test mit Print ")
285    "Das ist ein Test mit Print "
286    
287    (PRIN1-TO-STRING STRING1)
288    "\"Das ist ein Test mit Print \""
289    
290    (PRINC-TO-STRING STRING1)
291    "Das ist ein Test mit Print "
292    
293    (PROGN (SETQ A (MAKE-STRING-INPUT-STREAM "123")) T)
294    T
295    
296    (READ-CHAR-NO-HANG A)
297    #\1
298    
299    (READ A)
300    23
301    
302    (read-char-no-hang a)
303    ERROR
304    
305    (read-char-no-hang a nil "EOF")
306    "EOF"
307    
308    (PROGN (SETQ A (MAKE-STRING-INPUT-STREAM "1   2   ;32  abA"))
309    (SETQ B (MAKE-STRING-INPUT-STREAM " 1 2 3 A x y z
310    a b c")) T)
311    T
312    
313    (READ-DELIMITED-LIST #\A B)
314    (1 2 3)
315    
316    (SETQ C (MULTIPLE-VALUE-LIST (READ-LINE B)))
317    (" x y z" NIL)
318    
319    (LENGTH C)
320    2
321    
322    (MULTIPLE-VALUE-LIST (READ-LINE B))
323    ("a b c" T)
324    
325    (MULTIPLE-VALUE-LIST (READ-LINE B))
326    ERROR
327    
328    (MULTIPLE-VALUE-LIST (READ-LINE B NIL "EOF"))
329    #+XCL ("EOF" T) #-XCL ("EOF")
330    
331    (PEEK-CHAR NIL A)
332    #\1
333    
334    (READ-CHAR A)
335    #\1
336    
337    (PEEK-CHAR T A)
338    #\2
339    
340    (READ-CHAR A)
341    #\2
342    
343    (PEEK-CHAR T A)
344    #\;
345    
346    (READ-CHAR A)
347    #\;
348    
349    (PEEK-CHAR #\A A)
350    #\A
351    
352    (READ-CHAR A)
353    #\A
354    
355    (PEEK-CHAR NIL A)
356    ERROR
357    
358    (PEEK-CHAR NIL A NIL "EOF")
359    "EOF"
360    
361    (SETQ A (QUOTE
362    ((BERLIN (DRESDEN FRANKFURT BONN MUENCHEN)) (MUELLER (KARL LUISE DIETER
363    ALDO)))))
364    ((BERLIN (DRESDEN FRANKFURT BONN MUENCHEN)) (MUELLER (KARL LUISE DIETER
365    ALDO)))
366    
367    (PROGN (SETQ AA (MAKE-STRING-INPUT-STREAM "berlin d mueller :r")) T)
368    T
369    
370    (DEFUN ASK (&OPTIONAL (RES NIL))
371    "  (terpri)(terpri)(terpri)
372      (print '(*** Eingabe des  Keywortes ***))
373      (print '(- mit :r reset))
374      (terpri)" (SETQ X (READ AA)) "  (print x)" (COND
375    ((EQUAL X (QUOTE :R)) (CONS "--- reset ---" RES))
376    (T (CONS (CADR (ASSOC X A)) (ASK RES)))))
377    ASK
378    
379    (ASK)
380    ((DRESDEN FRANKFURT BONN MUENCHEN) NIL (KARL LUISE DIETER ALDO) "--- reset ---")
381    
382    (SETQ STRING1 "Das ist ein Teststring")
383    "Das ist ein Teststring"
384    
385    (SETQ STRING2 "Auch das 1 2 3 ist ein Teststring")
386    "Auch das 1 2 3 ist ein Teststring"
387    
388    (MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING1))
389    (DAS 4)
390    
391    (MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING2))
392    (AUCH 5)
393    
394    (MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING1 T NIL :START 2))
395    (S 4)
396    
397    (MULTIPLE-VALUE-LIST
398    (READ-FROM-STRING STRING1 T NIL :START 2 :PRESERVE-WHITESPACE T))
399    (S 3)
400    
401    (MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING2 T NIL :START 5))
402    (DAS 9)
403    
404    (MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING2 T NIL :START 5 :END
405    6))
406    (D 6)
407    
408    (MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING1 T NIL :START 4 :END
409    3))
410    ERROR
411    
412    (MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING1 T NIL :END 0))
413    ERROR
414    
415    (MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING1 T NIL :START -2 :END
416    0))
417    ERROR
418    
419    (MULTIPLE-VALUE-LIST (READ-FROM-STRING STRING1 T NIL :END 2))
420    (DA 2)
421    
422    *READ-SUPPRESS*
423    NIL
424    
425    (STANDARD-CHAR-P (QUOTE A))
426    ERROR
427    
428    (STANDARD-CHAR-P (QUOTE #\BACKSPACE))
429    #+XCL T #-XCL NIL
430    
431    (STANDARD-CHAR-P (QUOTE #\TAB))
432    #+XCL T #-XCL NIL
433    
434    (STANDARD-CHAR-P (QUOTE #\NEWLINE))
435    T
436    
437    (STANDARD-CHAR-P (QUOTE #\PAGE))
438    #+XCL T #-XCL NIL
439    
440    (STANDARD-CHAR-P (QUOTE #\RETURN))
441    #+XCL T #-XCL NIL
442    
443    (STRING-CHAR-P (QUOTE A))
444    ERROR
445    
446    (STRING-CHAR-P (QUOTE #\SPACE))
447    T
448    
449    (STRING-CHAR-P (QUOTE #\NEWLINE))
450    T
451    
452    (STRING-CHAR-P (QUOTE #\BACKSPACE))
453    T
454    
455    (STRING-CHAR-P (QUOTE #\a))
456    T
457    
458    (STRING-CHAR-P (QUOTE #\8))
459    T
460    
461    (STRING-CHAR-P (QUOTE #\-))
462    T
463    
464    (STRING-CHAR-P (QUOTE #\n))
465    T
466    
467    (STRING-CHAR-P (QUOTE #\())
468    T
469    
470    (STRINGP "das ist einer der Teststrings")
471    T
472    
473    (STRINGP (QUOTE (DAS IST NATUERLICH FALSCH)))
474    NIL
475    
476    (STRINGP "das ist die eine Haelfte" "und das die andere")
477    ERROR
478    
479    (SETQ J 0)
480    0
481    
482    (WITH-INPUT-FROM-STRING (S "animal crackers" :START 6) (READ S))
483    CRACKERS
484    
485    (WITH-INPUT-FROM-STRING (S "animal crackers" :INDEX J :START 6) (READ S))
486    CRACKERS
487    
488    J
489    15
490    
491    (WITH-INPUT-FROM-STRING (S "animal crackers" :INDEX J :START 7) (READ S))
492    CRACKERS
493    
494    J
495    15
496    
497    (WITH-INPUT-FROM-STRING (S "animal crackers" :INDEX J :START 2) (READ S))
498    IMAL
499    
500    J
501    7
502    
503    (WITH-INPUT-FROM-STRING (S "animal crackers" :INDEX J :START 0 :END 6) (READ S))
504    ANIMAL
505    
506    J
507    6
508    
509    (WITH-INPUT-FROM-STRING (S "animal crackers" :INDEX J :START 0 :END
510    12) (READ S))
511    ANIMAL
512    
513    J
514    7
515    
516    (WITH-INPUT-FROM-STRING (S "animal crackers" :INDEX J :START -1) (READ S))
517    ERROR
518    
519    J
520    7
521    
522    (WITH-INPUT-FROM-STRING (S "animal crackers" :INDEX J :START 6 :END
523    20) (READ S))
524    #+XCL CRACKERS #+CLISP ERROR
525    
526    J
527    #+XCL 20 #+CLISP 7
528    
529    (SETQ A "Das ist wieder einmal einer der SUUPERTESTstrings.")
530    "Das ist wieder einmal einer der SUUPERTESTstrings."
531    
532    (PROGN (SETQ B (MAKE-STRING-OUTPUT-STREAM)) T)
533    T
534    
535    (WRITE-STRING A B)
536    "Das ist wieder einmal einer der SUUPERTESTstrings."
537    
538    (WRITE-STRING A B :START 10)
539    "Das ist wieder einmal einer der SUUPERTESTstrings."
540    
541    (WRITE-STRING A B :START 80)
542    #+XCL "Das ist wieder einmal einer der SUUPERTESTstrings."
543    #-XCL ERROR
544    
545    (WRITE-STRING A B :END 5)
546    "Das ist wieder einmal einer der SUUPERTESTstrings."
547    
548    (WRITE-STRING A B :END -2)
549    ERROR
550    
551    (WRITE-STRING A B :END 100)
552    #+XCL "Das ist wieder einmal einer der SUUPERTESTstrings."
553    #-XCL ERROR
554    
555    (WRITE-STRING A B :START 5 :END 20)
556    "Das ist wieder einmal einer der SUUPERTESTstrings."
557    
558    (WRITE-STRING A B :START 10 :END 5)
559    #+XCL "Das ist wieder einmal einer der SUUPERTESTstrings."
560    #-XCL ERROR
561    
562    (GET-OUTPUT-STREAM-STRING B)
563    #+XCL
564    "Das ist wieder einmal einer der SUUPERTESTstrings.eder einmal einer der SUUPERTESTstrings.Das iDas ist wieder einmal einer der SUUPERTESTstrings.st wieder einma"
565    #+CLISP
566    "Das ist wieder einmal einer der SUUPERTESTstrings.eder einmal einer der SUUPERTESTstrings.Das ist wieder einma"
567    
568    (WRITE-STRING A B)
569    "Das ist wieder einmal einer der SUUPERTESTstrings."
570    
571    (LENGTH (GET-OUTPUT-STREAM-STRING B))
572    50
573    
574    (WRITE-LINE A B)
575    "Das ist wieder einmal einer der SUUPERTESTstrings."
576    
577    (LENGTH (GET-OUTPUT-STREAM-STRING B))
578    51
579    
580    (WITH-OUTPUT-TO-STRING (S) (PRINT (QUOTE XXX) S))
581    "
582    XXX "
583    
584    (SETQ A (MAKE-ARRAY 10 :ELEMENT-TYPE (QUOTE STRING-CHAR) :FILL-POINTER
585    0))
586    ""
587    
588    (WITH-OUTPUT-TO-STRING (S A) (PRINC 123 S))
589    123
590    
591    A
592    "123"
593    
594    (WITH-OUTPUT-TO-STRING (S A) (PRINC 4567 S))
595    4567
596    
597    A
598    "1234567"
599    
600    (WITH-OUTPUT-TO-STRING (S A) (PRINC 890 S))
601    890
602    
603    A
604    "1234567890"
605    
606    (WITH-OUTPUT-TO-STRING (S A) (PRINC (QUOTE A) S))
607    ERROR
608    
609    A
610    "1234567890"
611    
612    (SETQ A
613    (MAKE-ARRAY 10 :ELEMENT-TYPE (QUOTE STRING-CHAR) :FILL-POINTER 0 :ADJUSTABLE
614    T))
615    ""
616    
617    (WITH-OUTPUT-TO-STRING (S A) (PRINC 123 S))
618    123
619    
620    A
621    "123"
622    
623    (WITH-OUTPUT-TO-STRING (S A) (PRINC 4567 S))
624    4567
625    
626    A
627    "1234567"
628    
629    (WITH-OUTPUT-TO-STRING (S A) (PRINC 890 S))
630    890
631    
632    A
633    "1234567890"
634    
635    (WITH-OUTPUT-TO-STRING (S A) (PRINC (QUOTE ABCDE) S))
636    ABCDE
637    
638    A
639    "1234567890ABCDE"
640    
641    (WITH-OUTPUT-TO-STRING (S A) (PRINC (QUOTE FGHI) S))
642    FGHI
643    
644    A
645    "1234567890ABCDEFGHI"
646    
647    (progn
648    (makunbound 'bs)
649    (makunbound 'a)
650    (makunbound 'b)
651    (makunbound 'c)
652    (makunbound 'd)
653    (makunbound 'aa)
654    (makunbound 'string1)
655    (makunbound 'string2)
656    (makunbound 'x)
657    (makunbound 'j)
658    (makunbound 's1)
659    (makunbound 'str1)
660    t)
661    T
662    

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