source: trunk/source/tests/ansi-tests/pprint-newline.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: 9.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Wed Jul  7 07:48:01 2004
4;;;; Contains: Tests of PPRINT-NEWLINE
5
6(in-package :cl-test)
7
8(compile-and-load "printer-aux.lsp")
9
10(defmacro def-pprint-newline-test (name form expected-value &rest key-args)
11  `(def-pprint-test ,name
12     (with-output-to-string
13       (*standard-output*)
14       (pprint-logical-block (*standard-output* nil) ,form))
15     ,expected-value
16     ,@key-args))
17
18;;; NIL designates the standard output
19
20(def-pprint-test pprint-newline.1
21  (with-output-to-string
22    (*standard-output*)
23    (pprint-logical-block
24     (*standard-output* nil)
25     (dotimes (i 8)
26       (write-char #\A)
27       (write-char #\Space)
28       (pprint-newline :fill nil))))
29  "A A A A A
30A A A "
31  :margin 10)
32
33;;; T designates the stream *terminal-io*
34(def-pprint-test pprint-newline.2
35  (with-output-to-string
36    (os)
37    (with-input-from-string
38     (is "")
39     (with-open-stream
40      (*terminal-io* (make-two-way-stream is os))
41      (pprint-logical-block
42       (*terminal-io* nil)
43       (dotimes (i 8)
44         (write "A " :stream t)
45         (pprint-newline :fill t))))))
46  "A A A A A
47A A A "
48  :margin 10)
49
50;;; No stream is standard output
51
52(def-pprint-test pprint-newline.3
53  (with-output-to-string
54    (*standard-output*)
55    (pprint-logical-block
56     (*standard-output* nil)
57     (dotimes (i 8)
58       (write-char #\A)
59       (write-char #\Space)
60       (pprint-newline :fill))))
61  "A A A A A
62A A A "
63  :margin 10)
64
65;;; :linear
66
67(def-ppblock-test pprint-newline.linear.1
68  (progn
69   (dotimes (i 2) (write "A ") (pprint-newline :fill))
70   (write "B ") (pprint-newline :linear)
71   (dotimes (i 3) (write "A ") (pprint-newline :fill)))
72  "A A B
73A A A "
74  :margin 10)
75
76(def-ppblock-test pprint-newline.linear.2
77  (progn
78   (dotimes (i 2) (write "A ") (pprint-newline :fill))
79   (write "B ") (pprint-newline :linear)
80   (dotimes (i 2) (write "C ") (pprint-newline :fill))
81   (write "D ") (pprint-newline :linear)
82   (dotimes (i 3) (write "A ") (pprint-newline :fill)))
83  "A A B
84C C D
85A A A "
86  :margin 10)
87
88(def-ppblock-test pprint-newline.linear.3
89  (dotimes (i 4) (write "A ") (pprint-newline :linear))
90  "A A A A "
91  :margin 10)
92
93(def-ppblock-test pprint-newline.linear.4
94  (dotimes (i 4) (write "A ") (pprint-newline :linear))
95  "A A A A "
96  :margin 10
97  :miser 10)
98
99(def-ppblock-test pprint-newline.linear.5
100  (dotimes (i 10) (write "A ") (pprint-newline :linear))
101  "A A A A A A A A A A "
102  :margin 10
103  :pretty nil)
104
105(def-ppblock-test pprint-newline.linear.6
106  (dotimes (i 4) (write "A             ") (pprint-newline :linear))
107  "A
108A
109A
110A
111"
112  :margin 10)
113
114(def-ppblock-test pprint-newline.linear.7
115  (progn
116    (dotimes (i 4) (write "A ") (pprint-newline :linear))
117    (terpri)
118    (dotimes (i 4) (write "A ") (pprint-newline :linear)))
119  "A
120A
121A
122A
123
124A
125A
126A
127A
128"
129  :margin 10)
130
131(def-ppblock-test pprint-newline.linear.8
132  (progn
133    (pprint-logical-block (*standard-output* nil)
134                          (dotimes (i 4)
135                            (write "A ")
136                            (pprint-newline :linear)))
137    (pprint-newline :linear)
138    (pprint-logical-block (*standard-output* nil)
139                          (dotimes (i 4)
140                            (write "A ")
141                            (pprint-newline :linear))))
142  "A A A A
143A A A A "
144  :margin 10)
145   
146(def-ppblock-test pprint-newline.linear.9
147  (dotimes (i 10) (write "A ") (let ((*print-pretty* nil)) (pprint-newline :linear)))
148  "A A A A A A A A A A "
149  :margin 10)
150
151(deftest pprint-newline.linear.10
152  (with-standard-io-syntax
153   (let ((*print-readably* nil)
154         (*print-escape* nil)
155         (*print-pretty* t)
156         (*print-right-margin* 4)
157         (*print-miser-width* nil))
158     (with-output-to-string
159       (*standard-output*)
160       (dotimes (i 5) (write "A ") (pprint-newline :linear)))))
161  "A A A A A ")
162
163;;; :miser
164
165(def-ppblock-test pprint-newline.miser.1
166  (dotimes (i 10) (write "A ") (pprint-newline :miser))
167  "A A A A A A A A A A "
168  :margin 10)
169
170(def-ppblock-test pprint-newline.miser.2
171  (dotimes (i 10) (write "A ") (pprint-newline :miser))
172  "A A A A A A A A A A "
173  :margin 10
174  :miser 0)
175
176(def-ppblock-test pprint-newline.miser.3
177  (dotimes (i 10) (write "A ") (pprint-newline :miser))
178  "A A A A A A A A A A "
179  :margin 10
180  :miser 9)
181
182(def-ppblock-test pprint-newline.miser.4
183  (dotimes (i 10) (write "A ") (pprint-newline :miser))
184  "A
185A
186A
187A
188A
189A
190A
191A
192A
193A
194"
195  :margin 10
196  :miser 10)
197
198(def-ppblock-test pprint-newline.miser.5
199  (dotimes (i 10) (write "A ") (pprint-newline :miser))
200  "A A A A A A A A A A "
201  :margin 10
202  :miser 10
203  :pretty nil)
204
205(def-ppblock-test pprint-newline.miser.6
206  (progn
207    (terpri)
208    (write "A")
209    (pprint-newline :miser))
210  "
211A
212"
213  :margin 20
214  :miser 20)
215
216(def-ppblock-test pprint-newline.miser.7
217  (progn
218    (pprint-newline :miser)
219    (write "A")
220    (terpri))
221  "
222A
223"
224  :margin 20
225  :miser 20)
226
227(def-ppblock-test pprint-newline.miser.8
228  (progn
229    (write "AAAA ")
230    (pprint-newline :linear)
231    (pprint-logical-block
232     (*standard-output* nil)
233     (dotimes (i 4) (write "A ") (pprint-newline :miser))))
234  "AAAA
235A A A A "
236  :margin 10
237  :miser 8)
238
239(def-ppblock-test pprint-newline.miser.9
240  (progn
241    (write "AAAA ")
242    (pprint-newline :fill)
243    (pprint-logical-block
244     (*standard-output* nil)
245     (dotimes (i 4) (write "A ") (pprint-newline :miser))))
246  "AAAA
247A A A A "
248  :margin 10
249  :miser 8)
250
251(def-ppblock-test pprint-newline.miser.10
252  (pprint-logical-block (*standard-output* nil :prefix "(" :suffix ")")
253                        (write "A")
254                        (pprint-newline :miser)
255                        (pprint-newline :mandatory))
256  "(A
257
258 )"
259  :margin 20
260  :miser 20)
261
262(def-ppblock-test pprint-newline.miser.11
263  (pprint-logical-block (*standard-output* nil :prefix "(" :suffix ")")
264                        (write "A")
265                        (pprint-newline :miser)
266                        (pprint-newline :mandatory))
267  "(A
268
269 )"
270  :margin 20
271  :miser 19)
272
273(def-ppblock-test pprint-newline.miser.12
274  (pprint-logical-block (*standard-output* nil :prefix "(" :suffix ")")
275                        (write "A")
276                        (pprint-newline :miser)
277                        (pprint-newline :mandatory))
278  "(A
279 )"
280  :margin 20
281  :miser 18)
282
283(deftest pprint-newline.miser.13
284  (with-standard-io-syntax
285   (let ((*print-readably* nil)
286         (*print-escape* nil)
287         (*print-pretty* t)
288         (*print-right-margin* 4)
289         (*print-miser-width* 4))
290     (with-output-to-string
291       (*standard-output*)
292       (dotimes (i 5) (write "A ") (pprint-newline :miser)))))
293  "A A A A A ")
294
295;;; :fill
296
297(def-ppblock-test pprint-newline.fill.1
298  (dotimes (i 10) (write "A ") (pprint-newline :fill))
299  "A A A A A
300A A A A A "
301  :margin 10)
302
303(def-ppblock-test pprint-newline.fill.2
304  (dotimes (i 10) (write "A ") (pprint-newline :fill))
305  "A A A
306A A A
307A A A
308A "
309  :margin 6)
310
311(def-ppblock-test pprint-newline.fill.3
312  (dotimes (i 10) (write "A ") (pprint-newline :fill))
313  "A A A
314A A A
315A A A
316A "
317  :margin 7)
318
319(def-ppblock-test pprint-newline.fill.4
320    (dotimes (i 10) (write "A ") (pprint-newline :fill))
321  "A A A A A
322A A A A A "
323  :margin 10
324  :miser 9)
325
326(def-ppblock-test pprint-newline.fill.5
327    (dotimes (i 10) (write "A ") (pprint-newline :fill))
328  "A
329A
330A
331A
332A
333A
334A
335A
336A
337A
338"
339  :margin 10
340  :miser 10)
341
342(def-ppblock-test pprint-newline.fill.6
343    (dotimes (i 5)
344      (write '(A B))
345      (write #\Space)
346      (pprint-newline :fill))
347  "(A B) (A B)
348(A B) (A B)
349(A B) "
350  :margin 12)
351
352(def-ppblock-test pprint-newline.fill.7
353    (dolist (x '(A (A B) (A A A A A A A A) X (C D) (E F)))
354      (pprint-fill nil x)
355      (write #\Space)
356      (pprint-newline :fill))
357  "A (A B)
358(A A A A A
359 A A A)
360X (C D)
361(E F) "
362  :margin 12)
363
364(def-ppblock-test pprint-newline.fill.8
365    (dotimes (i 5)
366      (write '(A B) :pretty nil)
367      (write #\Space)
368      (let ((*print-pretty* nil)) (pprint-newline :fill)))
369  "(A B) (A B) (A B) (A B) (A B) "
370  :margin 12)
371
372(deftest pprint-newline.fill.9
373  (with-standard-io-syntax
374   (let ((*print-readably* nil)
375         (*print-escape* nil)
376         (*print-right-margin* 4)
377         (*print-pretty* t)
378         (*print-miser-width* nil))
379     (with-output-to-string
380       (*standard-output*)
381       (dotimes (i 5) (write "A ") (pprint-newline :fill)))))
382  "A A A A A ")
383
384(deftest pprint-newline.fill.10
385  (with-standard-io-syntax
386   (let ((*print-readably* nil)
387         (*print-escape* nil)
388         (*print-right-margin* 4)
389         (*print-pretty* t)
390         (*print-miser-width* 4))
391     (with-output-to-string
392       (*standard-output*)
393       (dotimes (i 5) (write "A ") (pprint-newline :fill)))))
394  "A A A A A ")
395
396
397;;; :mandatory
398
399(def-ppblock-test pprint-newline.mandatory.1
400  (dotimes (i 4) (write "A ") (pprint-newline :mandatory))
401  "A
402A
403A
404A
405")
406
407(def-ppblock-test pprint-newline.mandatory.2
408  (dotimes (i 4) (write "A ") (pprint-newline :mandatory))
409  "A
410A
411A
412A
413"
414  :margin 10)
415
416(def-ppblock-test pprint-newline.mandatory.3
417  (progn
418    (write "A ")
419    (pprint-newline :mandatory)
420    (write "A "))
421  "A
422A "
423  :margin 1)
424
425(def-ppblock-test pprint-newline.mandatory.4
426  (dotimes (i 4) (write "A ") (pprint-newline :mandatory))
427  "A A A A "
428  :pretty nil)
429
430(def-ppblock-test pprint-newline.mandatory.5
431  (pprint-logical-block
432   (*standard-output* nil :prefix "<<<" :suffix ">>>")
433   (dotimes (i 4) (write "A ") (pprint-newline :mandatory))
434   (write "A"))
435  "<<<A
436   A
437   A
438   A
439   A>>>")
440
441(deftest pprint-newline.mandatory.6
442  (with-standard-io-syntax
443   (let ((*print-readably* nil)
444         (*print-escape* nil)
445         (*print-pretty* t)
446         (*print-right-margin* 4)
447         (*print-miser-width* nil))
448     (with-output-to-string
449       (*standard-output*)
450       (dotimes (i 5) (write "A ") (pprint-newline :mandatory)))))
451  "A A A A A ")
452
453;;; Error cases
454
455(deftest pprint-newline.error.1
456  (check-type-error #'pprint-newline
457                    (typef '(member :linear :miser :fill :mandatory)))
458  nil)
459
460(deftest pprint-newline.error.1-unsafe
461  (check-type-error #'(lambda (x) (declare (optimize (safety 0))) (pprint-newline x))
462                    (typef '(member :linear :miser :fill :mandatory)))
463  nil)
464
465(deftest pprint-newline.error.2
466  (signals-error (pprint-newline) program-error)
467  t)
468
469(deftest pprint-newline.error.3
470  (signals-error (pprint-newline :fill nil nil) program-error)
471  t)
Note: See TracBrowser for help on using the repository browser.