source: trunk/source/tests/ansi-tests/peek-char.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: 6.6 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Jan 17 21:02:13 2004
4;;;; Contains: Tests of PEEK-CHAR
5
6(in-package :cl-test)
7
8(deftest peek-char.1
9  (with-input-from-string
10   (*standard-input* "abc")
11   (values
12    (peek-char)
13    (read-char)
14    (read-char)
15    (peek-char)
16    (read-char)))
17  #\a #\a #\b #\c #\c)
18
19(deftest peek-char.2
20  (with-input-from-string
21   (*standard-input* "   ab")
22   (values
23    (peek-char)
24    (read-char)
25    (peek-char t)
26    (read-char)
27    (peek-char t)
28    (read-char)))
29  #\Space #\Space #\a #\a #\b #\b)
30
31(deftest peek-char.3
32  (with-input-from-string
33   (*standard-input* (concatenate 'string
34                                  (string #\Newline)
35                                  (string #\Newline)
36                                  "  "
37                                  (string #\Newline)
38                                  "ab"))
39   (values
40    (peek-char)
41    (read-char)
42    (peek-char t)
43    (read-char)
44    (peek-char t)
45    (read-char)))
46  #\Newline #\Newline #\a #\a #\b #\b)
47
48(when (name-char "Linefeed")
49  (deftest peek-char.4
50    (with-input-from-string
51     (*standard-input* (concatenate 'string
52                                    (string (name-char "Linefeed"))
53                                    (string (name-char "Linefeed"))
54                                    "abc"))
55     (values
56      (peek-char)
57      (read-char)
58      (peek-char t)
59      (read-char)))
60    #.(name-char "Linefeed")
61    #.(name-char "Linefeed")
62    #\a #\a))
63
64(when (name-char "Page")
65  (deftest peek-char.5
66    (with-input-from-string
67     (*standard-input* (concatenate 'string
68                                    (string (name-char "Page"))
69                                    (string (name-char "Page"))
70                                    "abc"))
71     (values
72      (peek-char)
73      (read-char)
74      (peek-char t)
75      (read-char)))
76    #.(name-char "Page")
77    #.(name-char "Page")
78    #\a #\a))
79
80(when (name-char "Tab")
81  (deftest peek-char.6
82    (with-input-from-string
83     (*standard-input* (concatenate 'string
84                                    (string (name-char "Tab"))
85                                    (string (name-char "Tab"))
86                                    "abc"))
87     (values
88      (peek-char)
89      (read-char)
90      (peek-char t)
91      (read-char)))
92    #.(name-char "Tab")
93    #.(name-char "Tab")
94    #\a #\a))
95
96(when (name-char "Return")
97  (deftest peek-char.7
98    (with-input-from-string
99     (*standard-input* (concatenate 'string
100                                    (string (name-char "Return"))
101                                    (string (name-char "Return"))
102                                    "abc"))
103     (values
104      (peek-char)
105      (read-char)
106      (peek-char t)
107      (read-char)))
108    #.(name-char "Return")
109    #.(name-char "Return")
110    #\a #\a))
111
112(deftest peek-char.8
113  (with-input-from-string
114   (s "a bcd")
115   (values
116    (peek-char nil s)
117    (read-char s)
118    (peek-char t s)
119    (read-char s)
120    (peek-char t s)
121    (read-char s)))
122  #\a #\a #\b #\b #\c #\c)
123
124(deftest peek-char.9
125  (with-input-from-string
126   (*standard-input* " a bCcde")
127   (values
128    (peek-char #\c)
129    (read-char)
130    (read-char)))
131  #\c #\c #\d)
132
133(deftest peek-char.10
134  (with-input-from-string
135   (*standard-input* "  ; foo")
136   (values
137    (peek-char t)
138    (read-char)))
139  #\; #\;)
140
141(deftest peek-char.11
142  (with-input-from-string
143   (s "")
144   (peek-char nil s nil))
145  nil)
146
147(deftest peek-char.12
148  (with-input-from-string
149   (s "")
150   (peek-char nil s nil 'foo))
151  foo)
152
153(deftest peek-char.13
154  (with-input-from-string
155   (s "   ")
156   (peek-char t s nil))
157  nil)
158
159(deftest peek-char.14
160  (with-input-from-string
161   (s "   ")
162   (peek-char t s nil 'foo))
163  foo)
164
165(deftest peek-char.15
166  (with-input-from-string
167   (s "ab c d")
168   (peek-char #\z s nil))
169  nil)
170
171(deftest peek-char.16
172  (with-input-from-string
173   (s "ab c d")
174   (peek-char #\z s nil 'foo))
175  foo)
176
177;;; Interaction with echo streams
178
179(deftest peek-char.17
180  (block done
181    (with-input-from-string
182     (is "ab")
183     (with-output-to-string
184       (os)
185       (let ((es (make-echo-stream is os)))
186         (let ((pos1 (file-position os)))
187           (unless (zerop pos1) (return-from done :good))
188           (peek-char nil es nil)
189           (let ((pos2 (file-position os)))
190             (return-from done
191               (if (eql pos1 pos2)
192                   :good
193                 (list pos1 pos2)))))))))
194  :good)
195
196(deftest peek-char.18
197  (block done
198    (with-input-from-string
199     (is "   ab")
200     (with-output-to-string
201       (os)
202       (let ((es (make-echo-stream is os)))
203         (let ((pos1 (file-position os)))
204           (unless (zerop pos1) (return-from done :good))
205           (peek-char t es nil)
206           (let ((pos2 (file-position os)))
207             (return-from done
208               (if (eql pos1 pos2)
209                   pos1
210                 :good))))))))
211  :good)
212
213(deftest peek-char.19
214  (block done
215    (with-input-from-string
216     (is "abcde")
217     (with-output-to-string
218       (os)
219       (let ((es (make-echo-stream is os)))
220         (let ((pos1 (file-position os)))
221           (unless (zerop pos1) (return-from done :good))
222           (peek-char #\c es nil)
223           (let ((pos2 (file-position os)))
224             (return-from done
225               (if (eql pos1 pos2)
226                   pos1
227                 :good))))))))
228  :good)
229
230;;; Interactions with the readtable
231
232(deftest peek-char.20
233  (let ((*readtable* (copy-readtable)))
234    (set-syntax-from-char #\Space #\a)
235    (with-input-from-string
236     (*standard-input* "  x")
237     (values
238      (peek-char)
239      (read-char)
240      (peek-char t)
241      (read-char))))
242  #\Space #\Space
243  #\Space #\Space  ; *not* #\x #\x
244  )
245
246(deftest peek-char.21
247  (let ((*readtable* (copy-readtable)))
248    (set-syntax-from-char #\x #\Space)
249    (with-input-from-string
250     (*standard-input* "xxa")
251     (values
252      (peek-char)
253      (read-char)
254      (peek-char t)
255      (read-char))))
256  #\x #\x
257  #\a #\a  ; *not* #\x #\x
258  )
259
260;;; Stream designators are accepted for the stream argument
261
262(deftest peek-char.22
263  (with-input-from-string
264   (is "!?*")
265   (let ((*terminal-io* (make-two-way-stream is (make-string-output-stream))))
266     (peek-char nil t)))
267  #\!)
268
269(deftest peek-char.23
270  (with-input-from-string
271   (*standard-input* "345")
272   (peek-char nil nil))
273  #\3)
274
275;;; Error tests
276
277(deftest peek-char.error.1
278  (signals-error
279   (with-input-from-string
280    (s "abc")
281    (peek-char s nil nil nil nil 'nonsense))
282   program-error)
283  t)
284
285
286(deftest peek-char.error.2
287  (signals-error-always
288   (with-input-from-string
289    (*standard-input* "")
290    (peek-char))
291   end-of-file)
292  t t)
293
294(deftest peek-char.error.3
295  (signals-error-always
296   (with-input-from-string
297    (s "")
298    (peek-char nil s))
299   end-of-file)
300  t t)
301
302(deftest peek-char.error.4
303  (signals-error-always
304   (with-input-from-string
305    (s " ")
306    (peek-char t s))
307   end-of-file)
308  t t)
309
310(deftest peek-char.error.5
311  (signals-error-always
312   (with-input-from-string
313    (s "abcd")
314    (peek-char #\z s))
315   end-of-file)
316  t t)
317
318;;; There was a consensus on comp.lang.lisp that the requirement
319;;; that an end-of-file error be thrown in the following case
320;;; is a spec bug
321#|
322(deftest peek-char.error.6
323  (signals-error
324   (with-input-from-string
325    (s "")
326    (peek-char nil s nil nil t))
327   end-of-file)
328  t)
329|#
Note: See TracBrowser for help on using the repository browser.