X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fpprint.impure.lisp;h=a88e54adad4d26d1609ac3bfc4c24cddf84336b6;hb=cd13034f9415f64cdaa05893a4ac5ff1e95c97bd;hp=ee1f91a70a02c10c4f20b8d19eacc02261a178cf;hpb=2768ed83de59354b21ea61de3dea358c53d1ae05;p=sbcl.git diff --git a/tests/pprint.impure.lisp b/tests/pprint.impure.lisp index ee1f91a..a88e54a 100644 --- a/tests/pprint.impure.lisp +++ b/tests/pprint.impure.lisp @@ -88,6 +88,61 @@ ;2~%~ ;3x")))) +;;; bug 141b: not enough care taken to disambiguate ,.FOO and ,@FOO +;;; from , .FOO and , @FOO +(assert (equal + (with-output-to-string (s) + (write '`(, .foo) :stream s :pretty t :readably t)) + "`(, .FOO)")) +(assert (equal + (with-output-to-string (s) + (write '`(, @foo) :stream s :pretty t :readably t)) + "`(, @FOO)")) +(assert (equal + (with-output-to-string (s) + (write '`(, ?foo) :stream s :pretty t :readably t)) + "`(,?FOO)")) +;;; bug reported by Paul Dietz on sbcl-devel: unquoted lambda lists +;;; were leaking the SB-IMPL::BACKQ-COMMA implementation. +(assert (equal + (with-output-to-string (s) + (write '`(foo ,x) :stream s :pretty t :readably t)) + "`(FOO ,X)")) +(assert (equal + (with-output-to-string (s) + (write '`(foo ,@x) :stream s :pretty t :readably t)) + "`(FOO ,@X)")) +#+nil ; '`(foo ,.x) => '`(foo ,@x) apparently. +(assert (equal + (with-output-to-string (s) + (write '`(foo ,.x) :stream s :pretty t :readably t)) + "`(FOO ,.X)")) +(assert (equal + (with-output-to-string (s) + (write '`(lambda ,x) :stream s :pretty t :readably t)) + "`(LAMBDA ,X)")) +(assert (equal + (with-output-to-string (s) + (write '`(lambda ,@x) :stream s :pretty t :readably t)) + "`(LAMBDA ,@X)")) +#+nil ; see above +(assert (equal + (with-output-to-string (s) + (write '`(lambda ,.x) :stream s :pretty t :readably t)) + "`(LAMBDA ,.X)")) +(assert (equal + (with-output-to-string (s) + (write '`(lambda (,x)) :stream s :pretty t :readably t)) + "`(LAMBDA (,X))")) + +;;; SET-PPRINT-DISPATCH should accept function name arguments +(defun ppd-function-name (s o) + (print (length o) s)) +(set-pprint-dispatch '(cons (eql frob)) 'ppd-function-name) +(let ((s (with-output-to-string (s) + (pprint '(frob a b) s)))) + (assert (position #\3 s))) + ;;; success (quit :unix-status 104)