From: Tobias R. <tri...@us...> - 2010-04-27 09:08:11
|
Update of /cvsroot/sbcl/sbcl/tests In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv17486/tests Modified Files: pprint.impure.lisp Log Message: 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. Index: pprint.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/pprint.impure.lisp,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- pprint.impure.lisp 27 Apr 2010 07:19:59 -0000 1.14 +++ pprint.impure.lisp 27 Apr 2010 09:07:59 -0000 1.15 @@ -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 "#<FRABOTZICATOR>" + (let ((*print-right-margin* 5) + (*print-pretty* t)) + (format nil "~@<~S~:>" (make-instance 'frob)))))) + ;;; success |