From 87240c0aae3a9ed773a68b1c1654df2ccfa7a126 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Fri, 25 Jun 2004 13:44:14 +0000 Subject: [PATCH] More tests of pprint-dispatch --- ansi-tests/pprint-dispatch.lsp | 57 ++++++++++++++++++++++++++++++++-- 1 file changed, 54 insertions(+), 3 deletions(-) diff --git a/ansi-tests/pprint-dispatch.lsp b/ansi-tests/pprint-dispatch.lsp index f9adb246..544a8a3d 100644 --- a/ansi-tests/pprint-dispatch.lsp +++ b/ansi-tests/pprint-dispatch.lsp @@ -188,10 +188,61 @@ (write-to-string '|Y|))))) "X" nil "ABC" nil "ABC" "DEF") +;;; Funtion designators in pprint-dispatch +(defun pprint-dispatch-test-fn.1 (stream obj) (declare (ignore obj)) (write "ABC" :stream stream)) +(defun pprint-dispatch-test-fn.2 (stream obj) (declare (ignore obj)) (write "DEF" :stream stream)) + +(deftest pprint-dispatch.9 + (my-with-standard-io-syntax + (let ((*print-pprint-dispatch* (copy-pprint-dispatch nil)) + (*print-readably* nil) + (*print-escape* nil) + (*print-pretty* t)) + (values + (write-to-string '|X|) + (multiple-value-list (set-pprint-dispatch '(eql |X|) 'pprint-dispatch-test-fn.1)) + (write-to-string '|X|) + (multiple-value-list (set-pprint-dispatch '(eql |X|) 'pprint-dispatch-test-fn.2)) + (write-to-string '|X|)))) + "X" (nil) "ABC" (nil) "DEF") + +(deftest pprint-dispatch.10 + (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))) + (sym (gensym))) + (setf (symbol-function sym) f) + (values + (write-to-string '|X|) + (set-pprint-dispatch '(eql |X|) sym) + (write-to-string '|X|) + (progn + (setf (symbol-function sym) g) + (write-to-string '|X|)))))) + "X" nil "ABC" "DEF") + +;;; Error tests + +(deftest pprint-dispatch.error.1 + (signals-error (let ((*print-pprint-dispatch* (copy-pprint-dispatch nil))) + (pprint-dispatch)) + program-error) + t) + +(deftest pprint-dispatch.error.2 + (signals-error (let ((*print-pprint-dispatch* (copy-pprint-dispatch nil))) + (pprint-dispatch nil nil nil)) + program-error) + t) - - - -- GitLab