From 668b13f520677a64246faf6885713ca08ebbb0cd Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Mon, 23 May 2005 18:02:12 +0000 Subject: [PATCH] Bug from cmucl-imp, 2005-05-17 by Fredrik Sandstrom: 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. Examples: * (with-input-from-string (s "123") (list (peek-char nil s nil #\1) (read-char s) (read-char s))) (#\1 #\2 #\3) This fix is based on the version proposed by Rudi Schlatte, with minor changes in naming. --- code/stream.lisp | 29 ++++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/code/stream.lisp b/code/stream.lisp index 7a7c50386..dacd96733 100644 --- a/code/stream.lisp +++ b/code/stream.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.79 2005/04/19 18:26:42 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.80 2005/05/23 18:02:12 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -458,45 +458,46 @@ ;;; EOF-VALUE - 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 +;;; READ-EOF - the result returned from READ-FORM when eof is reached. ;;; 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) (defmacro generalized-peeking-mechanism (peek-type eof-value char-var - read-form unread-form + read-form read-eof 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 ,read-eof) ,(if eof-detected-form eof-detected-form - char-var)) + eof-value)) ((characterp ,peek-type) (do ((,char-var ,char-var ,read-form)) - ((or (eql ,char-var ,eof-value) + ((or (eql ,char-var ,read-eof) (char= ,char-var ,peek-type)) - (cond ((eql ,char-var ,eof-value) + (cond ((eql ,char-var ,read-eof) ,(if eof-detected-form eof-detected-form - char-var)) + eof-value)) (t ,unread-form ,char-var))) ,skipped-char-form)) ((eql ,peek-type t) (do ((,char-var ,char-var ,read-form)) - ((or (eql ,char-var ,eof-value) + ((or (eql ,char-var ,read-eof) (not (eql (get-cat-entry ,char-var *readtable*) whitespace))) - (cond ((eql ,char-var ,eof-value) + (cond ((eql ,char-var ,read-eof) ,(if eof-detected-form eof-detected-form - char-var)) + eof-value)) (t ,unread-form ,char-var))) ,skipped-char-form)) ((null ,peek-type) ,unread-form ,(if eof-detected-form - (when (eql char-var eof-value) + (when (eql char-var read-eof) eof-detected-form)) ,char-var) (t @@ -526,7 +527,8 @@ ;; lisp-stream (generalized-peeking-mechanism peek-type eof-value char - (read-char stream eof-errorp eof-value) + (read-char stream eof-errorp :eof) + :eof (unread-char char stream) nil (eof-or-lose stream (or eof-errorp recursive-p) eof-value)) @@ -1346,10 +1348,11 @@ output to Output-stream" (pop (echo-stream-unread-stuff stream))) (t (setf unread-char-p nil) - (read-char in eof-errorp eof-value))))) + (read-char in eof-errorp :eof))))) (generalized-peeking-mechanism arg1 eof-value char (infn) + :eof (unread-char char in) (outfn char)))))) (:file-length -- GitLab