From 2155320d81ccfe78cb8e6ba349883b2a0a366353 Mon Sep 17 00:00:00 2001 From: Rudi Schlatte Date: Fri, 20 May 2005 16:43:21 +0000 Subject: [PATCH] 0.9.0.40 Fix peek-char bug reported by Fredrik Sandstrom (sbcl-devel 2005-05-17, "Bug in peek-char") --- src/code/target-stream.lisp | 22 +++++++++++++--------- tests/stream.pure.lisp | 21 +++++++++++++++++++++ version.lisp-expr | 2 +- 3 files changed, 35 insertions(+), 10 deletions(-) diff --git a/src/code/target-stream.lisp b/src/code/target-stream.lisp index d018739..9593cd2 100644 --- a/src/code/target-stream.lisp +++ b/src/code/target-stream.lisp @@ -18,21 +18,22 @@ ;;; ;;; All arguments are forms which will be used for a specific purpose ;;; PEEK-TYPE - the current peek-type as defined by ANSI CL -;;; EOF-VALUE - the eof-value argument to peek-char +;;; EOF-RESULT - the eof-value argument to peek-char ;;; CHAR-VAR - the variable which will be used to store the current character ;;; READ-FORM - the form which will be used to read a character +;;; EOF-VALUE - the result returned from READ-FORM when hitting eof ;;; UNREAD-FORM - ditto for unread-char ;;; SKIPPED-CHAR-FORM - the form to execute when skipping a character ;;; EOF-DETECTED-FORM - the form to execute when EOF has been detected -;;; (this will default to CHAR-VAR) +;;; (this will default to EOF-RESULT) (sb!xc:defmacro generalized-peeking-mechanism - (peek-type eof-value char-var read-form unread-form + (peek-type eof-result char-var read-form eof-value unread-form &optional (skipped-char-form nil) (eof-detected-form nil)) `(let ((,char-var ,read-form)) - (cond ((eql ,char-var ,eof-value) + (cond ((eql ,char-var ,eof-value) ,(if eof-detected-form eof-detected-form - char-var)) + eof-result)) ((characterp ,peek-type) (do ((,char-var ,char-var ,read-form)) ((or (eql ,char-var ,eof-value) @@ -40,7 +41,7 @@ (cond ((eql ,char-var ,eof-value) ,(if eof-detected-form eof-detected-form - char-var)) + eof-result)) (t ,unread-form ,char-var))) ,skipped-char-form)) @@ -51,7 +52,7 @@ (cond ((eql ,char-var ,eof-value) ,(if eof-detected-form eof-detected-form - char-var)) + eof-result)) (t ,unread-form ,char-var))) ,skipped-char-form)) @@ -76,7 +77,8 @@ (t (generalized-peeking-mechanism peek-type eof-value char - (ansi-stream-read-char stream eof-error-p eof-value recursive-p) + (ansi-stream-read-char stream eof-error-p :eof recursive-p) + :eof (ansi-stream-unread-char char stream))))) (defun peek-char (&optional (peek-type nil) @@ -95,6 +97,7 @@ (if (null peek-type) (stream-peek-char stream) (stream-read-char stream)) + :eof (if (null peek-type) () (stream-unread-char stream char)) @@ -149,10 +152,11 @@ (pop (echo-stream-unread-stuff stream))) (t (setf unread-char-p nil) - (read-char in (first arg2) (second arg2)))))) + (read-char in (first arg2) :eof))))) (generalized-peeking-mechanism arg1 (second arg2) char (infn) + :eof (unread-char char in) (outfn char))))) (t diff --git a/tests/stream.pure.lisp b/tests/stream.pure.lisp index 6474758..120c706 100644 --- a/tests/stream.pure.lisp +++ b/tests/stream.pure.lisp @@ -74,6 +74,27 @@ ;; (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 "") diff --git a/version.lisp-expr b/version.lisp-expr index 7e81fac..1048da4 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.0.39" +"0.9.0.40" -- 1.7.10.4