source: trunk/source/tests/ansi-tests/pprint-exit-if-list-exhausted.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: 8.1 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue Jul  6 06:11:01 2004
4;;;; Contains: Tests of PPRINT-EXIT-IF-LIST-EXHAUSTED, PPRINT-POP
5
6(in-package :cl-test)
7
8(deftest pprint-exit-if-list-exhausted.1
9  (with-standard-io-syntax
10   (let ((*print-pretty* nil)
11         (*print-escape* nil)
12         (*print-right-margin* 100)
13         (*print-readably* nil)
14         )
15     (with-output-to-string
16       (os)
17       (pprint-logical-block
18        (os '(1 2))
19        (assert (equal (multiple-value-list
20                        (pprint-exit-if-list-exhausted))
21                       '(nil)))
22        (write (pprint-pop) :stream os)
23        (assert (equal (multiple-value-list
24                        (pprint-exit-if-list-exhausted))
25                       '(nil)))
26        (write #\Space :stream os)
27        (write (pprint-pop) :stream os)
28        (pprint-exit-if-list-exhausted)
29        (assert nil)))))
30  "1 2")
31
32(deftest pprint-exit-if-list-exhausted.2
33  (with-standard-io-syntax
34   (let ((*print-pretty* t)
35         (*print-escape* nil)
36         (*print-right-margin* 100)
37         (*print-readably* nil)
38         )
39     (with-output-to-string
40       (os)
41       (pprint-logical-block
42        (os '(1 2))
43        (assert (equal (multiple-value-list
44                        (pprint-exit-if-list-exhausted))
45                       '(nil)))
46        (write (pprint-pop) :stream os)
47        (assert (equal (multiple-value-list
48                        (pprint-exit-if-list-exhausted))
49                       '(nil)))
50        (write #\Space :stream os)
51        (write (pprint-pop) :stream os)
52        (pprint-exit-if-list-exhausted)
53        (assert nil)))))
54  "1 2")
55
56(deftest pprint-exit-if-list-exhausted.3
57  (with-standard-io-syntax
58   (let ((*print-pretty* t)
59         (*print-escape* nil)
60         (*print-right-margin* 100)
61         (*print-readably* nil)
62         )
63     (with-output-to-string
64       (os)
65       (pprint-logical-block
66        (os '(1 . 2))
67        (assert (equal (multiple-value-list
68                        (pprint-exit-if-list-exhausted))
69                       '(nil)))
70        (write (pprint-pop) :stream os)
71        (write #\Space :stream os)
72        (assert (equal (multiple-value-list
73                        (pprint-exit-if-list-exhausted))
74                       '(nil)))
75        (pprint-pop)
76        (assert nil)))))
77  "1 . 2")
78
79(deftest pprint-exit-if-list-exhausted.4
80  (with-standard-io-syntax
81   (let ((*print-pretty* t)
82         (*print-escape* nil)
83         (*print-right-margin* 100)
84         (*print-readably* nil)
85         )
86     (with-output-to-string
87       (os)
88       (pprint-logical-block
89        (os '(1 . 2) :prefix "[" :suffix "]")
90        (assert (equal (multiple-value-list
91                        (pprint-exit-if-list-exhausted))
92                       '(nil)))
93        (write (pprint-pop) :stream os)
94        (write #\Space :stream os)
95        (assert (equal (multiple-value-list
96                        (pprint-exit-if-list-exhausted))
97                       '(nil)))
98        (pprint-pop)
99        (assert nil)))))
100  "[1 . 2]")
101
102;;; Tests focusing on pprint-pop
103
104(deftest pprint-pop.1
105  (with-standard-io-syntax
106   (let ((*print-pretty* t)
107         (*print-escape* nil)
108         (*print-right-margin* 100)
109         (*print-readably* nil)
110         (*print-length* 0))
111     (with-output-to-string
112       (os)
113       (pprint-logical-block
114        (os nil)
115        (pprint-pop)
116        (assert nil)))))
117  "...")
118
119(deftest pprint-pop.2
120  (with-standard-io-syntax
121   (let ((*print-pretty* t)
122         (*print-escape* nil)
123         (*print-right-margin* 100)
124         (*print-readably* nil)
125         (*print-length* 0))
126     (with-output-to-string
127       (os)
128       (pprint-logical-block
129        (os 1)
130        (pprint-pop)))))
131  "1")
132
133(deftest pprint-pop.3
134  (with-standard-io-syntax
135   (let ((*print-pretty* t)
136         (*print-escape* nil)
137         (*print-right-margin* 100)
138         (*print-readably* nil)
139         (*print-length* 1))
140     (with-output-to-string
141       (os)
142       (pprint-logical-block
143        (os '(1))
144        (assert (equal '(1) (multiple-value-list (pprint-pop))))))))
145  "")
146
147(deftest pprint-pop.4
148  (with-standard-io-syntax
149   (let ((*print-pretty* t)
150         (*print-escape* nil)
151         (*print-right-margin* 100)
152         (*print-readably* nil)
153         (*print-length* 0))
154     (with-output-to-string
155       (os)
156       (pprint-logical-block
157        (os '(1 2 3) :prefix "{" :suffix "}")
158        (pprint-pop)
159        (assert nil)))))
160  "{...}")
161
162(deftest pprint-pop.5
163  (flet ((%f (len)
164             (with-standard-io-syntax
165              (let ((*print-pretty* t)
166                    (*print-escape* nil)
167                    (*print-right-margin* 100)
168                    (*print-readably* nil)
169                    (*print-length* len))
170                (with-output-to-string
171                  (os)
172                  (pprint-logical-block
173                   (os '(1 2 3 4 5) :prefix "{" :suffix "}")
174                   (pprint-exit-if-list-exhausted)
175                   (write (pprint-pop) :stream os)
176                   (loop (pprint-exit-if-list-exhausted)
177                         (write #\Space :stream os)
178                         (write (pprint-pop) :stream os))))))))
179    (values (%f 0) (%f 1) (%f 2) (%f 3) (%f 4) (%f 5) (%f 6)))
180  "{...}"
181  "{1 ...}"
182  "{1 2 ...}"
183  "{1 2 3 ...}"
184  "{1 2 3 4 ...}"
185  "{1 2 3 4 5}"
186  "{1 2 3 4 5}")
187
188(deftest pprint-pop.6
189  (flet ((%f (len)
190             (with-standard-io-syntax
191              (let ((*print-pretty* t)
192                    (*print-escape* nil)
193                    (*print-right-margin* 100)
194                    (*print-readably* nil)
195                    (*print-length* len))
196                (with-output-to-string
197                  (os)
198                  (pprint-logical-block
199                   (os '(1 2 . 3) :prefix "{" :suffix "}")
200                   (pprint-exit-if-list-exhausted)
201                   (write (pprint-pop) :stream os)
202                   (loop (pprint-exit-if-list-exhausted)
203                         (write #\Space :stream os)
204                         (write (pprint-pop) :stream os))))))))
205    (values (%f 0) (%f 1) (%f 2) (%f 3) (%f 4)))
206  "{...}"
207  "{1 ...}"
208  "{1 2 . 3}"
209  "{1 2 . 3}"
210  "{1 2 . 3}")
211
212;;; pprint-pop and circularity/sharing
213
214(deftest pprint-pop.7
215  (flet ((%f (len)
216             (with-standard-io-syntax
217              (let ((*print-pretty* t)
218                    (*print-escape* nil)
219                    (*print-right-margin* 100)
220                    (*print-readably* nil)
221                    (*print-length* len)
222                    (*print-circle* t))
223                (with-output-to-string
224                  (os)
225                  (let* ((tail (list 1))
226                         (x (list* tail 2 tail)))
227                    (pprint-logical-block
228                     (os x :prefix "<" :suffix ">")
229                     (pprint-exit-if-list-exhausted)
230                     (write (pprint-pop) :stream os)
231                     (loop (pprint-exit-if-list-exhausted)
232                           (write #\Space :stream os)
233                           (write (pprint-pop) :stream os)))))))))
234    (values (%f nil) (%f 0) (%f 1) (%f 2) (%f 3) (%f 4)))
235  "<#1=(1) 2 . #1#>"
236  "<...>"
237  "<(1) ...>"
238  "<(1) 2 ...>"
239  "<#1=(1) 2 . #1#>"
240  "<#1=(1) 2 . #1#>")
241
242(deftest pprint-pop.8
243  (flet ((%f (len)
244             (with-standard-io-syntax
245              (let ((*print-pretty* t)
246                    (*print-escape* nil)
247                    (*print-right-margin* 100)
248                    (*print-readably* nil)
249                    (*print-length* len)
250                    (*print-circle* t))
251                (with-output-to-string
252                  (os)
253                  (let* ((tail (list 2))
254                         (x (list* 1 tail)))
255                    (setf (cdr tail) tail)
256                    (pprint-logical-block
257                     (os x :prefix "[[" :suffix "]]")
258                     (pprint-exit-if-list-exhausted)
259                     (write (pprint-pop) :stream os)
260                     (loop (pprint-exit-if-list-exhausted)
261                           (write #\Space :stream os)
262                           (write (pprint-pop) :stream os)))))))))
263    (values (%f 0) (%f 1) (%f 2) (%f 3) (%f 10) (%f 20)))
264  "[[...]]"
265  "[[1 ...]]"
266  "[[1 2 ...]]"
267  "[[1 . #1=(2 . #1#)]]"
268  "[[1 . #1=(2 . #1#)]]"
269  "[[1 . #1=(2 . #1#)]]")
270
271;;; pprint-pop when pprint-logical-block is given NIL
272
273(deftest pprint-pop.9
274  (flet ((%f (len)
275             (with-standard-io-syntax
276              (let ((*print-pretty* t)
277                    (*print-escape* nil)
278                    (*print-right-margin* 100)
279                    (*print-readably* nil)
280                    (*print-length* len))
281                (with-output-to-string
282                  (os)
283                  (pprint-logical-block
284                   (os nil :prefix "{" :suffix "}")
285                   (let ((vals (multiple-value-list (pprint-pop))))
286                     (assert (equal vals '(nil)) () "First call returned ~A" vals))
287                   (write 1 :stream os)
288                   (write #\Space :stream os)
289                   (let ((vals (multiple-value-list (pprint-pop))))
290                     (assert (equal vals '(nil)) () "Second call returned ~A" vals))
291                   (write 2 :stream os)
292                   (write #\Space :stream os)
293                   (let ((vals (multiple-value-list (pprint-pop))))
294                     (assert (equal vals '(nil)) () "Third call returned ~A" vals))
295                   (write 3 :stream os)
296                   ))))))
297    (values (%f nil) (%f 0) (%f 1) (%f 2) (%f 3) (%f 4)))
298  "{1 2 3}"
299  "{...}"
300  "{1 ...}"
301  "{1 2 ...}"
302  "{1 2 3}"
303  "{1 2 3}")
304
305;;; Error cases
306
307(deftest pprint-exit-if-list-exhausted.error.1
308  (signals-error (pprint-exit-if-list-exhausted) error)
309  t)
310
311(deftest pprint-exit-if-list-exhausted.error.1-unsafe
312  (locally (declare (optimize (safety 0)))
313           (signals-error (locally (declare (optimize (safety 0)))
314                                   (pprint-exit-if-list-exhausted))
315                          error))
316  t)
317
318(deftest pprint-pop.error.1
319  (signals-error (pprint-pop) error)
320  t)
321
322
323(deftest pprint-pop.error.1-unsafe
324  (locally (declare (optimize (safety 0)))
325           (signals-error (locally (declare (optimize (safety 0))) (pprint-pop)) error))
326  t)
Note: See TracBrowser for help on using the repository browser.