source: trunk/source/tests/ansi-tests/pprint-indent.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: 9.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Jul  3 08:50:40 2004
4;;;; Contains: Tests of PPRINT-INDENT
5
6(in-package :cl-test)
7
8(deftest pprint-indent.1
9  (with-standard-io-syntax
10   (let ((*print-pretty* nil))
11     (with-open-stream (*standard-output* (make-string-output-stream))
12                       (pprint-indent :block 0))))
13  nil)
14
15(deftest pprint-indent.2
16  (with-standard-io-syntax
17   (let ((*print-pretty* nil))
18     (with-open-stream (*standard-output* (make-broadcast-stream))
19                       (pprint-indent :current 0))))
20  nil)
21
22(deftest pprint-indent.3
23  (with-standard-io-syntax
24   (let ((*print-pretty* nil))
25     (with-open-stream (s (make-string-output-stream))
26                       (pprint-indent :current 10 s))))
27  nil)
28
29(deftest pprint-indent.4
30  (with-standard-io-syntax
31   (let ((*print-pretty* nil))
32     (with-open-stream (s (make-string-output-stream))
33                       (pprint-indent :block 1/2 s))))
34  nil)
35
36(deftest pprint-indent.5
37  (with-standard-io-syntax
38   (let ((*print-pretty* nil))
39     (with-open-stream (s (make-string-output-stream))
40                       (pprint-indent :block 0.1 s))))
41  nil)
42
43(deftest pprint-indent.6
44  (with-standard-io-syntax
45   (let ((*print-pretty* nil))
46     (loop for x in '(1.0s0 1.0f0 1.0d0 1.0l0)
47           unless
48           (equal
49            (multiple-value-list
50             (with-open-stream (s (make-string-output-stream))
51                               (pprint-indent :block x s)))
52            '(nil))
53           collect x)))
54  nil)
55
56(deftest pprint-indent.7
57  (with-standard-io-syntax
58   (let ((*print-pretty* nil))
59     (with-open-stream (*standard-output* (make-broadcast-stream))
60                       (pprint-indent :current 0 nil))))
61  nil)
62
63(deftest pprint-indent.8
64  (with-standard-io-syntax
65   (let ((*print-pretty* nil))
66     (with-open-stream
67      (os (make-string-output-stream))
68      (with-open-stream
69       (is (make-string-input-stream ""))
70       (with-open-stream (*terminal-io* (make-two-way-stream is os))
71                         (pprint-indent :current 0 t))))))
72  nil)
73
74;;; Now test with pprint-logical-block
75
76;;; :current
77
78(deftest pprint-indent.9
79  (with-standard-io-syntax
80   (let ((*print-pretty* t)
81         (*print-readably* nil)
82         (*print-right-margin* 100)
83         (*print-escape* nil))
84     (with-output-to-string
85       (os)
86       (pprint-logical-block
87        (os '(|M| |M|))
88        (write '|M| :stream os)
89        (pprint-indent :current 3 os)
90        (pprint-newline :mandatory os)
91        (write '|M| :stream os)))))
92  "M
93    M")
94
95(deftest pprint-indent.10
96  (with-standard-io-syntax
97   (let ((*print-pretty* t)
98         (*print-readably* nil)
99         (*print-right-margin* 100)
100         (*print-escape* nil))
101     (with-output-to-string
102       (os)
103       (pprint-logical-block
104        (os '(|M| |M|) :prefix "(" :suffix ")")
105        (write '|M| :stream os)
106        (pprint-indent :current 1 os)
107        (pprint-newline :mandatory os)
108        (write '|M| :stream os)))))
109  "(M
110   M)")
111
112(deftest pprint-indent.11
113  (with-standard-io-syntax
114   (let ((*print-pretty* t)
115         (*print-readably* nil)
116         (*print-right-margin* 100)
117         (*print-escape* nil))
118     (with-output-to-string
119       (os)
120       (pprint-logical-block
121        (os '(|M| |M|) :prefix "(" :suffix ")")
122        (write '|M| :stream os)
123        (pprint-indent :current -1 os)
124        (pprint-newline :mandatory os)
125        (write '|M| :stream os)))))
126  "(M
127 M)")
128
129(deftest pprint-indent.12
130  (with-standard-io-syntax
131   (let ((*print-pretty* t)
132         (*print-readably* nil)
133         (*print-right-margin* 100)
134         (*print-escape* nil))
135     (with-output-to-string
136       (os)
137       (pprint-logical-block
138        (os '(|M| |M|) :prefix "(" :suffix ")")
139        (write '|M| :stream os)
140        (pprint-indent :current -2.0 os)
141        (pprint-newline :mandatory os)
142        (write '|M| :stream os)))))
143  "(M
144M)")
145
146;;; :block
147
148(deftest pprint-indent.13
149  (with-standard-io-syntax
150   (let ((*print-pretty* t)
151         (*print-readably* nil)
152         (*print-right-margin* 100)
153         (*print-escape* nil))
154     (with-output-to-string
155       (os)
156       (pprint-logical-block
157        (os '(|M| |M|))
158        (write '|MMM| :stream os)
159        (pprint-indent :block 0 os)
160        (pprint-newline :mandatory os)
161        (write '|MMMMM| :stream os)))))
162  "MMM
163MMMMM")
164
165(deftest pprint-indent.13a
166  (with-standard-io-syntax
167   (let ((*print-pretty* t)
168         (*print-readably* nil)
169         (*print-right-margin* 100)
170         (*print-escape* nil))
171     (with-output-to-string
172       (os)
173       (pprint-logical-block
174        (os '(|M| |M|) :prefix "(" :suffix ")")
175        (write '|MMM| :stream os)
176        (pprint-indent :block 0 os)
177        (pprint-newline :mandatory os)
178        (write '|MMMMM| :stream os)))))
179  "(MMM
180 MMMMM)")
181
182(deftest pprint-indent.14
183  (with-standard-io-syntax
184   (let ((*print-pretty* t)
185         (*print-readably* nil)
186         (*print-right-margin* 100)
187         (*print-escape* nil))
188     (with-output-to-string
189       (os)
190       (pprint-logical-block
191        (os '(|M| |M|))
192        (write '|MMM| :stream os)
193        (pprint-indent :block 1 os)
194        (pprint-newline :mandatory os)
195        (write '|MMMMM| :stream os)))))
196  "MMM
197 MMMMM")
198
199(deftest pprint-indent.15
200  (with-standard-io-syntax
201   (let ((*print-pretty* t)
202         (*print-readably* nil)
203         (*print-right-margin* 100)
204         (*print-escape* nil))
205     (with-output-to-string
206       (os)
207       (pprint-logical-block
208        (os '(|M| |M|))
209        (write '|MMM| :stream os)
210        (pprint-indent :block -1 os)
211        (pprint-newline :mandatory os)
212        (write '|MMMMM| :stream os)))))
213  "MMM
214MMMMM")
215
216(deftest pprint-indent.16
217  (loop for n in '(3.0s0 3.0f0 3.0d0 3.0l0)
218        unless (string=
219                (with-standard-io-syntax
220                 (let ((*print-pretty* t)
221                       (*print-readably* nil)
222                       (*print-right-margin* 100)
223                       (*print-escape* nil))
224                   (with-output-to-string
225                     (os)
226                     (pprint-logical-block
227                      (os '(|M| |M|))
228                      (write '|MMM| :stream os)
229                      (pprint-indent :block n os)
230                      (pprint-newline :mandatory os)
231                      (write '|MMMMM| :stream os)))))
232                "MMM
233   MMMMM")
234        collect n)
235  nil)
236
237;;; *print-pretty* must be true for pprint-indent to have an effect
238
239(deftest pprint-indent.17
240  (with-standard-io-syntax
241   (let ((*print-pretty* t)
242         (*print-readably* nil)
243         (*print-right-margin* 100)
244         (*print-escape* nil))
245     (with-output-to-string
246       (os)
247       (pprint-logical-block
248        (os '(|M| |M|))
249        (write '|M| :stream os)
250        (let ((*print-pretty* nil)) (pprint-indent :current 3 os))
251        (pprint-newline :mandatory os)
252        (write '|M| :stream os)))))
253  "M
254M")
255
256(deftest pprint-indent.18
257  (with-standard-io-syntax
258   (let ((*print-pretty* t)
259         (*print-readably* nil)
260         (*print-right-margin* 100)
261         (*print-escape* nil))
262     (with-output-to-string
263       (os)
264       (pprint-logical-block
265        (os '(|M| |M|))
266        (write '|M| :stream os)
267        (let ((*print-pretty* nil)) (pprint-indent :block 3 os))
268        (pprint-newline :mandatory os)
269        (write '|M| :stream os)))))
270  "M
271M")
272
273;;; indentation interaction with :per-line-prefix
274
275(deftest pprint-indent.19
276  (with-standard-io-syntax
277   (let ((*print-pretty* t)
278         (*print-readably* nil)
279         (*print-right-margin* 100)
280         (*print-escape* nil))
281     (with-output-to-string
282       (os)
283       (pprint-logical-block
284        (os '(|M| |M| |M|) :per-line-prefix ">>>>")
285        (write '|M| :stream os)
286        (pprint-indent :block 2 os)
287        (write #\Space :stream os)
288        (write '|M| :stream os)
289        (pprint-newline :mandatory os)
290        (write '|M| :stream os)))))
291  ">>>>M M
292>>>>  M")
293
294(deftest pprint-indent.20
295  (with-standard-io-syntax
296   (let ((*print-pretty* t)
297         (*print-readably* nil)
298         (*print-right-margin* 100)
299         (*print-escape* nil))
300     (with-output-to-string
301       (os)
302       (pprint-logical-block
303        (os '(|M| |M|) :per-line-prefix ">>>>")
304        (write '|M| :stream os)
305        (pprint-indent :block -1 os)
306        (pprint-newline :mandatory os)
307        (write '|M| :stream os)))))
308  ">>>>M
309>>>>M")
310
311(deftest pprint-indent.21
312  (with-standard-io-syntax
313   (let ((*print-pretty* t)
314         (*print-readably* nil)
315         (*print-right-margin* 100)
316         (*print-escape* nil))
317     (with-output-to-string
318       (os)
319       (pprint-logical-block
320        (os '(|M| |M| |M| |M|) :per-line-prefix ">>>>")
321        (write '|M| :stream os)
322        (pprint-indent :block 3 os)
323        (pprint-newline :mandatory os)
324        (write '|M| :stream os)
325        (pprint-indent :current -2 os)
326        (pprint-newline :mandatory os)
327        (write '|M| :stream os)
328        (pprint-indent :current -5 os)
329        (pprint-newline :mandatory os)
330        (write '|M| :stream os)
331        ))))
332       
333  ">>>>M
334>>>>   M
335>>>>  M
336>>>>M")
337
338;;; In miser mode, indentation is ignored
339
340(deftest pprint-indent.22
341  (with-standard-io-syntax
342   (let ((*print-pretty* t)
343         (*print-readably* nil)
344         (*print-right-margin* 100)
345         (*print-miser-width* 200)
346         (*print-escape* nil))
347     (with-output-to-string
348       (os)
349       (pprint-logical-block
350        (os '(1 2 3) :prefix "(" :suffix ")")
351        (write 1 :stream os)
352        (pprint-indent :current 1 os)
353        (pprint-newline :mandatory os)
354        (write 2 :stream os)
355        (pprint-indent :block 3 os)
356        (pprint-newline :mandatory os)
357        (write 3 :stream os)))))
358  "(1
359 2
360 3)")
361
362;;; TERPRI or printing newline characters does not invoke indentation
363
364(deftest pprint-indent.23
365  (with-standard-io-syntax
366   (let ((*print-pretty* t)
367         (*print-readably* nil)
368         (*print-right-margin* 100)
369         (*print-escape* nil))
370     (with-output-to-string
371       (os)
372       (pprint-logical-block
373        (os '(1 2 3 4))
374        (pprint-indent :block 2 os)
375        (write 1 :stream os)
376        (terpri os)
377        (write 2 :stream os)
378        (write #\Newline :stream os)
379        (write 3 :stream os)
380        (pprint-newline :mandatory os)
381        (write 4 :stream os)))))
382  "1
3832
3843
385  4")
386
387;;; Error cases
388
389(deftest pprint-indent.error.1
390  (signals-error (pprint-indent) program-error)
391  t)
392
393(deftest pprint-indent.error.2
394  (signals-error (pprint-indent :current) program-error)
395  t)
396
397(deftest pprint-indent.error.3
398  (signals-error (pprint-indent :block 0 *standard-output* nil) program-error)
399  t)
400
401(deftest pprint-indent.error.4
402  (loop for x in *mini-universe*
403        when (and (not (member x '(:block :current)))
404                  (not (eval `(signals-error (pprint-indent ',x 0) error))))
405        collect x)
406  nil)
407
408(deftest pprint-indent.error.4-unsafe
409  (loop for x in *mini-universe*
410        when (and (not (member x '(:block :current)))
411                  (not (eval `(signals-error (locally (declare (optimize (safety 0))) (pprint-indent ',x 0))
412                                             error))))
413        collect x)
414  nil)
415
Note: See TracBrowser for help on using the repository browser.