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