X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fpprint.impure.lisp;h=66efdc151f5a6aaf742d859719dc8eafb3100737;hb=669eaea6857ab6211bfd6c00c7d227f3263200b9;hp=a88e54adad4d26d1609ac3bfc4c24cddf84336b6;hpb=8cd789d3fc2be931ee5c3d31f102616021f7f227;p=sbcl.git

diff --git a/tests/pprint.impure.lisp b/tests/pprint.impure.lisp
index a88e54a..66efdc1 100644
--- a/tests/pprint.impure.lisp
+++ b/tests/pprint.impure.lisp
@@ -135,11 +135,31 @@
 	 (with-output-to-string (s)
 	   (write '`(lambda (,x)) :stream s :pretty t :readably t))
 	 "`(LAMBDA (,X))"))
+;;; more backquote printing brokenness, fixed quasi-randomly by CSR.
+;;; NOTE KLUDGE FIXME: because our backquote optimizes at read-time,
+;;; these assertions, like the ones above, are fragile.  Likewise, it
+;;; is very possible that at some point READABLY printing backquote
+;;; expressions will have to change to printing the low-level conses,
+;;; since the magical symbols are accessible though (car '`(,foo)) and
+;;; friends.  HATE HATE HATE.  -- CSR, 2004-06-10
+(assert (equal
+	 (with-output-to-string (s)
+	   (write '``(foo ,@',@bar) :stream s :pretty t))
+	 "``(FOO ,@',@BAR)"))
+(assert (equal
+	 (with-output-to-string (s)
+	   (write '``(,,foo ,',foo foo) :stream s :pretty t))
+	 "``(,,FOO ,',FOO FOO)"))
+(assert (equal
+	 (with-output-to-string (s)
+	   (write '``(((,,foo) ,',foo) foo) :stream s :pretty t))
+	 "``(((,,FOO) ,',FOO) FOO)"))
 
-;;; SET-PPRINT-DISPATCH should accept function name arguments
+;;; 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))
-(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)))