;;;; While most of SBCL is derived from the CMU CL system, the test
;;;; files (like this one) were written from scratch after the fork
;;;; from CMU CL.
-;;;;
+;;;;
;;;; This software is in the public domain and is provided with
;;;; absolutely no warranty. See the COPYING and CREDITS files for
;;;; more information.
(defparameter *scratch-file-name* "sbcl-wrapped-stream-test-data.tmp")
(defvar *scratch-file-stream*)
(dolist (scratch-file-length '(1 ; everyone's favorite corner case
- 200123)) ; hopefully much bigger than buffer
+ 200123)) ; hopefully much bigger than buffer
(format t "/SCRATCH-FILE-LENGTH=~W~%" scratch-file-length)
(with-open-file (s *scratch-file-name* :direction :output)
(dotimes (i scratch-file-length)
(write-char #\x s)))
(dolist (wrap-named-stream-fn
- ;; All kinds of wrapped input streams have the same issue.
- (list (lambda (wrapped-stream-name)
- (make-synonym-stream wrapped-stream-name))
- (lambda (wrapped-stream-name)
- (make-two-way-stream (symbol-value wrapped-stream-name)
- *standard-output*))
- (lambda (wrapped-stream-name)
- (make-concatenated-stream (symbol-value wrapped-stream-name)
- (make-string-input-stream "")))))
+ ;; All kinds of wrapped input streams have the same issue.
+ (list (lambda (wrapped-stream-name)
+ (make-synonym-stream wrapped-stream-name))
+ (lambda (wrapped-stream-name)
+ (make-two-way-stream (symbol-value wrapped-stream-name)
+ *standard-output*))
+ (lambda (wrapped-stream-name)
+ (make-concatenated-stream (symbol-value wrapped-stream-name)
+ (make-string-input-stream "")))))
(format t "/WRAP-NAMED-STREAM-FN=~S~%" wrap-named-stream-fn)
(with-open-file (*scratch-file-stream* *scratch-file-name*
- :direction :input)
+ :direction :input)
(let ((ss (funcall wrap-named-stream-fn '*scratch-file-stream*)))
- (flet ((expect (thing-expected)
- (let ((thing-found (read-char ss nil nil)))
- (unless (eql thing-found thing-expected)
- (error "expected ~S, found ~S"
- thing-expected thing-found)))))
- (dotimes (i scratch-file-length)
- (expect #\x)
- (unread-char #\y ss)
- (expect #\y)
- (unread-char #\z ss)
- (expect #\z))
- (expect nil))))) ; i.e. end of file
+ (flet ((expect (thing-expected)
+ (let ((thing-found (read-char ss nil nil)))
+ (unless (eql thing-found thing-expected)
+ (error "expected ~S, found ~S"
+ thing-expected thing-found)))))
+ (dotimes (i scratch-file-length)
+ (expect #\x)
+ (unread-char #\y ss)
+ (expect #\y)
+ (unread-char #\z ss)
+ (expect #\z))
+ (expect nil))))) ; i.e. end of file
(delete-file *scratch-file-name*))
(with-open-file (s *scratch-file-name* :direction :output)