X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Flambda-list.pure.lisp;h=3ccb54762b5fe6a1ed7c75a05711812e8c1bd800;hb=2e3a763ddec79a0888191714c3588b51c689d38c;hp=3f202d77aceae2ef71b10c740511e552c8061572;hpb=9f684145a95d4abbde75422edb8b217dfad3375b;p=sbcl.git

diff --git a/tests/lambda-list.pure.lisp b/tests/lambda-list.pure.lisp
index 3f202d7..3ccb547 100644
--- a/tests/lambda-list.pure.lisp
+++ b/tests/lambda-list.pure.lisp
@@ -6,29 +6,32 @@
 ;;;; 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.
 
-(macrolet ((error-p (ll)
-             `(progn
-                (multiple-value-bind (result error) (ignore-errors (handler-bind ((error #'error))
-                                                                     (eval `(lambda ,',ll 'ok))))
-                  (unless (and (not result) error)
-                    (error "No error from lambda ~S." ',ll)))
-                (multiple-value-bind (result error) (ignore-errors (handler-bind ((error #'error))
-                                                                     (eval `(lambda (x) (destructuring-bind ,',ll x 'ok)))))
-                  (unless (and (not result) error)
-                    (error "No error from d-b ~S." ',ll))))))
-  (error-p (&aux (foo 1) &aux (bar 2)))
-  (error-p (&aux (foo 1) &key bar))
-  (error-p (&aux (foo 1) &optional bar))
-  (error-p (&aux (foo 1) &rest bar))
-  (error-p (&key foo &allow-other-keys &allow-other-keys))
-  (error-p (&key foo &key bar))
-  (error-p (&key foo &optional bar))
-  (error-p (&key foo &rest bar))
-  (error-p (&optional foo &optional bar))
-  (error-p (&rest foo &rest bar))
-  (error-p (&rest foo &optional bar)))
+(let ((*macroexpand-hook* (lambda (fun form env)
+                            (handler-bind ((error (lambda (c)
+                                                    (when (eq 'destructuring-bind (car form))
+                                                      (throw 'd-b-error c)))))
+                              (funcall fun form env)))))
+  (macrolet ((error-p (ll)
+               `(progn
+                  (multiple-value-bind (result error) (ignore-errors (eval `(lambda ,',ll 'ok)))
+                    (unless (and (not result) error)
+                      (error "No error from lambda ~S." ',ll)))
+                  (catch 'd-b-error
+                    (eval `(lambda (x) (destructuring-bind ,',ll x 'ok)))
+                    (error "No error from d-b ~S." ',ll)))))
+    (error-p (&aux (foo 1) &aux (bar 2)))
+    (error-p (&aux (foo 1) &key bar))
+    (error-p (&aux (foo 1) &optional bar))
+    (error-p (&aux (foo 1) &rest bar))
+    (error-p (&key foo &allow-other-keys &allow-other-keys))
+    (error-p (&key foo &key bar))
+    (error-p (&key foo &optional bar))
+    (error-p (&key foo &rest bar))
+    (error-p (&optional foo &optional bar))
+    (error-p (&rest foo &rest bar))
+    (error-p (&rest foo &optional bar))))