X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fpprint.impure.lisp;h=5317d7a16892e5a1eb8b0c93473e7158fb18e242;hb=bfa4310e41dcd011ca9d139f29be1c5757b41378;hp=8423f9fdc276abfa1aa2492f9d265f025c125516;hpb=7f029da277c068fd346c5d95303f7e4eeafbdcfc;p=sbcl.git

diff --git a/tests/pprint.impure.lisp b/tests/pprint.impure.lisp
index 8423f9f..5317d7a 100644
--- a/tests/pprint.impure.lisp
+++ b/tests/pprint.impure.lisp
@@ -103,5 +103,47 @@
 	   (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, and not
+;;; rush to coerce them to functions.
+(set-pprint-dispatch '(cons (eql frob)) 'ppd-function-name)
+(defun ppd-function-name (s o)
+  (print (length o) s))
+(let ((s (with-output-to-string (s)
+	   (pprint '(frob a b) s))))
+  (assert (position #\3 s)))
+
 ;;; success
 (quit :unix-status 104)