source: trunk/source/tests/ansi-tests/print-vector.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: 11.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue Apr 20 22:36:53 2004
4;;;; Contains: Tests of vector printing
5
6(compile-and-load "printer-aux.lsp")
7
8(in-package :cl-test)
9
10;;; Empty vector tests
11
12(deftest print.vector.1
13  (with-standard-io-syntax
14   (write-to-string #() :readably nil :array t))
15  "#()")
16
17(deftest print.vector.2
18  (with-standard-io-syntax
19   (loop for i from 2 to 100
20         for a = (make-array '(0) :element-type `(unsigned-byte ,i))
21         for s = (write-to-string a :readably nil :array t :pretty nil)
22         unless (string= s "#()")
23         collect (list i s)))
24  nil)
25
26(deftest print.vector.3
27  (with-standard-io-syntax
28   (loop for i from 1 to 100
29         for a = (make-array '(0) :element-type `(signed-byte ,i))
30         for s = (write-to-string a :readably nil :array t :pretty nil)
31         unless (string= s "#()")
32         collect (list i s)))
33  nil)
34
35(deftest print.vector.4
36  (with-standard-io-syntax
37   (loop for type in '(short-float single-float double-float long-float)
38         for a = (make-array '(0) :element-type type)
39         for s = (write-to-string a :readably nil :array t :pretty nil)
40         unless (string= s "#()")
41         collect (list type s)))
42  nil)
43
44;;; Nonempty vectors
45
46(deftest print.vector.5
47  (with-standard-io-syntax
48   (let* ((*package* (find-package "CL-TEST"))
49          (result
50           (write-to-string #(a b c)
51                            :readably nil :array t
52                            :pretty nil :case :downcase)))
53     (or (and (string= result "#(a b c)") t)
54         result)))
55  t)
56
57(deftest print.vector.6
58  (with-standard-io-syntax
59   (loop
60    for i from 2 to 100
61    for a = (make-array '(4) :element-type `(unsigned-byte ,i)
62                        :initial-contents '(3 0 2 1))
63    for s = (write-to-string a :readably nil :array t :pretty nil)
64    unless (string= s "#(3 0 2 1)")
65    collect (list i a s)))
66  nil)
67
68(deftest print.vector.7
69  (with-standard-io-syntax
70   (loop
71    for i from 2 to 100
72    for a = (make-array '(4) :element-type `(signed-byte ,i)
73                        :initial-contents '(-2 -1 0 1))
74    for s = (write-to-string a :readably nil :array t :pretty nil)
75    unless (string= s "#(-2 -1 0 1)")
76    collect (list i a s)))
77  nil)
78
79;;; Vectors with fill pointers
80
81(deftest print.vector.fill.1
82  (with-standard-io-syntax
83   (let ((v (make-array '(10) :initial-contents '(a b c d e f g h i j)
84                        :fill-pointer 0))
85         (*package* (find-package "CL-TEST")))
86     (loop for i from 0 to 10
87           do (setf (fill-pointer v) i)
88           collect (write-to-string v :readably nil :array t :pretty nil
89                                    :case :downcase))))
90  ("#()"
91   "#(a)"
92   "#(a b)"
93   "#(a b c)"
94   "#(a b c d)"
95   "#(a b c d e)"
96   "#(a b c d e f)"
97   "#(a b c d e f g)"
98   "#(a b c d e f g h)"
99   "#(a b c d e f g h i)"
100   "#(a b c d e f g h i j)"))
101
102(deftest print.vector.fill.2
103  (with-standard-io-syntax
104   (let ((expected '("#()" "#(0)" "#(0 1)" "#(0 1 2)" "#(0 1 2 3)")))
105     (loop for i from 2 to 100
106           nconc
107           (let ((v (make-array '(4) :initial-contents '(0 1 2 3)
108                                :element-type `(unsigned-byte ,i)
109                                :fill-pointer 0)))
110             (loop for fp from 0 to 4
111                   for expected-result in expected
112                   for actual-result =
113                   (progn
114                     (setf (fill-pointer v) fp)
115                     (write-to-string v :readably nil :array t :pretty nil))
116                   unless (string= expected-result actual-result)
117                   collect (list i fp expected-result actual-result))))))
118  nil)
119
120(deftest print.vector.fill.3
121  (with-standard-io-syntax
122   (let ((expected '("#()" "#(0)" "#(0 -1)" "#(0 -1 -2)" "#(0 -1 -2 1)")))
123     (loop for i from 2 to 100
124           nconc
125           (let ((v (make-array '(4) :initial-contents '(0 -1 -2 1)
126                                :element-type `(signed-byte ,i)
127                                :fill-pointer 0)))
128             (loop for fp from 0 to 4
129                   for expected-result in expected
130                   for actual-result =
131                   (progn
132                     (setf (fill-pointer v) fp)
133                     (write-to-string v :readably nil :array t :pretty nil))
134                   unless (string= expected-result actual-result)
135                   collect (list i fp expected-result actual-result))))))
136  nil)
137
138;;; Displaced vectors
139
140(deftest print.vector.displaced.1
141  (let* ((v1 (vector 'a 'b 'c 'd 'e 'f 'g))
142         (v2 (make-array 3 :displaced-to v1 :displaced-index-offset 4)))
143    (with-standard-io-syntax
144     (write-to-string v2 :readably nil :array t :case :downcase :pretty nil
145                      :escape nil)))
146  "#(e f g)")
147
148(deftest print.vector.displaced.2
149  (with-standard-io-syntax
150   (loop for i from 2 to 100
151         nconc
152         (let* ((type `(unsigned-byte ,i))
153                (v1 (make-array 8 :element-type type
154                                :initial-contents '(0 1 2 3 0 1 2 3)))
155                (v2 (make-array 5 :displaced-to v1
156                                :displaced-index-offset 2
157                                :element-type type))
158                (result
159                 (write-to-string v2 :readably nil :array t :pretty nil)))
160           (unless (string= result "#(2 3 0 1 2)")
161             (list (list i v1 v2 result))))))
162  nil)
163
164
165(deftest print.vector.displaced.3
166  (with-standard-io-syntax
167   (loop for i from 2 to 100
168         nconc
169         (let* ((type `(signed-byte ,i))
170                (v1 (make-array 8 :element-type type
171                                :initial-contents '(0 1 -1 -2 0 1 -1 -2)))
172                (v2 (make-array 5 :displaced-to v1
173                                :displaced-index-offset 2
174                                :element-type type))
175                (result
176                 (write-to-string v2 :readably nil :array t :pretty nil)))
177           (unless (string= result "#(-1 -2 0 1 -1)")
178             (list (list i v1 v2 result))))))
179  nil)
180
181
182;;; Adjustable vectors
183
184(deftest print.vector.adjustable.1
185  (with-standard-io-syntax
186   (let ((v (make-array '(10) :initial-contents '(a b c d e f g h i j)
187                        :adjustable t)))
188     (write-to-string v :readably nil :array t :case :downcase :pretty nil
189                      :escape nil)))
190  "#(a b c d e f g h i j)")
191
192(deftest print.vector.adjustable.2
193  (with-standard-io-syntax
194   (loop for i from 2 to 100
195         for type = `(unsigned-byte ,i)
196         for v = (make-array '(8) :initial-contents '(0 1 2 3 3 0 2 1)
197                             :adjustable t)
198         for s =
199         (write-to-string v :readably nil :array t :case :downcase :pretty nil
200                          :escape nil)
201         unless (string= s "#(0 1 2 3 3 0 2 1)")
202         collect (list i v s)))
203  nil)
204
205(deftest print.vector.adjustable.3
206  (with-standard-io-syntax
207   (loop for i from 2 to 100
208         for type = `(signed-byte ,i)
209         for v = (make-array '(8) :initial-contents '(0 1 -1 -2 -1 0 -2 1)
210                             :adjustable t)
211         for s =
212         (write-to-string v :readably nil :array t :case :downcase :pretty nil
213                          :escape nil)
214         unless (string= s "#(0 1 -1 -2 -1 0 -2 1)")
215         collect (list i v s)))
216  nil)
217
218;;; Printing with *print-array* and *print-readably* bound to nil
219
220(deftest print.vector.unreadable.1
221  (with-standard-io-syntax
222   (subseq (write-to-string #(a b c d e) :array nil :readably nil) 0 2))
223  "#<")
224
225(deftest print.vector.unreadable.2
226  (with-standard-io-syntax
227   (loop for i from 2 to 100
228         for type = `(unsigned-byte ,i)
229         for v = (make-array '(4) :element-type type
230                             :initial-contents '(0 1 2 3))
231         for result = (write-to-string v :array nil :readably nil)
232         unless (string= (subseq result 0 2) "#<")
233         collect (list i type v result)))
234  nil)
235
236
237(deftest print.vector.unreadable.3
238  (with-standard-io-syntax
239   (loop for i from 2 to 100
240         for type = `(signed-byte ,i)
241         for v = (make-array '(4) :element-type type
242                             :initial-contents '(0 1 -2 -1))
243         for result = (write-to-string v :array nil :readably nil)
244         unless (string= (subseq result 0 2) "#<")
245         collect (list i type v result)))
246  nil)
247
248;;; Readability tests
249
250(deftest print.vector.random.1
251  (trim-list
252   (loop for v in *universe*
253         when (vectorp v)
254         nconc
255         (loop repeat 10
256               nconc (randomly-check-readability
257                      v :test #'equalp
258                      :can-fail (not (subtypep t (array-element-type v))))))
259   10)
260  nil)
261
262(deftest print.vector.random.2
263  (trim-list
264   (loop for i from 2 to 100
265         for type = `(unsigned-byte ,i)
266         for v = (make-array '(4) :element-type type
267                             :initial-contents '(1 3 2 0))
268         nconc
269         (loop repeat 10
270               nconc (randomly-check-readability v :test #'equalp
271                                                 :can-fail t)))
272   10)
273  nil)
274
275(deftest print.vector.random.3
276  (trim-list
277   (loop for i from 2 to 100
278         for type = `(signed-byte ,i)
279         for v = (make-array '(4) :element-type type
280                             :initial-contents '(-1 1 0 -2))
281         nconc
282         (loop repeat 10
283               nconc (randomly-check-readability v :test #'equalp
284                                                 :can-fail t)))
285   10)
286  nil)
287
288(deftest print.vector.random.4
289  (trim-list
290   (loop for v = (make-random-vector (1+ (random 100)))
291         repeat 1000
292         nconc (randomly-check-readability v :test #'equalp))
293   10)
294  nil)
295
296;;; *print-length* checks
297
298(deftest print.vector.length.1
299  (with-standard-io-syntax
300   (write-to-string #() :pretty nil :length 0 :readably nil))
301  "#()")
302
303(deftest print.vector.length.2
304  (with-standard-io-syntax
305   (write-to-string #(1) :pretty nil :length 0 :readably nil))
306  "#(...)")
307
308(deftest print.vector.length.3
309  (with-standard-io-syntax
310   (write-to-string #(1) :pretty nil :length 1 :readably nil))
311  "#(1)")
312
313(deftest print.vector.length.4
314  (with-standard-io-syntax
315   (write-to-string #(a b c d e f g h)
316                    :pretty nil
317                    :array t :escape nil
318                    :length 5 :case :downcase
319                    :readably nil))
320  "#(a b c d e ...)")
321
322(deftest print.vector.length.5
323  (with-standard-io-syntax
324   (loop for i from 2 to 100
325         for type = `(unsigned-byte ,i)
326         for v = (make-array '(0) :element-type type)
327         for result = (write-to-string v :array t :readably nil
328                                       :pretty nil
329                                       :length 0)
330         unless (string= result "#()")
331         collect (list i type v result)))
332  nil)
333
334(deftest print.vector.length.6
335  (with-standard-io-syntax
336   (loop for i from 2 to 100
337         for type = `(unsigned-byte ,i)
338         for v = (make-array '(1) :element-type type :initial-contents '(2))
339         for result = (write-to-string v
340                                       :pretty nil
341                                       :array t
342                                       :readably nil
343                                       :length 0)
344         unless (string= result "#(...)")
345         collect (list i type v result)))
346  nil)
347
348(deftest print.vector.length.7
349  (with-standard-io-syntax
350   (loop for i from 1 to 100
351         for type = `(signed-byte ,i)
352         for v = (make-array '(1) :element-type type :initial-contents '(-1))
353         for result = (write-to-string v
354                                       :pretty nil
355                                       :array t
356                                       :readably nil
357                                       :length 0)
358         unless (string= result "#(...)")
359         collect (list i type v result)))
360  nil)
361
362(deftest print.vector.length.8
363  (with-standard-io-syntax
364   (loop for i from 2 to 100
365         for type = `(unsigned-byte ,i)
366         for v = (make-array '(4) :element-type type
367                             :initial-contents '(1 3 0 2))
368         for result = (write-to-string v
369                                       :pretty nil
370                                       :array t
371                                       :readably nil
372                                       :length 2)
373         unless (string= result "#(1 3 ...)")
374         collect (list i type v result)))
375  nil)
376
377(deftest print.vector.length.9
378  (with-standard-io-syntax
379   (loop for i from 2 to 100
380         for type = `(signed-byte ,i)
381         for v = (make-array '(4) :element-type type
382                             :initial-contents '(1 -2 0 -1))
383         for result = (write-to-string v
384                                       :pretty nil
385                                       :array t
386                                       :readably nil
387                                       :length 2)
388         unless (string= result "#(1 -2 ...)")
389         collect (list i type v result)))
390  nil)
391
392;;; Printing with *print-level* bound
393
394(deftest print.vector.level.1
395  (with-standard-io-syntax
396   (write-to-string #() :level 0 :readably nil :pretty nil))
397  "#")
398
399(deftest print.vector.level.2
400  (with-standard-io-syntax
401   (write-to-string #() :level 1 :readably nil :pretty nil))
402  "#()")
403
404(deftest print.vector.level.3
405  (with-standard-io-syntax
406   (write-to-string #(17) :level 1 :readably nil :pretty nil))
407  "#(17)")
408
409(deftest print.vector.level.4
410  (with-standard-io-syntax
411   (write-to-string #(4 (17) 9 (a) (b) 0) :level 1 :readably nil :pretty nil))
412  "#(4 # 9 # # 0)")
413
414(deftest print.vector.level.5
415  (with-standard-io-syntax
416   (write-to-string '(#(a)) :level 1 :readably nil :pretty nil))
417  "(#)")
418
419(deftest print.vector.level.6
420  (with-standard-io-syntax
421   (write-to-string '#(#(a)) :level 1 :readably nil :pretty nil))
422  "#(#)")
423
Note: See TracBrowser for help on using the repository browser.