From 425ce8cf75122dfb7242ffbf5d726e12fae24e58 Mon Sep 17 00:00:00 2001 From: "Tobias C. Rittweiler" Date: Tue, 27 Apr 2010 09:07:58 +0000 Subject: [PATCH] 1.0.37.72: Fix ugliness in PRINT-UNREADABLE-OBJECT * If one used :TYPE NIL on it, one could sometimes get printed representations that looked like #<\nFOO...> (notice the newline.) * Test case included. * Fix some WITH-TEST forms of previous commit. --- NEWS | 1 + src/code/print.lisp | 4 ++-- tests/pprint.impure.lisp | 21 +++++++++++++++++---- version.lisp-expr | 2 +- 4 files changed, 21 insertions(+), 7 deletions(-) diff --git a/NEWS b/NEWS index c547ee3..13f057e 100644 --- a/NEWS +++ b/NEWS @@ -79,6 +79,7 @@ changes relative to sbcl-1.0.37: * bug fix: READ-BYTE isn't inline anymore, fixing weird streams failures. (lp#569404) * bug fix: RANDOM-STATE can be printed readably again. + * bug fix: Unreadable objects were sometimes printed like #<\nFoo>. changes in sbcl-1.0.37 relative to sbcl-1.0.36: * enhancement: Backtrace from THROW to uncaught tag on x86oids now shows diff --git a/src/code/print.lisp b/src/code/print.lisp index 276ce95..4676332 100644 --- a/src/code/print.lisp +++ b/src/code/print.lisp @@ -314,9 +314,9 @@ (when type (write (type-of object) :stream stream :circle nil :level nil :length nil) - (write-char #\space stream)) + (write-char #\space stream) + (pprint-newline :fill stream)) (when body - (pprint-newline :fill stream) (funcall body)) (when identity (when (or body (not type)) diff --git a/tests/pprint.impure.lisp b/tests/pprint.impure.lisp index 06c0c08..738f9f3 100644 --- a/tests/pprint.impure.lisp +++ b/tests/pprint.impure.lisp @@ -53,7 +53,7 @@ :done)) "#1=(1 2 3 . #1#)"))) -(with-test (:name :pprint :bug-99) +(with-test (:name (:pprint :bug-99)) (assert (equal (with-output-to-string (*standard-output*) (let* ((*print-circle* t)) @@ -113,7 +113,7 @@ ;;; bug reported by Paul Dietz on sbcl-devel: unquoted lambda lists ;;; were leaking the SB-IMPL::BACKQ-COMMA implementation. -(with-test (:name :pprint :leaking-backq-comma) +(with-test (:name :pprint-leaking-backq-comma) (assert (equal (with-output-to-string (s) (write '`(foo ,x) :stream s :pretty t :readably t)) @@ -172,7 +172,7 @@ (defun ppd-function-name (s o) (print (length o) s)) -(with-test (:name :set-pprint-dispatch :no-function-coerce)) +(with-test (:name (:set-pprint-dispatch :no-function-coerce))) (let ((s (with-output-to-string (s) (pprint '(frob a b) s)))) (assert (position #\3 s))) @@ -212,7 +212,7 @@ ;;; Printing malformed defpackage forms without errors. (with-test (:name :pprint-defpackage) - (with-open-stream (null (make-broadcast-stream)) + (let ((*standard-output* (make-broadcast-stream))) (pprint '(defpackage :foo nil)) (pprint '(defpackage :foo 42)))) @@ -235,5 +235,18 @@ (assert (equal "(DEFMETHOD FOO :AFTER (FUNCTION CONS) FUNCTION)" (to-string `(defmethod foo :after (function cons) function)))))) +(defclass frob () ()) + +(defmethod print-object ((obj frob) stream) + (print-unreadable-object (obj stream :type nil :identity nil) + (format stream "FRABOTZICATOR"))) + +;;; SBCL < 1.0.38 printed #<\nFRABOTIZICATOR> +(with-test (:name (:pprint-unreadable-object :no-ugliness-when-type=nil)) + (assert (equal "#" + (let ((*print-right-margin* 5) + (*print-pretty* t)) + (format nil "~@<~S~:>" (make-instance 'frob)))))) + ;;; success diff --git a/version.lisp-expr b/version.lisp-expr index 2945d53..6c153e3 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".) -"1.0.37.71" +"1.0.37.72" -- 1.7.10.4