common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Don't cons strings when read-suppressing

Browse source
This commit is contained in:
Douglas Katzman 2015-04-09 02:22:21 -04:00
parent d084c7484c
commit 881c95a99d
2 changed files with 22 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
src/code/reader.lisp
View file

@ -860,7 +860,9 @@ standard Lisp readtable when NIL."
(declare (character closech))
(let ((stream (in-synonym-of stream))
(buf *read-buffer*)
(rt *readtable*))
(rt *readtable*)
;; *read-suppress* => "... macros will not construct any new objects"
(suppress *read-suppress*))
(reset-read-buffer buf)
(macrolet ((scan (read-a-char eofp &optional finish)
`(loop (let ((char ,read-a-char))
@ -871,13 +873,15 @@ standard Lisp readtable when NIL."
(setq char ,read-a-char)
(when ,eofp
(error 'end-of-file :stream stream))))
(ouch-read-buffer (truly-the character char) buf)))))
(unless suppress
(ouch-read-buffer (truly-the character char)
buf))))))
(if (ansi-stream-p stream)
(prepare-for-fast-read-char stream
(scan (fast-read-char t) nil (done-with-fast-read-char)))
;; CLOS stream
(scan (read-char stream nil +EOF+) (eq char +EOF+))))
(copy-token-buf-string buf)))
(if suppress "" (copy-token-buf-string buf))))
(defun read-right-paren (stream ignore)
(declare (ignore ignore))

23
tests/reader.pure.lisp
View file

@ -213,14 +213,21 @@
;;; All these must return a primary value of NIL when *read-suppress* is T
;;; Reported by Bruno Haible on cmucl-imp 2004-10-25.
(let ((*read-suppress* t))
(assert (null (read-from-string "(1 2 3)")))
(assert (null (with-input-from-string (s "abc xyz)")
(read-delimited-list #\) s))))
(assert (null (with-input-from-string (s "(1 2 3)")
(read-preserving-whitespace s))))
(assert (null (with-input-from-string (s "(1 2 3)")
(read s)))))
(with-test (:name :read-suppress-char-macros)
(let ((*read-suppress* t))
(assert (null (read-from-string "(1 2 3)")))
(assert (null (with-input-from-string (s "abc xyz)")
(read-delimited-list #\) s))))
(assert (null (with-input-from-string (s "(1 2 3)")
(read-preserving-whitespace s))))
(assert (null (with-input-from-string (s "(1 2 3)")
(read s))))
;; .. and it's better to avoid consing rather than produce an object and
;; throw it away, even though it's (mostly) indistinguishable to the user.
(let ((input (make-string-input-stream "this-is-a-string! .")))
(assert (string= (sb-impl::with-read-buffer ()
(sb-impl::read-string input #\!))
"")))))
;;; System code that asks whether %READ-PRESERVING-WHITESPACE hit EOF
;;; mistook NIL as an object returned normally for NIL the default eof mark.