1 ;;;; tests related to Lisp streams
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
14 (load "assertoid.lisp")
15 (use-package "ASSERTOID")
17 ;;; type errors for inappropriate stream arguments, fixed in
20 (declare (optimize (safety 3)))
21 (assert-error (make-two-way-stream (make-string-output-stream)
22 (make-string-output-stream))
24 (assert-error (make-two-way-stream (make-string-input-stream "foo")
25 (make-string-input-stream "bar"))
27 ;; the following two aren't actually guaranteed, because ANSI, as it
28 ;; happens, doesn't say "should signal an error" for
29 ;; MAKE-ECHO-STREAM. It's still good to have, but if future
30 ;; maintenance work causes this test to fail because of these
31 ;; MAKE-ECHO-STREAM clauses, consider simply removing these clauses
32 ;; from the test. -- CSR, 2002-10-06
33 (assert-error (make-echo-stream (make-string-output-stream)
34 (make-string-output-stream))
36 (assert-error (make-echo-stream (make-string-input-stream "foo")
37 (make-string-input-stream "bar"))
39 (assert-error (make-concatenated-stream
40 (make-string-output-stream)
41 (make-string-input-stream "foo"))
44 ;;; bug 225: STRING-STREAM was not a class
45 (eval `(defgeneric bug225
(s)
46 ,@(mapcar (lambda (class)
47 `(:method
:around
((s ,class
)) (cons ',class
(call-next-method))))
48 '(stream string-stream sb-impl
::string-input-stream
49 sb-impl
::string-output-stream
))
50 (:method
(class) nil
)))
52 (assert (equal (bug225 (make-string-input-stream "hello"))
53 '(sb-impl::string-input-stream string-stream stream
)))
54 (assert (equal (bug225 (make-string-output-stream))
55 '(sb-impl::string-output-stream string-stream stream
)))
58 ;;; improper buffering on (SIGNED-BYTE 8) streams (fixed by David Lichteblau):
59 (let ((p "signed-byte-8-test.data"))
62 :element-type
'(unsigned-byte 8)
63 :if-exists
:supersede
)
65 (with-open-file (s p
:element-type
'(signed-byte 8))
66 (assert (= (read-byte s
) -
1)))
69 ;;; :IF-EXISTS got :ERROR and NIL the wrong way round (reported by
71 (let* ((p "this-file-will-exist")
72 (stream (open p
:direction
:output
:if-exists
:error
)))
73 (assert (null (with-open-file (s p
:direction
:output
:if-exists nil
) s
)))
75 (with-open-file (s p
:direction
:output
:if-exists
:error
)))
79 (assert-error (read-byte (make-string-input-stream "abc"))
81 (assert-error (with-open-file (s "/dev/zero")
84 #+win32 sb-int
:simple-file-error
)
85 ;;; bidirectional streams getting confused about their position
86 (let ((p "bidirectional-stream-test"))
87 (with-open-file (s p
:direction
:output
:if-exists
:supersede
)
88 (with-standard-io-syntax
89 (format s
"~S ~S ~S~%" 'these
'are
'symbols
)))
90 (with-open-file (s p
:direction
:io
:if-exists
:overwrite
)
92 (with-standard-io-syntax
95 (let ((line (read-line s
))
96 (want "THESE INSERTMBOLS"))
97 (unless (equal line want
)
98 (error "wanted ~S, got ~S" want line
))))
101 ;;; :DIRECTION :IO didn't work on non-existent pathnames
102 (let ((p "direction-io-test"))
103 (ignore-errors (delete-file p
))
104 (with-open-file (s p
:direction
:io
)
107 (file-position s
:start
)
108 (assert (char= (read-char s
) #\
1)))
111 ;;; FILE-POSITION on broadcast-streams is mostly uncontroversial
112 (assert (= 0 (file-position (make-broadcast-stream))))
113 (assert (file-position (make-broadcast-stream) :start
))
114 (assert (file-position (make-broadcast-stream) 0))
115 (assert (not (file-position (make-broadcast-stream) 1)))
116 (let ((s (make-broadcast-stream)))
118 (assert (not (file-position s
1)))
119 (assert (= 0 (file-position s
))))
121 (let ((p "broadcast-stream-test"))
122 (ignore-errors (delete-file p
))
123 (with-open-file (f p
:direction
:output
)
124 (let ((s (make-broadcast-stream f
)))
125 (assert (= 0 (file-position s
)))
126 (assert (file-position s
:start
))
127 (assert (file-position s
0))
129 (assert (= 1 (file-position s
))) ; unicode...
130 (assert (file-position s
0))))
133 ;;; CLOSING a non-new streams should not delete them, and superseded
134 ;;; files should be restored.
135 (with-test (:name
:test-file-for-close-should-not-delete
:fails-on
:win32
)
136 (let ((test "test-file-for-close-should-not-delete"))
137 (macrolet ((test-mode (mode)
139 (catch :close-test-exit
140 (with-open-file (f test
:direction
:output
:if-exists
,mode
)
141 (write-line "test" f
)
142 (throw :close-test-exit t
)))
143 (assert (and (probe-file test
) ,mode
)))))
146 (with-open-file (f test
:direction
:output
)
147 (write-line "test" f
))
149 (test-mode :overwrite
)
150 ;; FIXME: We really should recover supersede files as well, according to
151 ;; CLOSE in CLHS, but at the moment we don't.
152 ;; (test-mode :supersede)
154 (test-mode :rename-and-delete
))
155 (when (probe-file test
)
156 (delete-file test
))))))
158 ;;; test for read-write invariance of signed bytes, from Bruno Haible
159 ;;; cmucl-imp 2004-09-06
160 (defun bin-stream-test (&key
(size (integer-length most-positive-fixnum
))
161 (type 'unsigned-byte
) (file-name "stream-impure.tmp")
163 (bytes (if (eq type
'signed-byte
)
164 (loop :repeat num-bytes
:collect
165 (- (random (ash 1 size
))
167 (loop :repeat num-bytes
:collect
168 (random (ash 1 size
))))))
169 (with-open-file (foo file-name
:direction
:output
:if-exists
:supersede
170 :element-type
(list type size
))
172 (write-byte byte foo
)))
174 (with-open-file (foo file-name
:direction
:input
175 :element-type
(list type size
))
176 (list (stream-element-type foo
) (file-length foo
) bytes
177 (loop :for byte
:in bytes
:for nb
= (read-byte foo
) :collect nb
178 :unless
(= nb byte
) :do
179 (flet ((by-out (sz by
)
180 (format nil
"~v,'0,' ,4:b"
181 (+ sz
(floor sz
4)) by
)))
182 (error "~& * [(~s ~s)] ~a != ~a~%" type size
183 (by-out size byte
) (by-out size nb
))))))
184 (delete-file file-name
)))
185 (loop for size from
2 to
40 do
(bin-stream-test :size size
:type
'signed-byte
))
187 ;;; Check READ-SEQUENCE signals a TYPE-ERROR when the sequence can't
188 ;;; contain a stream element.
190 ;;; These tests check READ-SEQUENCE correctness, not whether the fast
191 ;;; or slow paths are being taken for each element type. To check the
192 ;;; fast or slow paths, trace ANSI-STREAM-READ-BYTE (slow path) and/or
195 ;;; (trace sb-impl::ansi-stream-read-byte sb-impl::read-n-bytes)
197 ;;; The order should be ANSI-STREAM-READ-BYTE, READ-N-BYTES,
198 ;;; READ-N-BYTES, ANSI-STREAM-READ-BYTE, ANSI-STREAM-READ-BYTE.
200 (let ((pathname "read-sequence.data"))
202 ;; Create the binary data.
203 (with-open-file (stream pathname
205 :if-exists
:supersede
206 :element-type
'(unsigned-byte 8))
207 (write-byte 255 stream
))
209 ;; Check the slow path for generic vectors.
210 (let ((sequence (make-array 1)))
211 (with-open-file (stream pathname
213 :element-type
'(unsigned-byte 8))
214 (read-sequence sequence stream
)
215 (assert (equalp sequence
#(255)))))
217 (let ((sequence (make-array 1)))
218 (with-open-file (stream pathname
220 :external-format
:latin-1
221 :element-type
'character
)
222 (read-sequence sequence stream
)
223 (assert (equalp sequence
#(#.
(code-char 255))))))
225 ;; Check the fast path works for (UNSIGNED-BYTE 8) and (SIGNED-BYTE
227 (let ((sequence (make-array 1 :element-type
'(unsigned-byte 8))))
228 (with-open-file (stream pathname
230 :element-type
'(unsigned-byte 8))
231 (read-sequence sequence stream
)
232 (assert (equalp sequence
#(255)))))
234 (let ((sequence (make-array 1 :element-type
'(signed-byte 8))))
235 (with-open-file (stream pathname
237 :element-type
'(signed-byte 8))
238 (read-sequence sequence stream
)
239 (assert (equalp sequence
#(-1)))))
241 ;; A bivalent stream can be read to a unsigned-byte vector, a
242 ;; string, or a generic vector
244 (let ((sequence (make-array 1 :element-type
'(unsigned-byte 8))))
245 (with-open-file (stream pathname
247 :element-type
:default
)
248 (read-sequence sequence stream
)
249 (assert (equalp sequence
#(255)))))
251 (let ((sequence (make-array 1 :element-type
'character
)))
252 (with-open-file (stream pathname
254 :external-format
:latin-1
255 :element-type
:default
)
256 (read-sequence sequence stream
)
257 (assert (equalp sequence
#(#.
(code-char 255))))))
259 (let ((sequence (make-array 1)))
260 (with-open-file (stream pathname
262 :external-format
:latin-1
263 :element-type
:default
)
264 (read-sequence sequence stream
)
265 (assert (equalp sequence
#(#.
(code-char 255))))))
267 ;; Check that a TYPE-ERROR is signalled for incompatible (sequence,
270 (let ((sequence (make-array 1 :element-type
'(signed-byte 8))))
271 (with-open-file (stream pathname
273 :element-type
'(unsigned-byte 8))
275 (read-sequence sequence stream
)
276 (error "READ-SEQUENCE didn't signal an error"))
277 (type-error (condition)
278 (assert (= (type-error-datum condition
) 255))
279 (assert (subtypep (type-error-expected-type condition
)
280 '(signed-byte 8)))))))
282 (let ((sequence (make-array 1 :element-type
'(unsigned-byte 8))))
283 (with-open-file (stream pathname
285 :element-type
'(signed-byte 8))
287 (read-sequence sequence stream
)
288 (error "READ-SEQUENCE didn't signal an error"))
289 (type-error (condition)
290 (assert (= (type-error-datum condition
) -
1))
291 (assert (subtypep (type-error-expected-type condition
)
292 '(unsigned-byte 8)))))))
294 ;; Can't read a signed-byte from a bivalent stream
296 (let ((sequence (make-array 1 :element-type
'(signed-byte 8))))
297 (with-open-file (stream pathname
299 :external-format
:latin1
300 :element-type
:default
)
302 (read-sequence sequence stream
)
303 (error "READ-SEQUENCE didn't signal an error"))
304 (type-error (condition)
305 (assert (eql (type-error-datum condition
) (code-char 255)))
306 (assert (subtypep (type-error-expected-type condition
)
307 '(signed-byte 8)))))))
308 (delete-file pathname
))
310 ;;; Check WRITE-SEQUENCE signals a TYPE-ERROR when the stream can't
311 ;;; write a sequence element.
313 ;;; These tests check WRITE-SEQUENCE correctness, not whether the fast
314 ;;; or slow paths are being taken for each element type. See the
315 ;;; READ-SEQUENCE tests above for more information.
317 ;;; (trace sb-impl::output-unsigned-byte-full-buffered sb-impl::output-signed-byte-full-buffered sb-impl::output-raw-bytes)
319 (let ((pathname "write-sequence.data")
320 (generic-sequence (make-array 1 :initial-contents
'(255)))
321 (generic-character-sequence (make-array 1 :initial-element
#\a))
322 (generic-mixed-sequence (make-array 2 :initial-element
#\a))
323 (string (make-array 1 :element-type
'character
324 :initial-element
(code-char 255)))
325 (unsigned-sequence (make-array 1
326 :element-type
'(unsigned-byte 8)
327 :initial-contents
'(255)))
328 (signed-sequence (make-array 1
329 :element-type
'(signed-byte 8)
330 :initial-contents
'(-1))))
332 (setf (aref generic-mixed-sequence
1) 255)
334 ;; Check the slow path for generic vectors.
335 (with-open-file (stream pathname
337 :if-exists
:supersede
338 :element-type
'(unsigned-byte 8))
339 (write-sequence generic-sequence stream
))
341 (with-open-file (stream pathname
343 :if-exists
:supersede
344 :element-type
'character
)
345 (write-sequence generic-character-sequence stream
))
347 ;; Check the fast path for unsigned and signed vectors.
348 (with-open-file (stream pathname
350 :if-exists
:supersede
351 :element-type
'(unsigned-byte 8))
352 (write-sequence unsigned-sequence stream
))
354 (with-open-file (stream pathname
356 :if-exists
:supersede
357 :element-type
'(signed-byte 8))
358 (write-sequence signed-sequence stream
))
360 ;; Bivalent streams on unsigned-byte vectors, strings, and a simple
361 ;; vector with mixed characters and bytes
363 (with-open-file (stream pathname
365 :if-exists
:supersede
366 :element-type
:default
)
367 (write-sequence unsigned-sequence stream
))
369 (with-open-file (stream pathname
371 :external-format
:latin-1
372 :if-exists
:supersede
373 :element-type
:default
)
374 (write-sequence string stream
))
376 (with-open-file (stream pathname
378 :external-format
:latin-1
379 :if-exists
:supersede
380 :element-type
:default
)
381 (write-sequence generic-mixed-sequence stream
))
383 ;; Check a TYPE-ERROR is signalled for unsigned and signed vectors
384 ;; which are incompatible with the stream element type.
385 (with-open-file (stream pathname
387 :if-exists
:supersede
388 :element-type
'(signed-byte 8))
390 (write-sequence unsigned-sequence stream
)
391 (error "WRITE-SEQUENCE didn't signal an error"))
392 (type-error (condition)
393 (assert (= (type-error-datum condition
) 255))
394 (assert (subtypep (type-error-expected-type condition
)
395 '(signed-byte 8))))))
397 (with-open-file (stream pathname
399 :if-exists
:supersede
400 :element-type
'(unsigned-byte 8))
402 (write-sequence signed-sequence stream
)
403 (error "WRITE-SEQUENCE didn't signal an error"))
404 (type-error (condition)
405 (assert (= (type-error-datum condition
) -
1))
406 (assert (subtypep (type-error-expected-type condition
)
407 '(unsigned-byte 8))))))
409 (with-open-file (stream pathname
411 :if-exists
:supersede
412 :element-type
:default
)
414 (write-sequence signed-sequence stream
)
415 (error "WRITE-SEQUENCE didn't signal an error"))
416 (type-error (condition)
417 (assert (= (type-error-datum condition
) -
1))
418 (assert (subtypep (type-error-expected-type condition
)
419 '(unsigned-byte 8))))))
421 (delete-file pathname
))
423 ;;; writing looong lines. takes way too long and way too much space
424 ;;; to test on 64 bit platforms
425 #-
#.
(cl:if
(cl:= sb-vm
:n-word-bits
64) '(and) '(or))
426 (let ((test "long-lines-write-test.tmp"))
428 (with-open-file (f test
430 :external-format
:ascii
431 :element-type
'character
432 :if-does-not-exist
:create
433 :if-exists
:supersede
)
434 (let* ((n (truncate most-positive-fixnum
16))
437 (buffer (make-string n
)))
441 (write-sequence buffer f
))
442 (assert (= p
(sb-impl::fd-stream-output-column f
)))
444 (assert (= (+ 1 p
) (sb-impl::fd-stream-output-column f
)))
445 (assert (typep p
'bignum
))))
446 (when (probe-file test
)
447 (delete-file test
))))
449 ;;; read-sequence misreported the amount read and lost position
450 (let ((string (make-array (* 3 sb-impl
::+ansi-stream-in-buffer-length
+)
451 :element-type
'character
)))
452 (dotimes (i (length string
))
453 (setf (char string i
) (code-char (mod i char-code-limit
))))
454 (with-open-file (f "read-sequence-character-test-data.tmp"
455 :if-exists
:supersede
457 :external-format
:utf-8
)
458 (write-sequence string f
))
460 (with-open-file (f "read-sequence-character-test-data.tmp"
461 :if-does-not-exist
:error
463 :external-format
:utf-8
)
464 (let ((buffer (make-array 128 :element-type
'character
))
466 (with-output-to-string (datum)
467 (loop for n-read
= (read-sequence buffer f
)
468 do
(write-sequence buffer datum
:start
0 :end n-read
)
469 (assert (<= (incf total n-read
) (length string
)))
470 while
(and (= n-read
128))))))))
471 (assert (equal copy string
)))
472 (delete-file "read-sequence-character-test-data.tmp"))
474 ;;; ANSI-STREAM-OUTPUT-STREAM-P used to assume that a SYNONYM-STREAM's
475 ;;; target was an ANSI stream, but it could be a user-defined stream,
476 ;;; e.g., a SLIME stream.
477 (defclass user-output-stream
(fundamental-output-stream)
480 (let ((*stream
* (make-instance 'user-output-stream
)))
481 (declare (special *stream
*))
482 (with-open-stream (stream (make-synonym-stream '*stream
*))
483 (assert (output-stream-p stream
))))
485 (defclass user-input-stream
(fundamental-input-stream)
488 (let ((*stream
* (make-instance 'user-input-stream
)))
489 (declare (special *stream
*))
490 (with-open-stream (stream (make-synonym-stream '*stream
*))
491 (assert (input-stream-p stream
))))
493 ;;; READ-LINE on ANSI-STREAM did not return T for the last line
494 ;;; (reported by Yoshinori Tahara)
495 (let ((pathname "test-read-line-eol"))
496 (with-open-file (out pathname
:direction
:output
:if-exists
:supersede
)
498 (let ((result (with-open-file (in pathname
)
499 (list (multiple-value-list (read-line in nil nil
))
500 (multiple-value-list (read-line in nil nil
))
501 (multiple-value-list (read-line in nil nil
))))))
502 (delete-file pathname
)
503 (assert (equal result
'(("a" nil
) ("b" t
) (nil t
))))))
505 ;;; READ-LINE used to work on closed streams because input buffers were left in place
506 (with-test (:name
:bug-425
)
508 (let ((f (open "stream.impure.lisp" :direction
:input
)))
509 (assert (stringp (read-line f
)))
514 (sb-int:closed-stream-error
() :fii
)))))
516 (let ((f (open "stream.impure.lisp" :direction
:input
)))
517 (assert (stringp (read-line f nil nil
)))
522 (sb-int:closed-stream-error
() :faa
))))))
524 (with-test (:name
:regression-1.0
.12.22)
525 (with-open-file (s "stream.impure.lisp" :direction
:input
)
526 (let ((buffer (make-string 20)))
527 (assert (= 2 (read-sequence buffer s
:start
0 :end
2)))
528 (assert (= 3 (read-sequence buffer s
:start
2 :end
3)))
529 (file-position s
:end
)
530 (assert (= 3 (read-sequence buffer s
:start
3))))))
532 ;;; In 1.0.27 (and also 0.9.16; presumably in between, too), binary
533 ;;; input operations on a bivalent stream did something bad after
534 ;;; unread-char: READ-BYTE would return the character, and
535 ;;; READ-SEQUENCE into a byte buffer would lose when attempting to
536 ;;; store the character in the vector.
537 (let ((pathname "bivalent-stream-unread-char-test.tmp"))
538 (with-open-file (s pathname
539 :element-type
:default
540 :direction
:io
:if-exists
:rename
)
542 (file-position s
:start
)
543 (unread-char (read-char s
) s
)
544 (assert (integerp (read-byte s
))))
545 (delete-file pathname
))
547 (let ((pathname "bivalent-stream-unread-char-test.tmp"))
548 (with-open-file (s pathname
549 :element-type
:default
550 :direction
:io
:if-exists
:rename
)
552 (file-position s
:start
)
553 (unread-char (read-char s
) s
)
554 (assert (let ((buffer (make-array 10 :element-type
'(unsigned-byte 8))))
555 (read-sequence buffer s
))))
556 (delete-file pathname
))
559 (let ((pathname "bivalent-stream-unread-char-test.tmp"))
560 (with-open-file (s pathname
561 :element-type
:default
562 :direction
:io
:if-exists
:rename
563 :external-format
:utf8
)
564 (write-char (code-char 192) s
)
565 (file-position s
:start
)
566 (unread-char (read-char s
) s
)
567 (assert (integerp (read-byte s
))))
568 (delete-file pathname
))
571 (let ((pathname "bivalent-stream-unread-char-test.tmp"))
572 (with-open-file (s pathname
573 :element-type
:default
574 :direction
:io
:if-exists
:rename
575 :external-format
:utf8
)
576 (write-char (code-char 192) s
)
577 (file-position s
:start
)
578 (unread-char (read-char s
) s
)
579 (assert (let ((buffer (make-array 10 :element-type
'(unsigned-byte 8))))
580 (read-sequence buffer s
))))
581 (delete-file pathname
))
583 (with-test (:name
:delete-file-on-streams
)
584 (with-open-file (f "delete-file-on-stream-test.tmp"
589 (write-line "still open" f
)
590 (file-position f
:start
)
591 (assert (equal "still open" (read-line f
)))))
592 (assert (not (probe-file "delete-file-on-stream-test.tmp"))))
594 ;;; READ-CHAR-NO-HANG on bivalent streams (as returned by RUN-PROGRAM)
595 ;;; was wrong. CSR managed to promote the wrongness to all streams in
596 ;;; the 1.0.32.x series, breaking slime instantly.
597 (with-test (:name
:read-char-no-hang-after-unread-char
:skipped-on
:win32
)
598 (let* ((process (run-program "/bin/sh" '("-c" "echo a && sleep 10")
599 :output
:stream
:wait nil
))
600 (stream (process-output process
))
601 (char (read-char stream
)))
602 (assert (char= char
#\a))
603 (unread-char char stream
)
604 (assert (char= (read-char stream
) #\a))
605 (assert (char= (read-char stream
) #\Newline
))
606 (let ((time (get-universal-time)))
607 ;; no input, not yet known to be at EOF: should return
609 (read-char-no-hang stream
)
610 (assert (< (- (get-universal-time) time
) 2)))))
614 (with-test (:name
:interrupt-open
:skipped-on
:win32
)
620 (setf fifo
(sb-posix:mktemp
"SBCL-fifo.XXXXXXX"))
621 (sb-posix:mkfifo fifo
(logior sb-posix
:s-iwusr sb-posix
:s-irusr
))
622 ;; Try to open it (which hangs), and interrupt ourselves with a timer,
623 ;; continue (this used to result in an error due to open(2) returning with
624 ;; EINTR, then interupt again and unwind.
627 (handler-bind ((timeout (lambda (c)
628 (when (eql 1 (incf to
))
631 (with-open-file (f fifo
:direction
:input
)
640 (ignore-errors (delete-file fifo
))))))
643 (with-test (:name
:overeager-character-buffering
:skipped-on
:win32
)
649 (format t
"trying ~A~%" format
)
653 (setf fifo
(sb-posix:mktemp
"SBCL-fifo-XXXXXXX"))
654 (sb-posix:mkfifo fifo
(logior sb-posix
:s-iwusr sb-posix
:s-irusr
))
655 ;; KLUDGE: because we have both ends in the same process, we would
656 ;; need to use O_NONBLOCK, but this works too.
658 (run-program "/bin/sh"
660 (format nil
"cat > ~A" (native-namestring fifo
)))
663 :external-format format
))
664 (write-line "foobar" (process-input proc
))
665 (finish-output (process-input proc
))
666 (with-open-file (f fifo
:direction
:input
:external-format format
)
667 (assert (equal "foobar" (read-line f
)))))
670 (close (process-input proc
) :abort t
)
672 (ignore-errors (process-close proc
))
675 (ignore-errors (delete-file fifo
))
677 sb-impl
::*external-formats
*)))
679 (with-test (:name
:bug-657183
:skipped-on
'(not :sb-unicode
))
681 (let ((name (merge-pathnames "stream-impure.temp-test"))
682 (text '(#\GREEK_SMALL_LETTER_LAMDA
683 #\JAPANESE_BANK_SYMBOL
685 #\HEAVY_BLACK_HEART
))
686 (positions '(2 5 6 9))
687 (sb-impl::*default-external-format
* :utf-8
))
690 (with-open-file (f name
:external-format
:default
:direction
:output
691 :if-exists
:supersede
)
692 (assert (eql 0 (file-position f
)))
693 (mapc (lambda (char pos
)
695 (assert (eql pos
(file-position f
))))
698 (with-open-file (f name
:external-format
:default
:direction
:input
)
699 (assert (eql 0 (file-position f
)))
700 (assert (eql (pop text
) (read-char f
)))
701 (assert (eql (file-position f
) 2))
702 (assert (eql (pop text
) (read-char f
)))
703 (assert (eql (file-position f
) 5))
704 (assert (eql (pop text
) (read-char f
)))
705 (assert (eql (file-position f
) 6))
706 (assert (eql (pop text
) (read-char f
)))
707 (assert (eql (file-position f
) 9))
708 (assert (eql (file-length f
) 9))))
709 (ignore-errors (delete-file name
)))))
711 (with-test (:name
:bug-561642
)
712 (let ((p "bug-561642-test.tmp"))
716 :if-exists
:supersede
717 :if-does-not-exist
:create
719 (write-line "FOOBAR" f
))
723 (let ((p0 (file-position f
))
725 (write-char #\newline f
)
728 (write-char #\newline f
)
733 (assert (eql 9 p2
)))))
734 (ignore-errors (delete-file p
)))))
736 (defstruct (mock-fd-stream
737 (:constructor %make-mock-fd-stream
(buffer-chain))
738 (:include sb-impl
::ansi-stream
739 (in #'mock-fd-stream-in
)
740 (n-bin #'mock-fd-stream-n-bin
)
742 (make-array sb-impl
::+ansi-stream-in-buffer-length
+
743 :element-type
'character
))))
746 (defun make-mock-fd-stream (buffer-chain)
747 ;; For notational convenience, #\| becomes #\Newline.
748 (%make-mock-fd-stream
749 (mapcar (lambda (x) (substitute #\Newline
#\| x
)) buffer-chain
)))
751 (defun mock-fd-stream-in (stream eof-err-p eof-val
)
752 (sb-impl::eof-or-lose stream eof-err-p eof-val
))
754 (defun mock-fd-stream-n-bin (stream char-buf start count eof-err-p
)
755 (cond ((mock-fd-stream-buffer-chain stream
)
756 (let* ((chars (pop (mock-fd-stream-buffer-chain stream
)))
757 (n-chars (length chars
)))
758 ;; make sure the mock object is being used as expected.
759 (assert (>= count
(length chars
)))
760 (replace char-buf chars
:start1 start
)
763 (sb-impl::eof-or-lose stream eof-err-p
0))))
765 (with-test (:name
:read-chunk-from-frc-buffer
)
766 (let ((s (make-mock-fd-stream '("zabc" "d" "efgh" "foo|bar" "hi"))))
767 (multiple-value-bind (line eofp
)
768 (sb-impl::ansi-stream-read-line-from-frc-buffer s nil
'woot
)
769 (assert (and (string= line
"zabcdefghfoo") (not eofp
))))
770 (multiple-value-bind (line eofp
)
771 (sb-impl::ansi-stream-read-line-from-frc-buffer s nil
'woot
)
772 (assert (and (string= line
"barhi") eofp
)))
773 (multiple-value-bind (line eofp
)
774 (sb-impl::ansi-stream-read-line-from-frc-buffer s nil
'woot
)
775 (assert (and (eq line
'woot
) eofp
))))
776 (let ((s (make-mock-fd-stream '("zabc" "d" "efgh" "foo*bar" "hi")))
777 (string (make-string 100)))
779 (sb-impl::ansi-stream-read-string-from-frc-buffer string s
10 nil
)))
780 (assert (and (= endpos
28)
781 (string= (subseq string
10 endpos
) "zabcdefghfoo*barhi"))))
783 (sb-impl::ansi-stream-read-string-from-frc-buffer string s
0 nil
)))
784 (assert (= endpos
0)))))