From c364434c07423e4b033f286397667b3fe0310e97 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 10 Aug 2005 07:57:33 +0000 Subject: [PATCH] 0.9.3.36: Fix bug reported by Nicholas Neuss (c.l.l, 2005-06-07, "ANSI question") ... confusion between whitespace[1] and whitespace[2], now deconfused and made explicit. ... tests of PARSE-INTEGER (whitespace[1]) and PEEK-CHAR T (whitespace[2]) --- NEWS | 2 ++ contrib/sb-simple-streams/impl.lisp | 4 ++-- src/code/reader.lisp | 20 ++++++++++++-------- src/code/target-extensions.lisp | 2 +- src/code/target-stream.lisp | 2 +- tests/reader.pure.lisp | 10 ++++++++++ tests/stream.pure.lisp | 6 ++++++ version.lisp-expr | 2 +- 8 files changed, 35 insertions(+), 13 deletions(-) diff --git a/NEWS b/NEWS index 8b6b726..8a32718 100644 --- a/NEWS +++ b/NEWS @@ -20,6 +20,8 @@ changes in sbcl-0.9.4 relative to sbcl-0.9.3: * fixed bug 343: SB-KERNEL:INSTANCE-LAMBDA is no longer necessary for funcallable-instance functions, and is no different from regular LAMBDA. + * bug fix: PARSE-INTEGER no longer depends on the whitespaceness of + characters in the current readtable. (reported by Nicholas Neuss) * optimizations: REMOVE-DUPLICATES now runs in linear time on lists in some cases. This partially fixes bug 384. * flush all standard streams before prompting in the REPL and the diff --git a/contrib/sb-simple-streams/impl.lisp b/contrib/sb-simple-streams/impl.lisp index 1c7582e..c6b696c 100644 --- a/contrib/sb-simple-streams/impl.lisp +++ b/contrib/sb-simple-streams/impl.lisp @@ -273,7 +273,7 @@ eof-error-p stream t))) ((or (eq char stream) - (not (sb-impl::whitespacep char))) + (not (sb-impl::whitespace[2]p char))) (unless (eq char stream) (funcall-stm-handler j-unread-char encap t)) (if (eq char stream) eof-value char)))) @@ -805,7 +805,7 @@ ((eq peek-type t) (do ((char (sb-gray:stream-read-char stream) (sb-gray:stream-read-char stream))) - ((or (eq char :eof) (not (sb-impl::whitespacep char))) + ((or (eq char :eof) (not (sb-impl::whitespace[2]p char))) (cond ((eq char :eof) (sb-impl::eof-or-lose stream eof-error-p eof-value)) (t diff --git a/src/code/reader.lisp b/src/code/reader.lisp index bf17289..243fd0c 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -114,8 +114,12 @@ ;;; predicates for testing character attributes -#!-sb-fluid (declaim (inline whitespacep)) -(defun whitespacep (char &optional (rt *readtable*)) +;;; the [1] and [2] here refer to ANSI glossary entries for +;;; "whitespace". +#!-sb-fluid (declaim (inline whitespace[1]p whitespace[2]p)) +(defun whitespace[1]p (char) + (test-attribute char +char-attr-whitespace+ *standard-readtable*)) +(defun whitespace[2]p (char &optional (rt *readtable*)) (test-attribute char +char-attr-whitespace+ rt)) (defmacro constituentp (char &optional (rt '*readtable*)) @@ -468,7 +472,7 @@ variables to allow for nested and thread safe reading." (loop (let ((char (read-char stream eof-error-p *eof-object*))) (cond ((eofp char) (return eof-value)) - ((whitespacep char)) + ((whitespace[2]p char)) (t (let* ((macrofun (get-coerced-cmt-entry char *readtable*)) (result (multiple-value-list @@ -507,7 +511,7 @@ variables to allow for nested and thread safe reading." (unless (or (eql result eof-value) recursivep) (let ((next-char (read-char stream nil nil))) (unless (or (null next-char) - (whitespacep next-char)) + (whitespace[2]p next-char)) (unread-char next-char stream)))) result)) @@ -569,7 +573,7 @@ variables to allow for nested and thread safe reading." (%reader-error stream "Nothing appears before . in list."))) - ((whitespacep nextchar) + ((whitespace[2]p nextchar) (setq nextchar (flush-whitespace stream)))) (rplacd listtail ;; Return list containing last thing. @@ -1534,7 +1538,7 @@ variables to allow for nested and thread safe reading." (return-from parse-integer (values nil end)) (parse-error "no non-whitespace characters in string ~S."))) (declare (fixnum i)) - (unless (whitespacep (char string i)) (return i)))) + (unless (whitespace[1]p (char string i)) (return i)))) (minusp nil) (found-digit nil) (result 0)) @@ -1553,11 +1557,11 @@ variables to allow for nested and thread safe reading." (setq result (+ weight (* result radix)) found-digit t)) (junk-allowed (return nil)) - ((whitespacep char) + ((whitespace[1]p char) (loop (incf index) (when (= index end) (return)) - (unless (whitespacep (char string index)) + (unless (whitespace[1]p (char string index)) (parse-error "junk in string ~S"))) (return nil)) (t diff --git a/src/code/target-extensions.lisp b/src/code/target-extensions.lisp index 87d4446..62f062a 100644 --- a/src/code/target-extensions.lisp +++ b/src/code/target-extensions.lisp @@ -40,7 +40,7 @@ applications.") (do ((char (read-char-no-hang stream nil nil nil) (read-char-no-hang stream nil nil nil))) ((null char) nil) - (cond ((not (whitespacep char)) + (cond ((not (whitespace[1]p char)) (unread-char char stream) (return t))))) diff --git a/src/code/target-stream.lisp b/src/code/target-stream.lisp index 4da3db1..c18b851 100644 --- a/src/code/target-stream.lisp +++ b/src/code/target-stream.lisp @@ -48,7 +48,7 @@ ((eql ,peek-type t) (do ((,char-var ,char-var ,read-form)) ((or (eql ,char-var ,read-eof) - (not (whitespacep ,char-var))) + (not (whitespace[2]p ,char-var))) (cond ((eql ,char-var ,read-eof) ,(if eof-detected-form eof-detected-form diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp index ed9743a..62bd000 100644 --- a/tests/reader.pure.lisp +++ b/tests/reader.pure.lisp @@ -228,3 +228,13 @@ (assert (equal '((0 . "A") (1 . "B")) (coerce (read-from-string "#((0 . \"A\") (1 . \"B\"))") 'list))) + +;;; parse-integer uses whitespace[1] not whitespace[2] as its +;;; definition of whitespace to skip. +(let ((*readtable* (copy-readtable))) + (set-syntax-from-char #\7 #\Space) + (assert (= 710 (parse-integer "710")))) + +(let ((*readtable* (copy-readtable))) + (set-syntax-from-char #\7 #\Space) + (assert (string= (format nil "~7D" 1) " 1"))) diff --git a/tests/stream.pure.lisp b/tests/stream.pure.lisp index b9e2a9b..9e9d914 100644 --- a/tests/stream.pure.lisp +++ b/tests/stream.pure.lisp @@ -293,3 +293,9 @@ (with-standard-io-syntax (open "/dev/null")) + +;;; PEEK-CHAR T uses whitespace[2] +(let ((*readtable* (copy-readtable))) + (assert (char= (peek-char t (make-string-input-stream " a")) #\a)) + (set-syntax-from-char #\Space #\a) + (assert (char= (peek-char t (make-string-input-stream " a")) #\Space))) diff --git a/version.lisp-expr b/version.lisp-expr index 42f8fcd..b30a6b6 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.3.35" +"0.9.3.36" -- 1.7.10.4