0.8.17.17:
[sbcl.git] / tests / lambda-list.pure.lisp
1 ;;;; lambda-list parsing tests with no side-effects
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
8 ;;;; from CMU CL.
9 ;;;; 
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
13
14 (let ((*macroexpand-hook* (lambda (fun form env)
15                             (handler-bind ((error (lambda (c)
16                                                     (when (eq 'destructuring-bind (car form))
17                                                       (throw 'd-b-error c)))))
18                               (funcall fun form env)))))
19   (macrolet ((error-p (ll)
20                `(progn
21                   (multiple-value-bind (result error) (ignore-errors (eval `(lambda ,',ll 'ok)))
22                     (unless (and (not result) error)
23                       (error "No error from lambda ~S." ',ll)))
24                   (catch 'd-b-error
25                     (eval `(lambda (x) (destructuring-bind ,',ll x 'ok)))
26                     (error "No error from d-b ~S." ',ll)))))
27     (error-p (&aux (foo 1) &aux (bar 2)))
28     (error-p (&aux (foo 1) &key bar))
29     (error-p (&aux (foo 1) &optional bar))
30     (error-p (&aux (foo 1) &rest bar))
31     (error-p (&key foo &allow-other-keys &allow-other-keys))
32     (error-p (&key foo &key bar))
33     (error-p (&key foo &optional bar))
34     (error-p (&key foo &rest bar))
35     (error-p (&optional foo &optional bar))
36     (error-p (&rest foo &rest bar))
37     (error-p (&rest foo &optional bar))))