source: trunk/source/tests/ansi-tests/write-sequence.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.5 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Wed Jan 21 04:07:58 2004
4;;;; Contains: Tests of WRITE-SEQUENCE
5
6(in-package :cl-test)
7
8(defmacro def-write-sequence-test (name input args &rest expected)
9  `(deftest ,name
10     (let ((s ,input))
11       (with-output-to-string
12         (os)
13         (assert (eq (write-sequence s os ,@args) s))))
14     ,@expected))
15
16;;; on strings
17
18(def-write-sequence-test write-sequence.string.1 "abcde" () "abcde")
19(def-write-sequence-test write-sequence.string.2 "abcde" (:start 1) "bcde")
20(def-write-sequence-test write-sequence.string.3 "abcde" (:end 3) "abc")
21(def-write-sequence-test write-sequence.string.4 "abcde"
22  (:start 1 :end 4) "bcd")
23(def-write-sequence-test write-sequence.string.5 "abcde" (:end nil) "abcde")
24(def-write-sequence-test write-sequence.string.6 "abcde" (:start 3 :end 3) "")
25(def-write-sequence-test write-sequence.string.7 "abcde"
26  (:end nil :start 1) "bcde")
27(def-write-sequence-test write-sequence.string.8 "abcde"
28  (:allow-other-keys nil) "abcde")
29(def-write-sequence-test write-sequence.string.9 "abcde"
30  (:allow-other-keys t :foo nil) "abcde")
31(def-write-sequence-test write-sequence.string.10 "abcde"
32  (:allow-other-keys t :allow-other-keys nil :foo nil) "abcde")
33(def-write-sequence-test write-sequence.string.11 "abcde"
34  (:bar 'x :allow-other-keys t) "abcde")
35(def-write-sequence-test write-sequence.string.12 "abcde"
36  (:start 1 :end 4 :start 2 :end 3) "bcd")
37(def-write-sequence-test write-sequence.string.13 "" () "")
38
39(defmacro def-write-sequence-special-test (name string args expected)
40  `(deftest ,name
41     (let ((str ,string)
42           (expected ,expected))
43       (do-special-strings
44        (s str nil)
45        (let ((out (with-output-to-string
46                     (os)
47                     (assert (eq (write-sequence s os ,@args) s)))))
48          (assert (equal out expected)))))
49     nil))
50
51(def-write-sequence-special-test write-sequence.string.14 "12345" () "12345")
52(def-write-sequence-special-test write-sequence.string.15 "12345" (:start 1 :end 3) "23")
53
54;;; on lists
55
56(def-write-sequence-test write-sequence.list.1 (coerce "abcde" 'list)
57  () "abcde")
58(def-write-sequence-test write-sequence.list.2 (coerce "abcde" 'list)
59  (:start 1) "bcde")
60(def-write-sequence-test write-sequence.list.3 (coerce "abcde" 'list)
61  (:end 3) "abc")
62(def-write-sequence-test write-sequence.list.4 (coerce "abcde" 'list)
63  (:start 1 :end 4) "bcd")
64(def-write-sequence-test write-sequence.list.5 (coerce "abcde" 'list)
65  (:end nil) "abcde")
66(def-write-sequence-test write-sequence.list.6 (coerce "abcde" 'list)
67  (:start 3 :end 3) "")
68(def-write-sequence-test write-sequence.list.7 (coerce "abcde" 'list)
69  (:end nil :start 1) "bcde")
70(def-write-sequence-test write-sequence.list.8 () () "")
71
72
73;;; on vectors
74
75(def-write-sequence-test write-sequence.simple-vector.1
76  (coerce "abcde" 'simple-vector) () "abcde")
77(def-write-sequence-test write-sequence.simple-vector.2
78  (coerce "abcde" 'simple-vector) (:start 1) "bcde")
79(def-write-sequence-test write-sequence.simple-vector.3
80  (coerce "abcde" 'simple-vector) (:end 3) "abc")
81(def-write-sequence-test write-sequence.simple-vector.4
82  (coerce "abcde" 'simple-vector) (:start 1 :end 4) "bcd")
83(def-write-sequence-test write-sequence.simple-vector.5
84  (coerce "abcde" 'simple-vector) (:end nil) "abcde")
85(def-write-sequence-test write-sequence.simple-vector.6
86  (coerce "abcde" 'simple-vector) (:start 3 :end 3) "")
87(def-write-sequence-test write-sequence.simple-vector.7
88  (coerce "abcde" 'simple-vector) (:end nil :start 1) "bcde")
89(def-write-sequence-test write-sequence.simple-vector.8 #() () "")
90
91;;; on vectors with fill pointers
92
93(def-write-sequence-test write-sequence.fill-vector.1
94  (make-array 10 :initial-contents "abcde     " :fill-pointer 5) () "abcde")
95(def-write-sequence-test write-sequence.fill-vector.2
96  (make-array 10 :initial-contents "abcde     " :fill-pointer 5)
97  (:start 1) "bcde")
98(def-write-sequence-test write-sequence.fill-vector.3
99  (make-array 10 :initial-contents "abcde     " :fill-pointer 5)
100  (:end 3) "abc")
101(def-write-sequence-test write-sequence.fill-vector.4
102  (make-array 10 :initial-contents "abcde     " :fill-pointer 5)
103  (:start 1 :end 4) "bcd")
104(def-write-sequence-test write-sequence.fill-vector.5
105  (make-array 10 :initial-contents "abcde     " :fill-pointer 5)
106  (:end nil) "abcde")
107(def-write-sequence-test write-sequence.fill-vector.6
108  (make-array 10 :initial-contents "abcde     " :fill-pointer 5)
109  (:start 3 :end 3) "")
110(def-write-sequence-test write-sequence.fill-vector.7
111  (make-array 10 :initial-contents "abcde     " :fill-pointer 5)
112  (:end nil :start 1) "bcde")
113
114;;; on bit vectors
115
116(defmacro def-write-sequence-bv-test (name input args expected)
117  `(deftest ,name
118     (let ((s ,input)
119           (expected ,expected))
120       (with-open-file
121        (os "tmp.dat" :direction :output
122            :element-type '(unsigned-byte 8)
123            :if-exists :supersede)
124         (assert (eq (write-sequence s os ,@args) s)))
125       (with-open-file
126        (is "tmp.dat" :direction :input
127            :element-type '(unsigned-byte 8))
128         (loop for i from 0 below (length expected)
129               for e = (elt expected i)
130               always (eql (read-byte is) e))))
131     t))
132
133(def-write-sequence-bv-test write-sequence.bv.1 #*00111010
134  () #*00111010)
135(def-write-sequence-bv-test write-sequence.bv.2 #*00111010
136  (:start 1) #*0111010)
137(def-write-sequence-bv-test write-sequence.bv.3 #*00111010
138  (:end 5) #*00111)
139(def-write-sequence-bv-test write-sequence.bv.4 #*00111010
140  (:start 1 :end 6) #*01110)
141(def-write-sequence-bv-test write-sequence.bv.5 #*00111010
142  (:start 1 :end nil) #*0111010)
143(def-write-sequence-bv-test write-sequence.bv.6 #*00111010
144  (:start 1 :end nil :end 4) #*0111010)
145
146
147;;; Error tests
148
149(deftest write-sequence.error.1
150  (signals-error (write-sequence) program-error)
151  t)
152
153(deftest write-sequence.error.2
154  (signals-error (write-sequence "abcde") program-error)
155  t)
156
157(deftest write-sequence.error.3
158  (signals-error (write-sequence '(#\a . #\b) *standard-output*) type-error)
159  t)
160
161(deftest write-sequence.error.4
162  (signals-error (write-sequence #\a *standard-output*) type-error)
163  t)
164
165(deftest write-sequence.error.5
166  (signals-error (write-sequence "ABC" *standard-output* :start -1) type-error)
167  t)
168
169(deftest write-sequence.error.6
170  (signals-error (write-sequence "ABC" *standard-output* :start 'x) type-error)
171  t)
172
173(deftest write-sequence.error.7
174  (signals-error (write-sequence "ABC" *standard-output* :start 0.0)
175                 type-error)
176  t)
177
178(deftest write-sequence.error.8
179  (signals-error (write-sequence "ABC" *standard-output* :end -1)
180                 type-error)
181  t)
182
183(deftest write-sequence.error.9
184  (signals-error (write-sequence "ABC" *standard-output* :end 'x)
185                 type-error)
186  t)
187
188(deftest write-sequence.error.10
189  (signals-error (write-sequence "ABC" *standard-output* :end 2.0)
190                 type-error)
191  t)
192
193(deftest write-sequence.error.11
194  (signals-error (write-sequence "abcde" *standard-output*
195                                 :foo nil) program-error)
196  t)
197         
198(deftest write-sequence.error.12
199  (signals-error (write-sequence "abcde" *standard-output*
200                                 :allow-other-keys nil :foo t)
201                 program-error)
202  t)
203
204(deftest write-sequence.error.13
205  (signals-error (write-sequence "abcde" *standard-output* :start)
206                 program-error)
207  t)
208
209(deftest write-sequence.error.14
210  (check-type-error #'(lambda (x) (write-sequence x *standard-output*))
211                    #'sequencep)
212  nil)
213
214(deftest write-sequence.error.15
215  (check-type-error #'(lambda (x) (write-sequence "abcde" *standard-output*
216                                                  :start x))
217                    (typef 'unsigned-byte))
218  nil)
219
220(deftest write-sequence.error.16
221  (check-type-error #'(lambda (x) (write-sequence "abcde" *standard-output*
222                                                  :end x))
223                    (typef '(or null unsigned-byte)))
224  nil)
225
Note: See TracBrowser for help on using the repository browser.