mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
7697509a0f
There was in fact something wrong with every iteration of the comments over the past 20 years. NS was right to want to make the XEP not appear - XEPs are just the trampolines and showing them would make the function appear twice. However, what actually inhibits the XEPs appearance is always annotating tail-recursive *local calls* as tail, even when it's non-returning, since XEPs local call the actual function. I think people got confused because of these two facets - there's the XEP, as well as the main function. The XEP should always tail-call the main function because we don't want it to show up in the backtrace unless there's an actual error happening within the XEP (think optional processing problems etc). Also remove ALLOW-NON-RETURNING-TAIL-CALL. Not only is the function it was originally written for gone, but it was inherently bogus: It achieved function frame disappearance by making all non-returning calls tail calls, even when they aren't in tail position. If the intention is just to make the function not appear in the backtrace, the debugger already has a facility to do that. Functions that just call error do not need TCO per se, because, well, they aren't going to consume more stack frames and don't need to be fast. Create a macro helper to express the intent more clearly. We also avoid scanning every single node in the component during tail annotation. Also, some non-trivial functions were wrongly annotated with ALLOW-NON-RETURNING-TAIL-CALL, hiding potentially useful local variables. So, don't make those error wrappers.
463 lines
19 KiB
Common Lisp
463 lines
19 KiB
Common Lisp
;;;; lambda-list parsing tests with no side-effects
|
|
|
|
;;;; 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.
|
|
|
|
(let ((*macroexpand-hook*
|
|
(compile nil
|
|
(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 ((maybe-funcall (&rest args)
|
|
;; The interpreters will delay lambda-list checks until
|
|
;; the lambda is actually called.
|
|
(if (eq sb-ext:*evaluator-mode* :compile)
|
|
`(progn ,@args)
|
|
`(funcall ,@args)))
|
|
(error-p (ll)
|
|
`(progn
|
|
(multiple-value-bind (result error)
|
|
(ignore-errors (maybe-funcall (eval `(lambda ,',ll 'ok))))
|
|
(unless (and (not result) error)
|
|
(error "No error from lambda ~S." ',ll)))
|
|
(catch 'd-b-error
|
|
(maybe-funcall
|
|
(eval `(lambda (x) (destructuring-bind ,',ll x 'ok)))
|
|
nil)
|
|
(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))))
|
|
|
|
(with-test (:name :lp1738638)
|
|
;; I really don't like that the name of the keyword to *expect* a failure
|
|
;; is ":allow-failure". It sounds like it's a permission, not a requirement.
|
|
(checked-compile '(lambda (&key ((x) 1)) x) :allow-failure t))
|
|
|
|
(with-test (:name :lp1740756)
|
|
(checked-compile '(lambda () (declare (special 1))) :allow-failure t)
|
|
(checked-compile '(lambda () (declare (special (foo)))) :allow-failure t))
|
|
|
|
(with-test (:name (:lambda-list :supplied-p-order 1))
|
|
(let ((* 10))
|
|
(assert (eql ((lambda (&key (x * *)) () x)) 10))
|
|
(assert (eql ((lambda (&key (y * *) (x *)) () x) :y 1) t))
|
|
(assert (eql ((lambda (&key (x *) (y * *)) () x) :y 1) 10))
|
|
|
|
(assert (eql (destructuring-bind (&key (x * *)) () x) 10))
|
|
(assert (eql (destructuring-bind (&key (y * *) (x *)) '(:y 1) x) t))
|
|
(assert (eql (destructuring-bind (&key (x *) (y * *)) '(:y 1) x) 10))
|
|
|
|
(assert (eql ((lambda (&optional (x * *)) () x)) 10))
|
|
(assert (eql ((lambda (&optional (y * *) (x *)) () x) 1) t))
|
|
(assert (eql ((lambda (&optional (x *) (y * *)) () x)) 10))
|
|
|
|
(assert (eql (destructuring-bind (&optional (x * *)) () x) 10))
|
|
(assert (eql (destructuring-bind (&optional (y * *) (x *)) '(1) x) t))
|
|
(assert (eql (destructuring-bind (&optional (x *) (y * *)) () x) 10))))
|
|
|
|
(with-test (:name (:lambda-list :supplied-p-order 2))
|
|
(checked-compile '(lambda ()
|
|
(destructuring-bind (&optional (x nil xp)) '()
|
|
(declare (ignore x xp))
|
|
nil))))
|
|
|
|
(with-test (:name :aux-not-destructured)
|
|
(assert-error (sb-c::parse-lambda-list
|
|
'(a &aux ((foo)))
|
|
:context 'destructuring-bind
|
|
:accept (sb-int:lambda-list-keyword-mask 'destructuring-bind))))
|
|
|
|
(with-test (:name :exact-unparse)
|
|
(labels ((round-trip (list)
|
|
(multiple-value-bind (llks req opt rest keys aux)
|
|
(sb-c::parse-lambda-list
|
|
list
|
|
:accept (sb-c::lambda-list-keyword-mask 'destructuring-bind)
|
|
:context 'destructuring-bind)
|
|
(sb-c::make-lambda-list llks nil req opt rest keys aux)))
|
|
(try (list)
|
|
(assert (equal list (round-trip list)))))
|
|
(try '(a b . c))
|
|
(try '(a b &rest r))
|
|
(try '(a b &body b))
|
|
(try '(a b &body b &key foo))))
|
|
|
|
(with-test (:name :fun-type-from-lambda-list)
|
|
(assert (equal
|
|
(sb-c::type-specifier
|
|
(sb-c::ftype-from-lambda-list
|
|
'(&key (size 1) color ((secret foo) 3 ssp) ((:what baz) nil)
|
|
&allow-other-keys)))
|
|
'(function (&key (:size t) (:color t) (secret t) (:what t)
|
|
&allow-other-keys) *))))
|
|
|
|
;; CLHS 3.4.4 says
|
|
;; "&whole is followed by a single variable that is bound to the entire
|
|
;; macro-call form; this is the value that the macro function receives
|
|
;; as its first argument."
|
|
;;
|
|
;; but 3.4.4.1.2 says
|
|
;; "&whole - The next element is a destructuring pattern that matches
|
|
;; the entire form in a macro, or the entire subexpression at inner levels."
|
|
;;
|
|
;; So one paragraph says "a single variable" and the other "a pattern".
|
|
;;
|
|
;; If it can be a pattern, then it constrains the expected shape of input
|
|
;; in a way that can conflict with the remainder of the pattern.
|
|
;; e.g. Given (FOO (&WHOLE (BAZ BAR) X &OPTIONAL Y) MUM), would the
|
|
;; outer list's second element need to be a list that matches both
|
|
;; (BAZ BAR) and (X &OPTIONAL Y)? Implementations disagree on this.
|
|
;;
|
|
;; Further 3.4.4 says "&whole can appear at any level of a macro
|
|
;; lambda list. At inner levels, the &whole variable is bound to the
|
|
;; corresponding part of the argument, as with &rest, but unlike &rest,
|
|
;; other arguments are also allowed."
|
|
;; This makes a strange implication that "&rest" does NOT allow
|
|
;; "other arguments", when clearly &REST can be followed by &KEY and
|
|
;; &AUX (if it means "formal" arguments), and followed by anything at
|
|
;; all if it means "actual" arguments. So it's not obvious from this
|
|
;; how &whole is supposed to be "unlike" &rest.
|
|
;;
|
|
;; And finally
|
|
;; "The use of &whole does not affect the pattern of arguments specified."
|
|
;; which is is inconsistent in the case where you write
|
|
;; (&WHOLE (A B) ...) which certainly seems to require that the whole
|
|
;; form be exactly a 2-list. What it was trying to clarify - reasonably
|
|
;; in the case where &whole binds one symbol - is that
|
|
;; (DEFMACRO MUMBLE (&WHOLE FOO) ...)
|
|
;; in terms of the pattern accepted, is exactly the same as
|
|
;; (DEFMACRO MUMBLE () ...)
|
|
;; which means that MUMBLE accepts zero arguments.
|
|
;; This is a justified point because the equivalence of &WHOLE
|
|
;; and &REST at inner levels suggests that (&WHOLE FOO) actually means that
|
|
;; MUMBLE accepts anything when in fact it does not.
|
|
;;
|
|
;; To resolve these problems, we'll say that &WHOLE at the outermost level
|
|
;; of a macro can only bind one symbol, which fits the mental model that it
|
|
;; receives the input form and nothing but that.
|
|
;; Whoever uses &WHOLE with a non-symbol after it deserves a kick in the head.
|
|
|
|
(with-test (:name :destructuring-whole)
|
|
(let* ((accept-inner
|
|
(sb-int:lambda-list-keyword-mask 'destructuring-bind))
|
|
(accept-outer
|
|
(logior (sb-int:lambda-list-keyword-mask '&environment)
|
|
accept-inner)))
|
|
(sb-c::parse-lambda-list '(&whole w a b x) :accept accept-outer)
|
|
(sb-c::parse-lambda-list '(&whole (w) a b x) :accept accept-inner)
|
|
(assert-error
|
|
(sb-c::parse-lambda-list '(&whole 5 a b x) :accept accept-outer))
|
|
(assert-error
|
|
(sb-c::parse-lambda-list '(&whole (w) a b x) :accept accept-outer))))
|
|
|
|
;; Unparsing a destructuring lambda list does not retain default values,
|
|
;; supplied-p variables, or &AUX.
|
|
;; This has a practical benefit of not saving source code unwittingly
|
|
;; in (X &OPTIONAL (A (MOAR-BIG-FN (DO-ALL-THE-THINGS (...)))))
|
|
;; as well as showing just what the lambda list expects as an interface.
|
|
(with-test (:name :destructuring-parse/unparse)
|
|
(flet ((try (input &optional (expect input))
|
|
(let ((parse (sb-c::parse-ds-lambda-list input)))
|
|
(assert (equal (sb-c::unparse-ds-lambda-list parse) expect)))))
|
|
|
|
(try '((a (b c)) . d)) ; parse/unparse undergoes no change
|
|
|
|
(try '(a &optional ((&optional)))) ; likewise
|
|
|
|
(try '(&optional . rest)) ; ... and even wackier
|
|
|
|
(try '(a (&rest foo) (&whole baz x y))
|
|
'(a (&rest foo) (x y)))
|
|
|
|
(try '((&body foo) (&whole (a . d) x y) &aux)
|
|
'((&body foo) (&whole (a . d) x y)))
|
|
|
|
(try '(&optional a ((bb1 bb2) (f)) (c 'c) (d 'd dsp) &aux foo (baz))
|
|
'(&optional a ((bb1 bb2)) (c) (d)))
|
|
|
|
(try '(&key ((:bork (zook mook)) def bsp) (e 'e esp)
|
|
((:name fred)) (color x csp))
|
|
'(&key ((:bork (zook mook))) (e) ((:name fred)) (color)))
|
|
|
|
(try '(x &optional (y) (((&whole (&whole w z . r) &body b) (c)) (def)))
|
|
;; ^ this &WHOLE variable is irrelevant
|
|
;; ^ but this one isn't
|
|
'(x &optional (y) (((&whole (z . r) &body b) (c)))))
|
|
|
|
;; Expanding a ds-bind of (((X))) re-conses the innermost list
|
|
;; list thrice, to generate code which produces three distinct
|
|
;; messages: "problem in (((X)))", "... in ((X))", "... in (X)"
|
|
;; This isn't great. Ideally the code should entail at most one
|
|
;; error message, but in general it's not easy to have a single point
|
|
;; at which the error is signaled, if you must already have pulled apart
|
|
;; the input to find the error. Thus, ds-bind expands into a sequence
|
|
;; of checks whether at each level, the structure is right.
|
|
;; In this limited case, it seems a particularly stupid technique.
|
|
;;
|
|
;; At any rate, the unparser memoizes intermediate results,
|
|
;; since the cost of doing that is virtually nothing.
|
|
;; This asserts that sharing works during re-construction.
|
|
(let ((parse (sb-c::parse-ds-lambda-list '(((a)))))
|
|
(cache (list nil)))
|
|
(assert (eq (sb-c::unparse-ds-lambda-list parse :cache cache)
|
|
(sb-c::unparse-ds-lambda-list parse :cache cache))))))
|
|
|
|
(with-test (:name :macro-lambda-list)
|
|
;; This only parses the surface level, which suffices to check for
|
|
;; some edge cases at the toplevel of a macro lambda list.
|
|
(flet ((parse (list)
|
|
sb-c::
|
|
(multiple-value-list
|
|
(parse-lambda-list
|
|
list :accept (logior (lambda-list-keyword-mask 'destructuring-bind)
|
|
(lambda-list-keyword-mask '&environment))))))
|
|
;; The bitmasks of lambda-list-keywords differ, so don't compare them.
|
|
(assert (equal (cdr (parse '(&environment e &rest rest)))
|
|
(cdr (parse '(&environment e . rest)))))
|
|
(assert (equal (cdr (parse '(&whole w &rest r)))
|
|
(cdr (parse '(&whole w . r)))))
|
|
(assert (equal (cdr (parse '(&whole w &environment e &rest r)))
|
|
(cdr (parse '(&whole w &environment e . r)))))
|
|
(assert (equal (cdr (parse '(a b c &environment foo &rest rest)))
|
|
(cdr (parse '(a b c &environment foo . rest)))))
|
|
(assert (equal (cdr (parse '(a b c &environment foo &body rest)))
|
|
(cdr (parse '(a b c &environment foo . rest)))))
|
|
(assert-error (parse '(a b c &environment foo &rest r . rest)))
|
|
|
|
;; lp# 707556
|
|
(assert-error (parse '(a &key b &allow-other-keys c)))))
|
|
|
|
(with-test (:name :ds-lambda-list-symbols)
|
|
(flet ((try (list expect)
|
|
(assert (equal sb-c::(ds-lambda-list-variables
|
|
(parse-ds-lambda-list list))
|
|
expect))))
|
|
(try '(a ((b c))
|
|
&rest (r1 r2)
|
|
&key k1 (k2) (k3 'foo) (k4 'baz k4p) ((:boo (k5 k6)) '(1 2) k56p))
|
|
'(a b c r1 r2 k1 k2 k3 k4 k4p k5 k6 k56p))
|
|
|
|
(try '(a &optional x (y) (z 'foo zp) ((w1 w2) (f)) &aux foo (bar) (baz 3))
|
|
'(a x y z zp w1 w2 foo bar baz))))
|
|
|
|
(with-test (:name :ds-lambda-list-possible-mismatch-warning)
|
|
(assert-signal (sb-c::parse-ds-lambda-list '(a &optional ((b c) 'foo)))
|
|
style-warning)
|
|
;; Suppose this meant: one required arg followed by one optional arg
|
|
;; which is a list of one required and one optional arg.
|
|
;; But it's accidentally missing a pair of disambiguating parentheses.
|
|
(assert-signal (sb-c::parse-ds-lambda-list '(a &optional (b &optional c)))
|
|
style-warning)
|
|
;; Similarly...
|
|
(assert-signal (sb-c::parse-ds-lambda-list '(a &optional (b c &key)))
|
|
style-warning))
|
|
|
|
(with-test (:name (destructuring-bind :list-checkers))
|
|
(labels ((gen-check (lambda-list macro-context)
|
|
(sb-c::emit-ds-bind-check (sb-c::parse-ds-lambda-list lambda-list)
|
|
:ignore macro-context nil))
|
|
(try (winp lambda-list input)
|
|
(let ((check (gen-check lambda-list nil)))
|
|
(if winp
|
|
(apply (car check) input (cddr check))
|
|
(assert-error (apply (car check) input (cddr check)))))))
|
|
(try t '(a b . rest) '(1 2))
|
|
(try t '(a b . rest) '(1 2 3))
|
|
(try t '(a b . rest) '(1 2 . foo))
|
|
(try nil '(a b . rest) '(1))
|
|
(try t '(a &optional b . rest) '(1 2))
|
|
(try nil '(a &key b) '(1 :b)) ; odd
|
|
(try nil '(a &key b) '(1 :b . bar)) ; dotted
|
|
(try nil '(a &key b) '(1 :b bar . baz)) ; dotted
|
|
(try t '(a &key b) '(1 :b bar :allow-other-keys nil))
|
|
|
|
(let ((check (gen-check '(bar &key ((secret v)))
|
|
'(:macro whatever . define-compiler-macro))))
|
|
(apply (car check) '(a secret 3) (cddr check))
|
|
(assert-signal (apply (car check) '(a secret 3) (cddr check))
|
|
sb-c::compiler-macro-keyword-problem))))
|
|
|
|
;; The same lambda lists and test inputs are each run two different ways.
|
|
(macrolet ((with-test-ll ((name lambda-list) &body body)
|
|
`(with-test (:name (destructuring-bind :shape ,name))
|
|
(let ((fun
|
|
(lambda (args)
|
|
(sb-int:binding*
|
|
,(sb-c::expand-ds-bind lambda-list 'args nil 'the)
|
|
(list ,@(sb-c::ds-lambda-list-variables
|
|
(sb-c::parse-ds-lambda-list lambda-list))))))
|
|
(ast (sb-c::meta-abstractify-ds-lambda-list
|
|
(sb-c::parse-ds-lambda-list ',lambda-list))))
|
|
,@body)))
|
|
(win (x &optional expect)
|
|
`(progn (assert (sb-c::ds-lambda-list-match-p ,x ast))
|
|
,(if expect
|
|
`(assert (equal (funcall fun ,x) ,expect))
|
|
`(funcall fun ,x)))) ; don't crash is all
|
|
(lose (x)
|
|
`(progn (assert (not (sb-c::ds-lambda-list-match-p ,x ast)))
|
|
(assert-error (funcall fun ,x)))))
|
|
|
|
(with-test-ll (:want-0-args ()) ; this only allows NIL as its input
|
|
(win '())
|
|
(lose 'foo)
|
|
(lose '(a)))
|
|
|
|
(with-test-ll (:want-1-arg (a))
|
|
(lose '())
|
|
(lose 'foo)
|
|
(win '(a))
|
|
(lose '(a . b))
|
|
(lose '(a b)))
|
|
|
|
(with-test-ll (:want-1-or-2-args (a &optional b))
|
|
(lose '())
|
|
(lose 'foo)
|
|
(win '(a))
|
|
(lose '(a . b))
|
|
(win '(a b))
|
|
(lose '(a b . c))
|
|
(lose '(a b c)))
|
|
|
|
(with-test-ll (:want-3-args (a b c))
|
|
(lose '())
|
|
(lose '(a))
|
|
(lose '(a b))
|
|
(lose '(a b . c))
|
|
(win '(a b c))
|
|
(lose '(a b c . d))
|
|
(lose '(a b c d)))
|
|
|
|
(with-test-ll (:want-3-or-4-args (a b c &optional d))
|
|
(lose '())
|
|
(lose '(a))
|
|
(lose '(a b))
|
|
(lose '(a b . c))
|
|
(win '(a b c))
|
|
(lose '(a b c . d))
|
|
(win '(a b c d))
|
|
(lose '(a b c d . e))
|
|
(lose '(a b c d ee)))
|
|
|
|
(with-test-ll (:want-3-or-more-args (a b c &optional d . r))
|
|
(lose '())
|
|
(lose '(a))
|
|
(lose '(a b))
|
|
(lose '(a b . c))
|
|
(win '(a b c))
|
|
(lose '(a b c . d))
|
|
(win '(a b c d))
|
|
(win '(a b c d . e))
|
|
(win '(a b c d ee)))
|
|
|
|
(with-test-ll (:destructured-rest (a b &rest (c d)))
|
|
(lose '())
|
|
(lose '(a b))
|
|
(lose '(a b . c))
|
|
(lose '(a b c . d))
|
|
(win '(a b c d))
|
|
(lose '(a b c d . e))
|
|
(lose '(a b c d ee)))
|
|
|
|
(with-test-ll (:hairy-1 ((a) ((b . c)) &optional ((x y) '(vx vy))))
|
|
(win '((1) ((2 . whatever)) (3 4)))
|
|
(win '((1) ((2 . whatever)) (3 4)))
|
|
(lose '((1) ((2)) (3))))
|
|
|
|
(with-test-ll (:hairy-2 ((a) ((b . c)) &optional ((x &optional y) '(f))))
|
|
(win '((1) ((2 . whatever)) (3)))
|
|
(win '((1) ((2 . whatever))))
|
|
(lose '((1) ((2 . whatever)) 3)))
|
|
|
|
;; This destructuring &WHOLE pattern demands at least 2 args,
|
|
;; despite that the containing pattern otherwise accepts 0 or more.
|
|
(with-test-ll (:destructured-whole (&whole (a b . c) &optional x &rest y))
|
|
(lose '())
|
|
(lose '(a))
|
|
(lose '(a . b))
|
|
(win '(a b))
|
|
(win '(a b c)))
|
|
|
|
(with-test-ll (:destructured-key (a b &rest r
|
|
&key ((:point (x y &optional z))
|
|
(list 'foo 'bar))))
|
|
(lose '(a b . foo))
|
|
(win '(a b :point (1 2)))
|
|
(lose '(a b :point (1 2 . 3)))
|
|
(win '(a b :point (1 2 3)))
|
|
(lose '(a b :point (1 2 3 4)))
|
|
(lose '(a b :point (1 2 3) :baz 9))
|
|
(win '(a b :point (1 2 3) :baz 9 :allow-other-keys t))
|
|
(win '(a b :point (1 2 3) :baz 9 :allow-other-keys t
|
|
:allow-other-keys nil)))
|
|
|
|
;; This bizarro lambda lists expects that if you give the :FRUITS keyword,
|
|
;; then its value is NIL, because it has to match a lambda list that
|
|
;; accepts exactly zero required arguments, zero optionals, and no &REST.
|
|
(with-test-ll (:fruity (&key ((:fruits (&optional)))))
|
|
(win '())
|
|
(lose 'a)
|
|
(lose '(a))
|
|
(lose '(a . b))
|
|
(lose '(:fruits))
|
|
(lose '(:fruits 3))
|
|
(lose '(:fruits (3)))
|
|
(win '(:fruits nil)))
|
|
|
|
;; Test an EXPAND-DS-BIND that is hairier than you should ever write.
|
|
(with-test-ll (:insane-hair
|
|
((a ((b) &key)) &optional (((c &rest r)) '((wat)) csp)
|
|
&aux (bork 'end)))
|
|
(win '((1 ((2)))) '(1 2 wat nil nil end))
|
|
(win '((1 ((2) :size 3 :allow-other-keys t)))
|
|
'(1 2 wat nil nil end))
|
|
(win '((1 ((2))) ((3 . more))) '(1 2 3 more t end))
|
|
(lose '((1 ((2 3)))))
|
|
(lose '((1 ((2) 3))))
|
|
(lose '((1 ((2)) 3)))
|
|
(lose '((1 ((2))) wat))
|
|
(lose '((1 ((2))) (wat))))
|
|
|
|
;; () as nested destructuring lambda list.
|
|
(with-test-ll (:nil-as-nested-ds-lambda-list (a () b))
|
|
(win '(1 () 3) '(1 3))
|
|
(lose '(1 2))
|
|
(lose '(1 2 3))
|
|
(lose '(1 (2) 3))))
|
|
|
|
(with-test (:name :destructuring-optional/key-warn-once-only)
|
|
(let ((count 0))
|
|
(handler-bind ((warning (lambda (c) (incf count) (muffle-warning c))))
|
|
(macroexpand-1
|
|
'(defmacro defx (name ll &optional (types '*) &key node) 1)))
|
|
(assert (= count 1))))
|
|
|
|
(with-test (:name :silent-pcl-internals)
|
|
(assert-no-signal
|
|
(sb-int:parse-lambda-list
|
|
'(sb-pcl::.pv. sb-pcl::.next-method-call. self &optional o &key k
|
|
&allow-other-keys))))
|
|
|
|
(with-test (:name :macro-nested-&key-defaults)
|
|
(assert (equal (sb-kernel:%fun-lambda-list (macro-function (eval `(defmacro ,(gensym) ((&key (x 7))) x))))
|
|
'((&key (x 7))))))
|