From 39d7b43e2357a2a67e0b19815a87d0da60ba0230 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sat, 3 Jul 2004 14:22:25 +0000 Subject: [PATCH] Added pprint-tabular tests for stream designators, error cases. Fixed *terminal-io* in pprint-fill and pprint-linear tests to be bidirectional. --- ansi-tests/pprint-fill.lsp | 5 ++++- ansi-tests/pprint-linear.lsp | 14 ++++++++----- ansi-tests/pprint-tabular.lsp | 38 +++++++++++++++++++++++++++++++++++ 3 files changed, 51 insertions(+), 6 deletions(-) diff --git a/ansi-tests/pprint-fill.lsp b/ansi-tests/pprint-fill.lsp index 5e586061..0eb1c1eb 100644 --- a/ansi-tests/pprint-fill.lsp +++ b/ansi-tests/pprint-fill.lsp @@ -61,7 +61,10 @@ (let ((*print-pretty* nil) (*print-readably* nil) (*print-right-margin* 100)) - (with-output-to-string (*terminal-io*) (pprint-fill t '(1 2 3))))) + (with-output-to-string + (os) + (with-open-stream (*terminal-io* (make-two-way-stream (make-string-input-stream "") os)) + (pprint-fill t '(1 2 3)))))) "(1 2 3)") (deftest pprint-fill.11 diff --git a/ansi-tests/pprint-linear.lsp b/ansi-tests/pprint-linear.lsp index d8733028..cafec237 100644 --- a/ansi-tests/pprint-linear.lsp +++ b/ansi-tests/pprint-linear.lsp @@ -42,15 +42,16 @@ (let ((*print-pretty* t) (*print-readably* nil) (*print-right-margin* ,margin) + (*package* (find-package "CL-TEST")) (*print-circle* ,circle)) (with-output-to-string (s) (pprint-linear s ,@args)))) ,expected-value)) -(def-pprint-linear-test pprint-linear.3 ('(cl-user::|A|)) "(A)") -(def-pprint-linear-test pprint-linear.4 ('(cl-user::|A|) t) "(A)") -(def-pprint-linear-test pprint-linear.5 ('(cl-user::|A|) nil) "A") +(def-pprint-linear-test pprint-linear.3 ('(|A|)) "(A)") +(def-pprint-linear-test pprint-linear.4 ('(|A|) t) "(A)") +(def-pprint-linear-test pprint-linear.5 ('(|A|) nil) "A") (def-pprint-linear-test pprint-linear.6 ('(1 2 3 4 5)) "(1 2 3 4 5)") (def-pprint-linear-test pprint-linear.7 ('((1) (2) #(3) "abc" 5) nil) "(1) (2) #(3) \"abc\" 5") @@ -65,7 +66,10 @@ (let ((*print-pretty* nil) (*print-readably* nil) (*print-right-margin* 100)) - (with-output-to-string (*terminal-io*) (pprint-linear t '(1 2 3))))) + (with-output-to-string + (os) + (with-open-stream (*terminal-io* (make-two-way-stream (make-string-input-stream "") os)) + (pprint-linear t '(1 2 3)))))) "(1 2 3)") (deftest pprint-linear.11 @@ -126,7 +130,7 @@ nil) ;;; -(def-pprint-linear-test pprint-linear.14 ((let ((x (list 'CL-USER::|A|))) (list x x))) +(def-pprint-linear-test pprint-linear.14 ((let ((x (list '|A|))) (list x x))) "(#1=(A) #1#)" :circle t) ;;; Error tests diff --git a/ansi-tests/pprint-tabular.lsp b/ansi-tests/pprint-tabular.lsp index 71d6ac24..df84201b 100644 --- a/ansi-tests/pprint-tabular.lsp +++ b/ansi-tests/pprint-tabular.lsp @@ -91,6 +91,26 @@ 3)" :pre (write " " :stream s :escape nil) :margin 10) +;;; Takes T, NIL as stream designators + +(deftest pprint-tabular.23 + (my-with-standard-io-syntax + (let ((*print-pretty* nil) + (*print-readably* nil) + (*print-right-margin* 100)) + (with-output-to-string + (os) + (with-open-stream (*terminal-io* (make-two-way-stream (make-string-input-stream "") os)) + (pprint-tabular t '(1 2 3) t nil 1))))) + "(1 2 3)") + +(deftest pprint-tabular.24 + (my-with-standard-io-syntax + (let ((*print-pretty* t) + (*print-readably* nil) + (*print-right-margin* 100)) + (with-output-to-string (*standard-output*) (pprint-tabular nil '(1 2 3) t nil 1)))) + "(1 2 3)") ;;; Test that pprint-tabular returns NIL @@ -109,3 +129,21 @@ (with-open-stream (s (make-broadcast-stream)) (pprint-tabular s 10 nil nil 100)))) nil) + +;;; Error tests + +(deftest pprint-tabular.error.1 + (signals-error (pprint-tabular) program-error) + t) + +(deftest pprint-tabular.error.2 + (signals-error (pprint-tabular *standard-output*) program-error) + t) + +(deftest pprint-tabular.error.3 + (signals-error (pprint-tabular *standard-output* nil t nil 1 nil) program-error) + t) + +(deftest pprint-tabular.error.4 + (signals-error (pprint-tabular *standard-output* '(a b c) t t 1 nil) program-error) + t) -- GitLab