From 24407d11d34abdaaef6d839fd0b2665c73b0e6d5 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sun, 24 Nov 2002 22:40:52 +0000 Subject: [PATCH] 0.7.9.66: merged emu patch from sbcl-devel 2002-11-18, tweaking .32 patch to cope with PEEK-CHAR/UNREAD-CHAR on ECHO-STREAMs better --- src/code/stream.lisp | 54 +++++++++++++++++++++++++++++++++--------------- tests/stream.pure.lisp | 14 ++++++++++++- version.lisp-expr | 2 +- 3 files changed, 51 insertions(+), 19 deletions(-) diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 6e0e377..ac44a90 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -992,7 +992,6 @@ (in-fun echo-bin read-byte ansi-stream-bout stream-write-byte eof-error-p eof-value)) - (defun echo-misc (stream operation &optional arg1 arg2) (let* ((in (two-way-stream-input-stream stream)) (out (two-way-stream-output-stream stream))) @@ -1014,18 +1013,39 @@ (set-closed-flame stream)) (:peek-char ;; For the special case of peeking into an echo-stream - ;; arg1 is peek-type, arg2 is (eof-error-p eof-value) + ;; arg1 is PEEK-TYPE, arg2 is (EOF-ERROR-P EOF-VALUE) ;; returns peeked-char, eof-value, or errors end-of-file - (flet ((outfn (c) - (if (ansi-stream-p out) - (funcall (ansi-stream-out out) out c) - ;; gray-stream - (stream-write-char out c)))) - (generalized-peeking-mechanism - arg1 (second arg2) char - (read-char in (first arg2) (second arg2)) - (unread-char char in) - (outfn char)))) + ;; + ;; Note: This code could be moved into PEEK-CHAR if desired. + ;; I am unsure whether this belongs with echo-streams because it is + ;; echo-stream specific, or PEEK-CHAR because it is peeking code. + ;; -- mrd 2002-11-18 + ;; + ;; UNREAD-CHAR-P indicates whether the current character was one + ;; that was previously unread. In that case, we need to ensure that + ;; the semantics for UNREAD-CHAR are held; the character should + ;; not be echoed again. + (let ((unread-char-p nil)) + (flet ((outfn (c) + (unless unread-char-p + (if (ansi-stream-p out) + (funcall (ansi-stream-out out) out c) + ;; gray-stream + (stream-write-char out c)))) + (infn () + ;; Obtain input from unread buffer or input stream, + ;; and set the flag appropriately. + (cond ((not (null (echo-stream-unread-stuff stream))) + (setf unread-char-p t) + (pop (echo-stream-unread-stuff stream))) + (t + (setf unread-char-p nil) + (read-char in (first arg2) (second arg2)))))) + (generalized-peeking-mechanism + arg1 (second arg2) char + (infn) + (unread-char char in) + (outfn char))))) (t (or (if (ansi-stream-p in) (funcall (ansi-stream-misc in) in operation arg1 arg2) @@ -1033,16 +1053,16 @@ (if (ansi-stream-p out) (funcall (ansi-stream-misc out) out operation arg1 arg2) (stream-misc-dispatch out operation arg1 arg2))))))) - -;;;; string streams +;;;; base STRING-STREAM stuff + (defstruct (string-stream (:include ansi-stream) (:constructor nil) (:copier nil)) (string nil :type string)) - -;;;; string input streams + +;;;; STRING-INPUT-STREAM stuff (defstruct (string-input-stream (:include string-stream @@ -1134,7 +1154,7 @@ (internal-make-string-input-stream (coerce string 'simple-string) start end)) -;;;; string output streams +;;;; STRING-OUTPUT-STREAM stuff (defstruct (string-output-stream (:include string-stream diff --git a/tests/stream.pure.lisp b/tests/stream.pure.lisp index 845c87e..d1f52f8 100644 --- a/tests/stream.pure.lisp +++ b/tests/stream.pure.lisp @@ -53,7 +53,7 @@ (return))))) ;;; Entomotomy PEEK-CHAR-WRONGLY-ECHOS-TO-ECHO-STREAM bug, fixed by -;;; by MRD patch sbcl-devel 2002-11-02 merged ca. sbcl-0.7.9.32 +;;; by MRD patch sbcl-devel 2002-11-02 merged ca. sbcl-0.7.9.32... (assert (string= (with-output-to-string (out) (peek-char #\] @@ -61,3 +61,15 @@ (make-string-input-stream "ab cd e df s]") out))) ;; (Before the fix, the result had a trailing #\] in it.) "ab cd e df s")) +;;; ...and a missing wrinkle in the original patch, dealing with +;;; PEEK-CHAR/UNREAD-CHAR on ECHO-STREAMs, fixed by MRD patch +;;; sbcl-devel 2002-11-18, merged ca. sbcl-0.7.9.66 +(assert (string= + (let* ((in-stream (make-string-input-stream "abc")) + (out-stream (make-string-output-stream)) + (echo-stream (make-echo-stream in-stream out-stream))) + (unread-char (read-char echo-stream) echo-stream) + (peek-char #\a echo-stream) + (get-output-stream-string out-stream)) + ;; (Before the fix, the LET* expression just signalled an error.) + "a")) diff --git a/version.lisp-expr b/version.lisp-expr index c1dd8f6..1cf8fce 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.9.65" +"0.7.9.66" -- 1.7.10.4