From 35b9e99e66b856c11a7018f2345eebc6960bdd1f Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sun, 17 Aug 2008 09:28:10 +0000
Subject: [PATCH] 1.0.19.30: muffle code deletion note from destructuring-bind

 * Was emitted when destructuring constant lists.
---
 NEWS                         |  3 +++
 src/code/parse-defmacro.lisp |  2 ++
 tests/compiler.pure.lisp     | 18 ++++++++++++++++++
 version.lisp-expr            |  2 +-
 4 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/NEWS b/NEWS
index 0cfec0242..1cc248cd7 100644
--- a/NEWS
+++ b/NEWS
@@ -23,6 +23,9 @@ changes in sbcl-1.0.20 relative to 1.0.19:
     work. (thanks to Alec Berryman)
   * optimization: REPLACE deftransforms don't punt when :START1 or
     :START2 is given
+  * bug fix: compiling DESTRUCTURING-BIND on constant list arguments
+    no longer emits a code deletion note. (reported by Andrew
+    Gasparovic)
   * bug fix: bogus odd-number-of-keywords STYLE-WARNINGs from calls to
     functions with an odd number of &OPTIONAL arguments, a &REST
     argument, and one or more &KEY arguments at the call site.
diff --git a/src/code/parse-defmacro.lisp b/src/code/parse-defmacro.lisp
index 613f9c021..bc233baaa 100644
--- a/src/code/parse-defmacro.lisp
+++ b/src/code/parse-defmacro.lisp
@@ -51,6 +51,8 @@
                                       :error-fun error-fun
                                       :anonymousp anonymousp)
         (values `(let* (,@(nreverse *system-lets*))
+                   #-sb-xc-host
+                   (declare (muffle-conditions sb!ext:code-deletion-note))
                    ,@(when *ignorable-vars*
                        `((declare (ignorable ,@*ignorable-vars*))))
                    ,@*arg-tests*
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index c85ebd08e..6fcfb213d 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2626,3 +2626,21 @@
     (multiple-value-bind (res err) (ignore-errors (funcall fun nil))
       (assert (not res))
       (assert (typep err 'type-error)))))
+
+(with-test (:name :constant-list-destructuring)
+  (handler-bind ((sb-ext:compiler-note #'error))
+    (progn
+      (assert (= 10
+                 (funcall
+                  (compile nil
+                           '(lambda ()
+                             (destructuring-bind (a (b c) d) '(1 (2 3) 4)
+                               (+ a b c d)))))))
+      (assert (eq :feh
+                  (funcall
+                   (compile nil
+                            '(lambda (x)
+                              (or x
+                               (destructuring-bind (a (b c) d) '(1 "foo" 4)
+                                 (+ a b c d)))))
+                   :feh))))))
diff --git a/version.lisp-expr b/version.lisp-expr
index eb782f27f..20751b549 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.19.29"
+"1.0.19.30"
-- 
2.11.4.GIT