Skip to content
Snippets Groups Projects
Commit 617f0ae0 authored by pfdietz's avatar pfdietz
Browse files

More tests of pprint-dispatch, set-pprint-dispatch

parent 87f8d549
No related branches found
No related tags found
No related merge requests found
...@@ -53,6 +53,8 @@ ...@@ -53,6 +53,8 @@
nil) nil)
|# |#
;;; Test that setting the pprint dispatch of a symbol causes
;;; the printing to change, and that it can be unset.
(deftest pprint-dispatch.3 (deftest pprint-dispatch.3
(my-with-standard-io-syntax (my-with-standard-io-syntax
(let ((*print-pprint-dispatch* (copy-pprint-dispatch nil)) (let ((*print-pprint-dispatch* (copy-pprint-dispatch nil))
...@@ -70,6 +72,8 @@ ...@@ -70,6 +72,8 @@
(write-to-string '|X|))))) (write-to-string '|X|)))))
"X" nil "ABC" nil "X") "X" nil "ABC" nil "X")
;;; Test that setting the pprint dispatch of a symbol causes
;;; the printing to change for any real weight, and that it can be unset.
(deftest pprint-dispatch.4 (deftest pprint-dispatch.4
(my-with-standard-io-syntax (my-with-standard-io-syntax
(loop for v1 in (remove-if-not #'realp *universe*) (loop for v1 in (remove-if-not #'realp *universe*)
...@@ -92,6 +96,8 @@ ...@@ -92,6 +96,8 @@
collect v1)) collect v1))
nil) nil)
;;; Test that setting the pprint dispatch of a symbol causes
;;; the printing to change, and that it can be unset with any real weight
(deftest pprint-dispatch.5 (deftest pprint-dispatch.5
(my-with-standard-io-syntax (my-with-standard-io-syntax
(loop for v1 in (remove-if-not #'realp *universe*) (loop for v1 in (remove-if-not #'realp *universe*)
...@@ -114,6 +120,8 @@ ...@@ -114,6 +120,8 @@
collect v1)) collect v1))
nil) nil)
;;; Check that specifying the pprint-dispatch table argument to set-pprint-dispatch
;;; causes that table to be changed, not *print-pprint-dispatch*.
(deftest pprint-dispatch.6 (deftest pprint-dispatch.6
(my-with-standard-io-syntax (my-with-standard-io-syntax
(let ((other-ppd-table (copy-pprint-dispatch nil)) (let ((other-ppd-table (copy-pprint-dispatch nil))
...@@ -135,3 +143,55 @@ ...@@ -135,3 +143,55 @@
(set-pprint-dispatch '(eql |X|) nil) (set-pprint-dispatch '(eql |X|) nil)
(write-to-string '|X|))))) (write-to-string '|X|)))))
"X" nil "X" "ABC" nil "ABC" nil "X") "X" nil "X" "ABC" nil "ABC" nil "X")
;;; Test that the default weight of set-pprint-dispatch is 0
(deftest pprint-dispatch.7
(my-with-standard-io-syntax
(let ((*print-pprint-dispatch* (copy-pprint-dispatch nil))
(*print-readably* nil)
(*print-escape* nil)
(*print-pretty* t))
(let ((f #'(lambda (stream obj)
(declare (ignore obj))
(write "ABC" :stream stream)))
(g #'(lambda (stream obj)
(declare (ignore obj))
(write "DEF" :stream stream))))
(values
(write-to-string '|X|)
(set-pprint-dispatch '(eql |X|) f)
(write-to-string '|X|)
(set-pprint-dispatch '(member |X| |Y|) g .0001)
(write-to-string '|X|)
(write-to-string '|Y|)))))
"X" nil "ABC" nil "DEF" "DEF")
(deftest pprint-dispatch.8
(my-with-standard-io-syntax
(let ((*print-pprint-dispatch* (copy-pprint-dispatch nil))
(*print-readably* nil)
(*print-escape* nil)
(*print-pretty* t))
(let ((f #'(lambda (stream obj)
(declare (ignore obj))
(write "ABC" :stream stream)))
(g #'(lambda (stream obj)
(declare (ignore obj))
(write "DEF" :stream stream))))
(values
(write-to-string '|X|)
(set-pprint-dispatch '(eql |X|) f)
(write-to-string '|X|)
(set-pprint-dispatch '(member |X| |Y|) g -.0001)
(write-to-string '|X|)
(write-to-string '|Y|)))))
"X" nil "ABC" nil "ABC" "DEF")
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment