;; (Before the fix, the LET* expression just signalled an error.)
"a"))
+;;; Reported by Fredrik Sandstrom to sbcl-devel 2005-05-17 ("Bug in
+;;; peek-char"):
+;;; Description: In (peek-char nil s nil foo), if foo happens to be
+;;; the same character that peek-char returns, the character is
+;;; removed from the input stream, as if read by read-char.
+(assert (equal (with-input-from-string (s "123")
+ (list (peek-char nil s nil #\1) (read-char s) (read-char s)))
+ '(#\1 #\1 #\2)))
+
+;;; ... and verify that the fix does not break echo streams
+(assert (string= (let ((out (make-string-output-stream)))
+ (with-open-stream (s (make-echo-stream
+ (make-string-input-stream "123")
+ out))
+ (format s "=>~{~A~}"
+ (list (peek-char nil s nil #\1)
+ (read-char s)
+ (read-char s)))
+ (get-output-stream-string out)))
+ "12=>112"))
+
;;; 0.7.12 doesn't advance current stream in concatenated streams
;;; correctly when searching a stream for a char to read.
(with-input-from-string (p "")
;;; Ideas?
#+nil (assert (eq (interactive-stream-p *terminal-io*) t))
-;;; FILE-POSITION on string-input-streams should work, even with
-;;; :START or :END new positions.
-(let ((stream (make-string-input-stream "abc")))
- (assert (char= (read-char stream) #\a))
- (assert (= (file-position stream) 1))
- (assert (file-position stream 0))
+;;; MAKE-STRING-INPUT-STREAM
+;;;
+;;; * Observe FILE-POSITION :START and :END, and allow setting of
+;;; FILE-POSITION beyond the end of string, signalling END-OF-FILE only
+;;; on read.
+(let* ((string (copy-seq "abc"))
+ (stream (make-string-input-stream string)))
(assert (char= (read-char stream) #\a))
+ (assert (= 1 (file-position stream)))
(assert (file-position stream :start))
- (assert (char= (read-char stream) #\a))
+ (assert (= 0 (file-position stream)))
+ (assert (file-position stream :end))
+ (assert (= (length string) (file-position stream)))
+ (assert (file-position stream (1- (file-position stream))))
+ (assert (char= (read-char stream) #\c))
+ (assert (file-position stream (1- (file-position stream))))
+ (assert (char= (read-char stream) #\c))
+ (assert (file-position stream :end))
+ (let ((eof (cons nil nil)))
+ (assert (eq (read-char stream nil eof) eof)))
+ (assert (file-position stream 10))
+ (multiple-value-bind (val cond) (ignore-errors (file-position stream -1))
+ (assert (null val))
+ (assert (typep cond 'error)))
+ (multiple-value-bind (val cond) (ignore-errors (read-char stream))
+ (assert (null val))
+ (assert (typep cond 'end-of-file))))
+
+;;; MAKE-STRING-OUTPUT-STREAM
+;;;
+;;; * Observe FILE-POSITION :START and :END, and allow setting of
+;;; FILE-POSITION to an arbitrary index.
+;;;
+;;; * END will always refer to the farthest position of stream so-far
+;;; seen, and setting FILE-POSITION beyond the current END will extend
+;;; the string/stream with uninitialized elements.
+;;;
+;;; * Rewinding the stream works with overwriting semantics.
+;;;
+(let ((stream (make-string-output-stream)))
+ (princ "abcd" stream)
+ (assert (= 4 (file-position stream)))
+ (assert (file-position stream :start))
+ (assert (= 0 (file-position stream)))
+ (princ "0" stream)
+ (assert (= 1 (file-position stream)))
+ (file-position stream 2)
+ (assert (= 2 (file-position stream)))
+ (princ "2" stream)
(assert (file-position stream :end))
- (assert (eq (read-char stream nil 'foo) 'foo)))
+ (assert (= 4 (file-position stream)))
+ (assert (file-position stream 6))
+ (assert (file-position stream 4))
+ (assert (file-position stream :end))
+ (assert (= 6 (file-position stream)))
+ (assert (file-position stream 4))
+ (multiple-value-bind (val cond) (ignore-errors (file-position stream -1))
+ (assert (null val))
+ (assert (typep cond 'error)))
+ (princ "!!" stream)
+ (assert (equal "0b2d!!" (get-output-stream-string stream))))
+
+;;; WITH-OUTPUT-TO-STRING (when provided with a string argument)
+;;;
+;;; * Observe FILE-POSITION :START and :END, and allow setting of
+;;; FILE-POSITION to an arbitrary index. If the new position is beyond
+;;; the end of string and the string is adjustable the string will be
+;;; implicitly extended, otherwise an error will be signalled. The
+;;; latter case is provided for in the code, but not currently
+;;; excercised since SBCL fill-pointer arrays are always (currently)
+;;; adjustable.
+;;;
+;;; * END will refer to the ARRAY-TOTAL-SIZE of string, not
+;;; FILL-POINTER, since by definition the FILE-POSITION will always be
+;;; a FILL-POINTER, so that would be of limited use.
+;;;
+;;; * Rewinding the stream works with overwriting semantics.
+;;;
+#+nil (let ((str (make-array 0
+ :element-type 'character
+ :adjustable nil
+ :fill-pointer t)))
+ (with-output-to-string (stream str)
+ (princ "abcd" stream)
+ (assert (= 4 (file-position stream)))
+ (assert (file-position stream :start))
+ (assert (= 0 (file-position stream)))
+ (princ "0" stream)
+ (assert (= 1 (file-position stream)))
+ (file-position stream 2)
+ (assert (= 2 (file-position stream)))
+ (princ "2" stream)
+ (assert (file-position stream :end))
+ (assert (= 4 (file-position stream)))
+ (multiple-value-bind (val cond) (ignore-errors (file-position stream -1))
+ (assert (null val))
+ (assert (typep cond 'error)))
+ (multiple-value-bind (val cond) (ignore-errors (file-position stream 6))
+ (assert (null val))
+ (assert (typep cond 'error)))
+ (assert (equal "0b2d" str))))
+
+(let ((str (make-array 0
+ :element-type 'character
+ :adjustable nil
+ :fill-pointer t)))
+ (with-output-to-string (stream str)
+ (princ "abcd" stream)
+ (assert (= 4 (file-position stream)))
+ (assert (file-position stream :start))
+ (assert (= 0 (file-position stream)))
+ (princ "0" stream)
+ (assert (= 1 (file-position stream)))
+ (file-position stream 2)
+ (assert (= 2 (file-position stream)))
+ (princ "2" stream)
+ (assert (file-position stream :end))
+ (assert (= 4 (file-position stream)))
+ (assert (file-position stream 6))
+ (assert (file-position stream 4))
+ (assert (file-position stream :end))
+ (assert (= 6 (file-position stream)))
+ (assert (file-position stream 4))
+ (multiple-value-bind (val cond) (ignore-errors (file-position stream -1))
+ (assert (null val))
+ (assert (typep cond 'error)))
+ (princ "!!" stream)
+ (assert (equal "0b2d!!" str))))
+
+;;; MAKE-STRING-OUTPUT-STREAM and WITH-OUTPUT-TO-STRING take an
+;;; :ELEMENT-TYPE keyword argument
+(macrolet ((frob (element-type-form)
+ `(progn
+ (let ((s (with-output-to-string
+ (s nil ,@(when element-type-form
+ `(:element-type ,element-type-form))))))
+ (assert (typep s '(simple-array ,(if element-type-form
+ (eval element-type-form)
+ 'character)
+ (0)))))
+ (get-output-stream-string
+ (make-string-output-stream
+ ,@(when element-type-form
+ `(:element-type ,element-type-form)))))))
+ (frob nil)
+ (frob 'character)
+ (frob 'base-char)
+ (frob 'nil))
+
+(with-open-file (s "/dev/null" :element-type '(signed-byte 48))
+ (assert (eq :eof (read-byte s nil :eof))))
+
+(let* ((is (make-string-input-stream "foo"))
+ (os (make-string-output-stream))
+ (s (make-echo-stream is os))
+ (sequence (copy-seq "abcdef")))
+ (assert (= (read-sequence sequence s) 3))
+ (assert (string= sequence "foodef"))
+ (assert (string= (get-output-stream-string os) "foo")))
+
+(let* ((is (make-string-input-stream "foo"))
+ (os (make-string-output-stream))
+ (s (make-echo-stream is os))
+ (sequence (copy-seq "abcdef")))
+ (assert (char= #\f (read-char s)))
+ (assert (= (read-sequence sequence s) 2))
+ (assert (string= sequence "oocdef"))
+ (assert (string= (get-output-stream-string os) "foo")))
+
+(let* ((is (make-string-input-stream "foo"))
+ (os (make-string-output-stream))
+ (s (make-echo-stream is os))
+ (sequence (copy-seq "abcdef")))
+ (assert (char= #\f (read-char s)))
+ (unread-char #\f s)
+ (assert (= (read-sequence sequence s) 3))
+ (assert (string= sequence "foodef"))
+ (assert (string= (get-output-stream-string os) "foo")))