source: trunk/source/tests/ansi-tests/pprint-tabular.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 4.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Jun 27 06:29:39 2004
4;;;; Contains: Tests of PPRINT-TABULAR
5
6(in-package :cl-test)
7
8;;; When printing a non-list, the result is the same as calling WRITE."
9(deftest pprint-tabular.1
10  (my-with-standard-io-syntax
11   (let ((*print-pretty* t)
12         (*print-readably* nil))
13     (loop for obj in *mini-universe*
14           nconc
15           (and (not (listp obj))
16                (let ((s1 (write-to-string obj))
17                      (s2 (with-output-to-string (s) (pprint-tabular s obj))))
18                  (unless (equal s1 s2)
19                    (list (list obj s1 s2))))))))
20  nil)
21
22(deftest pprint-tabular.2
23  (my-with-standard-io-syntax
24   (let ((*print-pretty* nil)
25         (*print-readably* nil))
26     (loop for obj in *mini-universe*
27           nconc
28           (and (not (listp obj))
29                (let ((s1 (write-to-string obj))
30                      (s2 (with-output-to-string (s) (pprint-tabular s obj))))
31                  (unless (equal s1 s2)
32                    (list (list obj s1 s2))))))))
33  nil)
34
35(defmacro def-pprint-tabular-test (name args expected-value &key (margin 100) (circle nil) (pre nil))
36  `(deftest ,name
37     (my-with-standard-io-syntax
38      (let ((*print-pretty* t)
39            (*print-readably* nil)
40            (*print-right-margin* ,margin)
41            (*package* (find-package :cl-test))
42            (*print-circle* ,circle))
43        (with-output-to-string
44          (s)
45          ,@(when pre (list pre))
46          (pprint-tabular s ,@args))))
47     ,expected-value))
48
49;;;
50;;; Note
51;;; The prefix and suffix "(" and ")" are not considered part of the
52;;; logical block they enclose (see the spec page for pprint-logical-block.
53;;;
54
55(def-pprint-tabular-test pprint-tabular.3 ('(|M|)) "(M)")
56(def-pprint-tabular-test pprint-tabular.4 ('(|M|) t) "(M)")
57(def-pprint-tabular-test pprint-tabular.5 ('(|M|) nil) "M")
58
59(def-pprint-tabular-test pprint-tabular.6 ('(|M| |M|)) "(M               M)")
60(def-pprint-tabular-test pprint-tabular.7 ('(|M| |M|) t nil 1) "(M M)")
61(def-pprint-tabular-test pprint-tabular.8 ('(|M| |M|) t t 3) "(M  M)")
62(def-pprint-tabular-test pprint-tabular.9 ('(|M| |M|) t nil 4) "(M   M)")
63(def-pprint-tabular-test pprint-tabular.10 ('(|MM| |MM|) t nil 4) "(MM  MM)")
64(def-pprint-tabular-test pprint-tabular.11 ('(|MM| |MM|) t nil 5) "(MM   MM)")
65(def-pprint-tabular-test pprint-tabular.12 ('(|M| |MM|) t nil 5)  "(M    MM)")
66
67(def-pprint-tabular-test pprint-tabular.13 ((let ((x (list '|A|))) (list x x)) t nil 1)
68  "(#1=(A) #1#)" :circle t)
69
70(def-pprint-tabular-test pprint-tabular.14 ('(|M| |M|) t t 4) "(M   M)")
71
72(def-pprint-tabular-test pprint-tabular.15 ('(1 2 3 4) t t 1) "(1 2 3 4)")
73(def-pprint-tabular-test pprint-tabular.16 ('(10 20 30 40) t t 1) "(10 20 30 40)")
74(def-pprint-tabular-test pprint-tabular.17 ('(10 200 3000 40000) t t 1) "(10 200 3000 40000)")
75(def-pprint-tabular-test pprint-tabular.18 ('(10 20 30 40) t t 2) "(10  20  30  40)")
76(def-pprint-tabular-test pprint-tabular.19 ('(10 200 3000 40000) t t 2) "(10  200 3000  40000)")
77
78(def-pprint-tabular-test pprint-tabular.20 ('(1 2 3) t nil 1)
79  "     (1 2 3)"
80  :pre (write "     " :stream s :escape nil))
81
82(def-pprint-tabular-test pprint-tabular.21 ('(1 2 3) t nil 1)
83  "     (1
84      2
85      3)"
86  :pre (write "     " :stream s :escape nil) :margin 9)
87
88
89(def-pprint-tabular-test pprint-tabular.22 ('(1 2 3) t nil 1)
90  "     (1 2
91      3)"
92  :pre (write "     " :stream s :escape nil) :margin 10)
93
94;;; Takes T, NIL as stream designators
95
96(deftest pprint-tabular.23
97  (my-with-standard-io-syntax
98   (let ((*print-pretty* nil)
99         (*print-readably* nil)
100         (*print-right-margin* 100))
101     (with-output-to-string
102       (os)
103       (with-input-from-string
104        (is "")
105        (with-open-stream (*terminal-io* (make-two-way-stream is os))
106                          (pprint-tabular t '(1 2 3) t nil 1))))))
107  "(1 2 3)")
108
109(deftest pprint-tabular.24
110  (my-with-standard-io-syntax
111   (let ((*print-pretty* t)
112         (*print-readably* nil)
113         (*print-right-margin* 100))
114     (with-output-to-string (*standard-output*) (pprint-tabular nil '(1 2 3) t nil 1))))
115  "(1 2 3)")
116
117;;; FIXME: add test for colon-p argument of NIL
118
119;;; Test that pprint-tabular returns NIL
120
121(deftest pprint-tabular.return-values.1
122  (my-with-standard-io-syntax
123   (let ((*print-pretty* nil)
124         (*package* (find-package :cl-test)))
125     (with-open-stream (s (make-broadcast-stream))
126                       (pprint-tabular s '(a b)))))
127  nil)
128
129(deftest pprint-tabular.return-values.2
130  (my-with-standard-io-syntax
131   (let ((*print-pretty* nil)
132         (*package* (find-package :cl-test)))
133     (with-open-stream (s (make-broadcast-stream))
134                       (pprint-tabular s 10 nil nil 100))))
135  nil)
136
137;;; Error tests
138
139(deftest pprint-tabular.error.1
140  (signals-error (pprint-tabular) program-error)
141  t)
142
143(deftest pprint-tabular.error.2
144  (signals-error (pprint-tabular *standard-output*) program-error)
145  t)
146
147(deftest pprint-tabular.error.3
148  (signals-error (pprint-tabular *standard-output* nil t nil 1 nil) program-error)
149  t)
150
151(deftest pprint-tabular.error.4
152  (signals-error (pprint-tabular *standard-output* '(a b c) t t 1 nil) program-error)
153  t)
Note: See TracBrowser for help on using the repository browser.