0.9.0.40

Fix peek-char bug reported by Fredrik Sandstrom (sbcl-devel
2005-05-17, "Bug in peek-char")

diff --git a/src/code/target-stream.lisp b/src/code/target-stream.lisp
index d018739..9593cd2 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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"