From 8ac4167586be6db0ab26afa7ab6f326bb07c1a55 Mon Sep 17 00:00:00 2001 From: Gabor Melis Date: Fri, 4 Dec 2009 17:59:48 +0000 Subject: [PATCH 1/1] 1.0.33.6: prettier PRINT-OBJECT default method If *PRINT-PRETTY*, the default method of PRINT-OBJECT now establishes a logical block around PRINT-UNREADABLE-OBJECT that, in turn, adds a few PPRINT-NEWLINES to allow for the stuff between #< and > be broken into multiple lines as the pretty printer sees fit. This allows #<...> to be wrapped properly. https://bugs.launchpad.net/sbcl/+bug/488979 --- NEWS | 2 ++ src/code/print.lisp | 8 +++++--- src/pcl/print-object.lisp | 5 ++++- tests/print.impure.lisp | 16 ++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 28 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index 364bfc2..3d11b7d 100644 --- a/NEWS +++ b/NEWS @@ -6,6 +6,8 @@ changes relative to sbcl-1.0.33: Willem Broekema; launchpad bug lp#489698). * bug fix: some minor code rearrangements to reenable warning-free building from CMUCL (reported by xme@gmx.net; launchpad bug lp#491104) + * bug fix: PRINT-OBJECT for clos instances respects the right margin when + pretty printing changes in sbcl-1.0.33 relative to sbcl-1.0.32: * new port: support added for x86-64 NetBSD. (thanks to Aymeric Vincent) diff --git a/src/code/print.lisp b/src/code/print.lisp index 31b48ab..8e6e0c8 100644 --- a/src/code/print.lisp +++ b/src/code/print.lisp @@ -316,10 +316,12 @@ :level nil :length nil) (write-char #\space stream)) (when body + (pprint-newline :fill stream) (funcall body)) (when identity (when (or body (not type)) (write-char #\space stream)) + (pprint-newline :fill stream) (write-char #\{ stream) (write (get-lisp-obj-address object) :stream stream :radix nil :base 16) @@ -332,9 +334,9 @@ (pprint-logical-block (stream nil :prefix "#<" :suffix ">") (print-description))) (t - (write-string "#<" stream) - (print-description) - (write-char #\> stream)))) + (write-string "#<" stream) + (print-description) + (write-char #\> stream)))) nil) ;;;; OUTPUT-OBJECT -- the main entry point diff --git a/src/pcl/print-object.lisp b/src/pcl/print-object.lisp index b5c2500..7711dab 100644 --- a/src/pcl/print-object.lisp +++ b/src/pcl/print-object.lisp @@ -46,7 +46,10 @@ (fmakunbound 'print-object) (defgeneric print-object (object stream)) (defmethod print-object ((x t) stream) - (print-unreadable-object (x stream :type t :identity t)))) + (if *print-pretty* + (pprint-logical-block (stream nil) + (print-unreadable-object (x stream :type t :identity t))) + (print-unreadable-object (x stream :type t :identity t))))) (/show0 "done replacing placeholder PRINT-OBJECT with DEFGENERIC") ;;;; a hook called by the printer to take care of dispatching to PRINT-OBJECT diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp index 7766b39..382483a 100644 --- a/tests/print.impure.lisp +++ b/tests/print.impure.lisp @@ -456,4 +456,20 @@ (let ((*print-pretty* t)) (assert (string= (princ-to-string 'bar) "BAR")))))) +;;; bug-lp#488979 + +(defclass a-class-name () ()) + +(assert (find #\Newline + (let ((*print-pretty* t) + (*print-right-margin* 10)) + (format nil "~A" (make-instance 'a-class-name))) + :test #'char=)) + +(assert (not (find #\Newline + (let ((*print-pretty* nil) + (*print-right-margin* 10)) + (format nil "~A" (make-instance 'a-class-name))) + :test #'char=))) + ;;; success diff --git a/version.lisp-expr b/version.lisp-expr index 8a41bfe..436b013 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.33.5" +"1.0.33.6" -- 1.7.10.4