;;;; 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))))