From 70f323d9b06b95ed37a447742c1925906985c088 Mon Sep 17 00:00:00 2001 From: Paul Khuong Date: Sat, 30 Mar 2013 21:06:32 +0100 Subject: [PATCH] Stop emitting references to inexistant #n= forms in the pretty printer * Special logic was introduced in 2003 to avoid pprinting backquote-comma forms as ", foo" when ",foo" is unambiguous; the bug has likely been around since then. * Reported by Douglas Katzman on launchpad, and reduced by James M. Lawrence (lp#1161218) --- NEWS | 2 ++ src/code/pp-backq.lisp | 22 ++++++++++++++++------ tests/pprint.impure.lisp | 6 ++++++ 3 files changed, 24 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index 0357268..0450bf6 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,8 @@ changes relative to sbcl-1.1.6 * bug fix: svref/(setf svref) on symbol macros don't crash the compiler anymore. (Minimal test case provided by James M. Lawrence on sbcl-devel) + * bug fix: no more bogus ## references when pretty printing backquoted + forms with non-trivial structure sharing. (lp#1161218) changes in sbcl-1.1.6 relative to sbcl-1.1.5: * enhancement: the continuable error when defknown-ing over extant diff --git a/src/code/pp-backq.lisp b/src/code/pp-backq.lisp index c1268d0..fd1fb13 100644 --- a/src/code/pp-backq.lisp +++ b/src/code/pp-backq.lisp @@ -96,14 +96,24 @@ ;; stream, possibly with a space prepended. However, this doesn't ;; work for pretty streams which need to do margin calculations. Oh ;; well. It was good while it lasted. -- CSR, 2003-12-15 - (let ((output (with-output-to-string (s) - (write (cadr form) :stream s)))) - (unless (= (length output) 0) - (when (and (eql (car form) 'backq-comma) + ;; + ;; This is an evil hack. If we print to a string and then print again, + ;; the circularity detection logic behaves as though it's already + ;; printed that data... and it has, to a string stream that we send + ;; to the bitbucket in the sky. -- PK, 2013-03-30 + (when (eql (car form) 'backq-comma) + (let ((output (with-output-to-string (s) + ;; Patching evil with more evil. The next step is + ;; likely to stop the madness and unconditionally + ;; insert a space. + (let (*circularity-hash-table* + *circularity-counter*) + (write (cadr form) :stream s))))) + (when (and (plusp (length output)) (or (char= (char output 0) #\.) (char= (char output 0) #\@))) - (write-char #\Space stream)) - (write (cadr form) :stream stream)))) + (write-char #\Space stream)))) + (write (cadr form) :stream stream)) ;;; This is called by !PPRINT-COLD-INIT, fairly late, because ;;; SET-PPRINT-DISPATCH doesn't work until the compiler works. diff --git a/tests/pprint.impure.lisp b/tests/pprint.impure.lisp index 4e6d8a3..39884e0 100644 --- a/tests/pprint.impure.lisp +++ b/tests/pprint.impure.lisp @@ -291,5 +291,11 @@ (when errors (error "Can't PPRINT imporper lists: ~a" errors)))) +(with-test (:name :pprint-circular-backq-comma) + ;; LP 1161218 reported by James M. Lawrence + (let ((string (write-to-string '(let ((#1=#:var '(99))) + `(progn ,@(identity #1#))) + :circle t :pretty t))) + (assert (not (search "#2#" string))))) ;;; success -- 1.7.10.4