1.0.8.27: Improve error handling for (DESTRUCTURING-BIND (...) 'NOTLIST ...).

diff --git a/src/code/destructuring-bind.lisp b/src/code/destructuring-bind.lisp
index e2d699d..c485b75 100644 (file)
--- a/src/code/destructuring-bind.lisp
+++ b/src/code/destructuring-bind.lisp
@@ -20,5 +20,8 @@ tree structure resulting from the evaluation of EXPRESSION."
                         :doc-string-allowed nil
                         :wrap-block nil)
       `(let ((,whole-name ,expression))
+         ;; This declaration-as-assertion should protect us from
+         ;; (DESTRUCTURING-BIND (X . Y) 'NOT-A-LIST ...).
+         (declare (type list ,whole-name))
          ,@local-decls
          ,body))))

diff --git a/src/code/parse-defmacro.lisp b/src/code/parse-defmacro.lisp
index fe30d12..613f9c0 100644 (file)
--- a/src/code/parse-defmacro.lisp
+++ b/src/code/parse-defmacro.lisp
@@ -91,7 +91,7 @@
          (aux-seen nil)
          (optional-seen nil)
          ;; ANSI specifies that dotted lists are "treated exactly as if the
-         ;; parameter name that ends the list had appeared preceded by &rest."
+         ;; parameter name that ends the list had appeared preceded by &REST."
          ;; We force this behavior by transforming dotted lists into ordinary
          ;; lists with explicit &REST elements.
          (lambda-list (do ((in-pdll possibly-dotted-lambda-list (cdr in-pdll))
@@ -106,14 +106,14 @@
       (error "&WHOLE may only appear first in ~S lambda-list." context))
     ;; Special case compiler-macros: if car of the form is FUNCALL,
     ;; skip over it for destructuring, pretending cdr of the form is
-    ;; the actual form. Save original for &whole
+    ;; the actual form. Save original for &WHOLE.
     (when (eq context 'define-compiler-macro)
       (push-let-binding compiler-macro-whole whole-var :system t)
       (push compiler-macro-whole *ignorable-vars*)
       (push-let-binding whole-var whole-var
                         :system t
                         :when `(not (eq 'funcall (car ,whole-var)))
-                        ;; do we need to SETF too?
+                        ;; Do we need to SETF too?
                         :else `(setf ,whole-var (cdr ,whole-var))))
     (do ((rest-of-lambda-list lambda-list (cdr rest-of-lambda-list)))
         ((null rest-of-lambda-list))

diff --git a/tests/destructure.impure.lisp b/tests/destructure.impure.lisp
new file mode 100644 (file)
index 0000000..a611b47
--- /dev/null
+++ b/tests/destructure.impure.lisp
@@ -0,0 +1,25 @@
+;;;; tests, with side effects, of DESTRUCTURING-BIND-ish functionality
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+;;; In sbcl-1.0.7.8, the printer for the ERROR condition signalled from
+;;;   (DESTRUCTURING-BIND (...) 1 ...)
+;;; contained the implicit assumption that the bad datum was a list,
+;;; so that attempting to print the condition caused a new error.
+(defun frob-1-0-7-8 (x)
+  (destructuring-bind (y . z) x
+    (print y)
+    (print z)))
+(multiple-value-bind (whatever error)
+    (ignore-errors (frob-1-0-7-8 1))
+  (declare (ignore whatever))
+  (princ error)) ; shouldn't cause an error

diff --git a/version.lisp-expr b/version.lisp-expr
index a43a54b..eaf4ef1 100644 (file)
--- 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.8.26"
+"1.0.8.27"