1.0.45.31: make COPY-PPRINT-DISPATCH have access to a pristine table

  ...so that it can always be used to restore the original.

  Fixes lp#678409.

  Also add missing NEWS entry for last commit.

diff --git a/NEWS b/NEWS
index 79a2a74..1120bec 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -3,6 +3,8 @@ changes relative to sbcl-1.0.45:
   * enhancement: largefile support on Solaris.
   * enhancement: SB-PROFILE:REPORT now supports :LIMIT and :PRINT-NO-CALL-LIST
     arguments (lp#710017)
+  * enhancement: forward referenced functions no longer cause STYLE-WARNINGS
+    when running under --script. (lp#677779)
   * optimization: ERROR and CERROR are approximately 5 times faster.
   * optimization: optimized constructors are used for MAKE-INSTANCE of classes
     with applicable non-standard (SETF SLOT-VALUE-USING-CLASS),
@@ -22,6 +24,9 @@ changes relative to sbcl-1.0.45:
   * bug fix: RUN-PROGRAM :PTY option was racy on OpenBSD. (lp#669485)
   * bug fix: UNINTERN takes a symbol, not a symbol designator -- could previously
     unintern the wrong symbol with the same name. (lp#693796)
+  * bug fix: COPY-PPRINT-DISPATCH always has access to a pristine table,
+    making it possible to restore the initial table if it has been messed up.
+    (lp#678409)
 
 changes in sbcl-1.0.45 relative to sbcl-1.0.44:
   * enhancement: ~/ and ~user/ are treated specially in pathnames.

diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp
index f938d30..c0ab247 100644 (file)
--- a/src/code/pprint.lisp
+++ b/src/code/pprint.lisp
@@ -1591,5 +1591,6 @@ line break."
 
   (setf *standard-pprint-dispatch-table*
         (copy-pprint-dispatch *initial-pprint-dispatch-table*))
-  (setf *print-pprint-dispatch* *initial-pprint-dispatch-table*)
+  (setf *print-pprint-dispatch*
+        (copy-pprint-dispatch *initial-pprint-dispatch-table*))
   (setf *print-pretty* t))

diff --git a/tests/pprint.impure.lisp b/tests/pprint.impure.lisp
index e59458f..038af4d 100644 (file)
--- a/tests/pprint.impure.lisp
+++ b/tests/pprint.impure.lisp
@@ -269,5 +269,14 @@
                              (pprint-newline :mandatory s)))
                          n)))))
 
+(with-test (:name :can-restore-orig-pprint-dispatch-table)
+  (let* ((orig (pprint-dispatch 'some-symbol))
+         (alt (lambda (&rest args) (apply orig args))))
+    (set-pprint-dispatch 'symbol alt)
+    (assert (eq alt (pprint-dispatch 'some-symbol)))
+    (setf *print-pprint-dispatch* (copy-pprint-dispatch nil))
+    (assert (eq orig (pprint-dispatch 'some-symbol)))
+    (assert (not (eq alt orig)))))
+
 \f
 ;;; success

diff --git a/version.lisp-expr b/version.lisp-expr
index 34f1332..b57f14e 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -20,4 +20,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.45.30"
+"1.0.45.31"