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

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

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

File size: 7.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Jul  4 07:17:52 2004
4;;;; Contains: Tests of PPRINT-LOGICAL-BLOCK
5
6(in-package :cl-test)
7
8(deftest pprint-logical-block.1
9  (with-standard-io-syntax
10   (let ((*print-pretty* t)
11         (*print-right-margin* 100)
12         (*print-readably* nil))
13     (with-open-stream
14      (os (make-string-output-stream))
15      (values
16       (multiple-value-list (pprint-logical-block (os 1)))
17       (get-output-stream-string os)))))
18  (nil) "1")
19
20(deftest pprint-logical-block.2
21  (with-standard-io-syntax
22   (let ((*print-pretty* nil)
23         (*print-right-margin* 100)
24         (*print-readably* nil)
25         (val '(1 a (b) (c . d) 1.0s0 2.0f0 -3.0d0 4.0l0 1/2 #(x y z))))
26     (string=t (with-output-to-string (s) (write val :stream s))
27               (with-output-to-string (s) (pprint-logical-block (s val) (write val :stream s))))))
28  t)
29
30(deftest pprint-logical-block.3
31  (with-standard-io-syntax
32   (let ((*print-pretty* nil)
33         (*print-right-margin* 100)
34         (*print-readably* nil))
35     (with-output-to-string
36       (*standard-output*)
37       (pprint-logical-block (nil 1)))))
38  "1")
39
40(deftest pprint-logical-block.4
41  (with-standard-io-syntax
42   (let ((*print-pretty* nil)
43         (*print-right-margin* 100)
44         (*print-readably* nil))
45     (with-output-to-string
46       (os)
47       (with-input-from-string
48        (is "")
49        (with-open-stream (*terminal-io* (make-two-way-stream is os))
50                          (pprint-logical-block (t 1)))))))
51  "1")
52
53(deftest pprint-logical-block.5
54  (with-standard-io-syntax
55   (let ((*print-pretty* t)
56         (*print-right-margin* 100)
57         (*print-readably* nil)
58         (val '(1)))
59     (with-output-to-string
60       (os)
61       (pprint-logical-block
62        (os val)
63        (write (car val) :stream os)))))
64  "1")
65
66(deftest pprint-logical-block.6
67  (with-standard-io-syntax
68   (let ((*print-pretty* t)
69         (*print-right-margin* 100)
70         (*print-readably* nil)
71         (val '(2)))
72     (with-output-to-string
73       (os)
74       (pprint-logical-block
75        (os val :prefix "[" :suffix "]")
76        (write (car val) :stream os)))))
77  "[2]")
78
79(deftest pprint-logical-block.7
80  :notes (:nil-vectors-are-strings)
81  (with-standard-io-syntax
82   (let ((*print-pretty* t)
83         (*print-right-margin* 100)
84         (*print-readably* nil)
85         (val '(3)))
86     (with-output-to-string
87       (os)
88       (pprint-logical-block
89        (os val
90            :prefix (make-array '(0) :element-type nil)
91            :suffix (make-array '(0) :element-type nil))
92        (write (car val) :stream os)))))
93  "3")
94
95(deftest pprint-logical-block.8
96  (with-standard-io-syntax
97   (let ((*print-pretty* t)
98         (*print-right-margin* 100)
99         (*print-readably* nil)
100         (val '(4)))
101     (with-output-to-string
102       (os)
103       (pprint-logical-block
104        (os val
105            :prefix (make-array '(10) :element-type 'character
106                                :initial-contents "abcdefghij"
107                                :fill-pointer 3)
108            :suffix (make-array '(2) :element-type 'base-char
109                                :initial-contents "!?"
110                                :adjustable t))
111        (write (car val) :stream os)))))
112  "abc4!?")
113
114(deftest pprint-logical-block.9
115  (with-standard-io-syntax
116   (let ((*print-pretty* t)
117         (*print-right-margin* 100)
118         (*print-readably* nil)
119         (*print-level* 1)
120         (val '((4))))
121     (with-output-to-string
122       (os)
123       (pprint-logical-block
124        (os val :prefix "{" :suffix "}")
125        (pprint-logical-block
126         (os (car val)  :prefix "[" :suffix "]")
127         (write (caar val) :stream os))))))
128  "{#}")
129
130(deftest pprint-logical-block.10
131  (with-standard-io-syntax
132   (let ((*print-pretty* t)
133         (*print-right-margin* 100)
134         (*print-readably* nil)
135         (*print-level* 0)
136         (val '(5)))
137     (with-output-to-string
138       (os)
139       (pprint-logical-block
140        (os val :prefix "[" :suffix "]")
141        (write (car val) :stream os)))))
142  "#")
143
144(deftest pprint-logical-block.11
145  (with-standard-io-syntax
146   (let ((*print-pretty* t)
147         (*print-right-margin* 100)
148         (*print-readably* nil)
149         (val '(6)))
150     (with-output-to-string
151       (os)
152       (pprint-logical-block
153        (os val :per-line-prefix "abcd")
154        (write (car val) :stream os)))))
155  "abcd6")
156
157(deftest pprint-logical-block.12
158  (with-standard-io-syntax
159   (let ((*print-pretty* t)
160         (*print-right-margin* 100)
161         (*print-readably* nil)
162         (val '(a b c)))
163     (with-output-to-string
164       (os)
165       (pprint-logical-block
166        (os val :per-line-prefix "abcd")
167        (write 1 :stream os)
168        (terpri os)
169        (terpri os)
170        (write 2 :stream os)
171        (terpri os)
172        (write 3 :stream os)))))
173
174  "abcd1
175abcd
176abcd2
177abcd3")
178
179;;; Same as pprint-logical-block.10, but *print-pretty* is bound to nil
180(deftest pprint-logical-block.13
181  (with-standard-io-syntax
182   (let ((*print-pretty* nil)
183         (*print-right-margin* 100)
184         (*print-readably* nil)
185         (*print-level* 0)
186         (val '(5)))
187     (with-output-to-string
188       (os)
189       (pprint-logical-block
190        (os val :prefix "[" :suffix "]")
191        (write (car val) :stream os)))))
192  "#")
193
194;;; Both :suffix and :per-line-prefix may be supplied
195(deftest pprint-logical-block.14
196  (with-standard-io-syntax
197   (let ((*print-pretty* t)
198         (*print-right-margin* 100)
199         (*print-readably* nil)
200         (val '(6)))
201     (with-output-to-string
202       (os)
203       (pprint-logical-block (os val :per-line-prefix "[" :suffix "]")
204                             (write (car val) :stream os)))))
205  "[6]")
206
207;;; Declarations are allowed
208
209(deftest pprint-logical-block.15
210  (with-standard-io-syntax
211   (let ((*print-pretty* t)
212         (x 0))
213     (with-output-to-string
214       (os)
215       (declare (integer x))
216       (declare (optimize (safety 3))))))
217  "")
218
219;;; Two conditions that cause :prefix, :suffix to be omitted
220
221(deftest pprint-logical-block.16
222  (with-standard-io-syntax
223   (let ((*print-pretty* t)
224         (*print-right-margin* 100)
225         (*print-readably* nil)
226         (val 9))
227     (with-output-to-string
228       (os)
229       (pprint-logical-block (os val :prefix "[" :suffix "]")
230                             (write val :stream os)))))
231  "9")
232
233(deftest pprint-logical-block.17
234  (with-standard-io-syntax
235   (let* ((*print-pretty* t)
236          (*print-right-margin* 100)
237          (*print-readably* nil)
238          (*print-circle* t)
239          (v1 '(8))
240          (val (list v1 v1)))
241     (with-output-to-string
242       (os)
243       (pprint-logical-block
244        (os val :prefix "(" :suffix ")")
245        (pprint-logical-block (os (car val) :prefix "(" :suffix ")")
246                              (write (caar val) :stream os))
247        (write-char #\Space os)
248        (pprint-logical-block (os (cadr val) :prefix "(" :suffix ")")
249                              (write (caadr val) :stream os))))))
250  "(#1=(8) #1#)")
251
252;;; Error cases
253
254(deftest pprint-logical-block.error.1
255  (check-type-error #'(lambda (x)
256                        (pprint-logical-block (*standard-output* '(1) :prefix x)))
257                    #'stringp)
258  nil)
259
260(deftest pprint-logical-block.error.1-unsafe
261  (check-type-error #'(lambda (x)
262                        (declare (optimize (safety 0)))
263                        (pprint-logical-block (*standard-output* '(1) :prefix x)))
264                    #'stringp)
265  nil)
266
267(deftest pprint-logical-block.error.2
268  (check-type-error #'(lambda (x)
269                        (pprint-logical-block (*standard-output* '(1) :suffix x)))
270                    #'stringp)
271  nil)
272
273(deftest pprint-logical-block.error.2-unsafe
274  (check-type-error #'(lambda (x)
275                        (declare (optimize (safety 0)))
276                        (pprint-logical-block (*standard-output* '(1) :suffix x)))
277                    #'stringp)
278  nil)
279
280(deftest pprint-logical-block.error.3
281  (check-type-error #'(lambda (x)
282                        (pprint-logical-block (*standard-output* '(1) :per-line-prefix x)))
283                    #'stringp)
284  nil)
285
286(deftest pprint-logical-block.error.3-unsafe
287  (check-type-error #'(lambda (x)
288                        (declare (optimize (safety 0)))
289                        (pprint-logical-block (*standard-output* '(1) :per-line-prefix x)))
290                    #'stringp)
291  nil)
292
293(deftest pprint-logical-block.error.4
294  (signals-error (with-standard-io-syntax
295                  (let ((*print-pretty* t)
296                        (*print-right-margin* 100)
297                        (*print-readably* nil)
298                        (val '(7)))
299                    (pprint-logical-block (os val :prefix "" :per-line-prefix "")
300                                          (write (car val) :stream os))))
301                 error)
302  t)
303
304(deftest pprint-logical-block.error.4-unsafe
305  (signals-error (with-standard-io-syntax
306                  (let ((*print-pretty* t)
307                        (*print-right-margin* 100)
308                        (*print-readably* nil)
309                        (val '(7)))
310                    (pprint-logical-block (os val :prefix "" :per-line-prefix "")
311                                          (write (car val) :stream os))))
312                 error
313                 :safety 0)
314  t)
Note: See TracBrowser for help on using the repository browser.