-(let ((*print-pretty* t)
- (*print-circle* t)
- (*print-pprint-dispatch* (copy-pprint-dispatch)))
- (labels ((pprint-a (stream form &rest rest)
- (declare (ignore rest))
- (pprint-logical-block (stream form :prefix "<" :suffix ">")
- (pprint-exit-if-list-exhausted)
- (loop
- (write (pprint-pop) :stream stream)
- (pprint-exit-if-list-exhausted)
- (write-char #\space stream)))))
- (set-pprint-dispatch '(cons (eql a)) #'pprint-a)
- (assert (string= "<A 1 2 3>"
- (with-output-to-string (s)
- (write '(a 1 2 3) :stream s))))
- (assert (string= "#1=<A 1 #1# #2=#(2) #2#>"
- (with-output-to-string (s)
- (write '#2=(a 1 #2# #5=#(2) #5#) :stream s))))
- (assert (string= "#1=(B #2=<A 1 #1# 2 3> #2#)"
- (with-output-to-string (s)
- (write '#3=(b #4=(a 1 #3# 2 3) #4#) :stream s))))))
+(with-test (:name :pprint-circular-detection)
+ (let ((*print-pretty* t)
+ (*print-circle* t)
+ (*print-pprint-dispatch* (copy-pprint-dispatch)))
+ (labels ((pprint-a (stream form &rest rest)
+ (declare (ignore rest))
+ (pprint-logical-block (stream form :prefix "<" :suffix ">")
+ (pprint-exit-if-list-exhausted)
+ (loop
+ (write (pprint-pop) :stream stream)
+ (pprint-exit-if-list-exhausted)
+ (write-char #\space stream)))))
+ (set-pprint-dispatch '(cons (eql a)) #'pprint-a)
+ (assert (string= "<A 1 2 3>"
+ (with-output-to-string (s)
+ (write '(a 1 2 3) :stream s))))
+ (assert (string= "#1=<A 1 #1# #2=#(2) #2#>"
+ (with-output-to-string (s)
+ (write '#2=(a 1 #2# #5=#(2) #5#) :stream s))))
+ (assert (string= "#1=(B #2=<A 1 #1# 2 3> #2#)"
+ (with-output-to-string (s)
+ (write '#3=(b #4=(a 1 #3# 2 3) #4#) :stream s)))))))