source: trunk/source/tests/ansi-tests/subseq.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: 6.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Oct 12 19:41:14 2002
4;;;; Contains: Tests on SUBSEQ
5
6(in-package :cl-test)
7
8(compile-and-load "subseq-aux.lsp")
9
10;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11;;; subseq, on lists
12
13(deftest subseq-list.1
14  (subseq '(a b c d e) 0 0)
15  nil)
16
17(deftest subseq-list.2
18  (subseq '(a b c) 0)
19  (a b c))
20
21(deftest subseq-list.3
22  (subseq '(a b c) 1)
23  (b c))
24
25
26(deftest subseq-list.4
27  (subseq-list.4-body)
28  t)
29
30(deftest subseq-list.5
31  (subseq-list.5-body)
32  t)
33
34(deftest subseq-list.6    ;; check that no structure is shared
35  (subseq-list.6-body)
36  t)
37
38(deftest subseq-list.7
39  (let ((x (loop for i from 0 to 9 collect i)))
40    (setf (subseq x 0 3) (list 'a 'b 'c))
41    x)
42  (a b c 3 4 5 6 7 8 9))
43
44(deftest subseq-list.8
45  (let* ((x '(a b c d e))
46         (y (copy-seq x)))
47    (setf (subseq y 0) '(f g h))
48    (list x y))
49  ((a b c d e) (f g h d e)))
50
51(deftest subseq-list.9
52  (let* ((x '(a b c d e))
53         (y (copy-seq x)))
54    (setf (subseq y 1 3) '(1 2 3 4 5))
55    (list x y))
56  ((a b c d e) (a 1 2 d e)))
57
58(deftest subseq-list.10
59  (let* ((x '(a b c d e))
60         (y (copy-seq x)))
61    (setf (subseq y 5) '(1 2 3 4 5))
62    (list x y))
63  ((a b c d e) (a b c d e)))
64
65(deftest subseq-list.11
66  (let* ((x '(a b c d e))
67         (y (copy-seq x)))
68    (setf (subseq y 2 5) '(1))
69    (list x y))
70  ((a b c d e) (a b 1 d e)))
71
72(deftest subseq-list.12
73  (let* ((x '(a b c d e))
74         (y (copy-seq x)))
75    (setf (subseq y 0 0) '(1 2))
76    (list x y))
77  ((a b c d e) (a b c d e)))
78
79;; subseq on vectors
80
81
82(deftest subseq-vector.1
83  (subseq-vector.1-body)
84  t)
85
86
87(deftest subseq-vector.2
88    (subseq-vector.2-body)
89  t)
90
91
92(deftest subseq-vector.3
93    (subseq-vector.3-body)
94  t)
95
96(deftest subseq-vector.4
97    (subseq-vector.4-body)
98  t)
99
100(deftest subseq-vector.5
101  (subseq-vector.5-body)
102  t)
103
104(deftest subseq-vector.6
105  (subseq-vector.6-body)
106  t)
107
108(deftest subseq-vector.7
109    (let* ((x (make-array '(10) :initial-contents '(a b c d e f g h i j)))
110           (y (subseq x 2 8)))
111      (equal-array y (make-array '(6) :initial-contents '(c d e f g h))))
112  t)
113
114(deftest subseq-vector.8
115    (let* ((x (make-array '(200) :initial-element 107
116                          :element-type 'fixnum))
117           (y (subseq x 17 95)))
118      (and (eqlt (length y) (- 95 17))
119           (equal-array y
120                        (make-array (list (- 95 17))
121                                    :initial-element 107
122                                    :element-type 'fixnum))))
123  t)
124
125(deftest subseq-vector.9
126    (let* ((x (make-array '(1000) :initial-element 17.6e-1
127                          :element-type 'single-float))
128           (lo 164)
129           (hi 873)
130           (y (subseq x lo hi)))
131      (and (eqlt (length y) (- hi lo))
132           (equal-array y
133                        (make-array (list (- hi lo))
134                                    :initial-element 17.6e-1
135                                    :element-type 'single-float))))
136  t)
137
138(deftest subseq-vector.10
139    (let* ((x (make-array '(2000) :initial-element 3.1415927d4
140                          :element-type 'double-float))
141           (lo 731)
142           (hi 1942)
143           (y (subseq x lo hi)))
144      (and (eqlt (length y) (- hi lo))
145           (equal-array y
146                        (make-array (list (- hi lo))
147                                    :initial-element  3.1415927d4
148                                    :element-type 'double-float))))
149  t)
150
151;;; subseq on strings
152
153(deftest subseq-string.1
154  (subseq-string.1-body)
155  t)
156
157(deftest subseq-string.2
158  (subseq-string.2-body)
159  t)
160
161(deftest subseq-string.3
162  (subseq-string.3-body)
163  t)
164
165;;; Specialized string tests
166
167(deftest subseq.specialized-string.1
168  (let* ((s0 "abcde")
169         (len (length s0)))
170    (do-special-strings
171     (s "abcde" nil)
172     (loop for i from 0 below len
173           for s1 = (subseq s i)
174           do (assert (typep s1 'simple-array))
175           do (assert (string= (subseq s i) (subseq s0 i)))
176           do (loop for j from i to len
177                    for s2 = (subseq s i j)
178                    do (assert (typep s2 'simple-array))
179                    (assert (string= s2 (subseq s0 i j)))))))
180  nil)
181
182;;; Other specialized vectors
183
184(deftest subseq.specialized-vector.1
185  (let* ((v0 #(1 0 1 1 0 1 1 0))
186         (len (length v0)))
187    (do-special-integer-vectors
188     (v (copy-seq v0) nil)
189     (loop for i from 0 below len
190           for v1 = (subseq v i)
191           do (assert (typep v1 'simple-array))
192           do (assert (equalp (subseq v i) (subseq v0 i)))
193           do (loop for j from i to len
194                    for v2 = (subseq v i j)
195                    do (assert (typep v2 'simple-array))
196                    (assert (equalp v2 (subseq v0 i j)))))))
197  nil)
198
199(deftest subseq.specialized-vector.2
200  (loop for type in '(short-float single-float long-float double-float)
201        for len = 10
202        for vals = (loop for i from 1 to len collect (coerce i type))
203        for vec = (make-array len :element-type type :initial-contents vals)
204        for result = (subseq vec 1 9)
205        unless (and (= (length result) 8)
206                    (equal (array-element-type vec) (array-element-type result))
207                    (equalp result (apply #'vector (subseq vals 1 9))))
208        collect (list type vals result))
209  nil)
210
211(deftest subseq.specialized-vector.3
212  (loop for etype in '(short-float single-float long-float double-float
213                                   integer rational)
214        for type = `(complex ,etype)
215        for len = 10
216        for vals = (loop for i from 1 to len collect (complex (coerce i etype)
217                                                              (coerce (- i) etype)))
218        for vec = (make-array len :element-type type :initial-contents vals)
219        for result = (subseq vec 1 9)
220        unless (and (= (length result) 8)
221                    (equal (array-element-type vec) (array-element-type result))
222                    (equalp result (apply #'vector (subseq vals 1 9))))
223        collect (list type vals result))
224  nil)
225
226;;; Tests on bit vectors
227
228(deftest subseq-bit-vector.1
229  (subseq-bit-vector.1-body)
230  t)
231
232(deftest subseq-bit-vector.2
233  (subseq-bit-vector.2-body)
234  t)
235
236(deftest subseq-bit-vector.3
237  (subseq-bit-vector.3-body)
238  t)
239
240;;; Order of evaluation
241
242(deftest subseq.order.1
243  (let ((i 0) a b c)
244    (values
245     (subseq
246      (progn (setf a (incf i)) "abcdefgh")
247      (progn (setf b (incf i)) 1)
248      (progn (setf c (incf i)) 4))
249     i a b c))
250  "bcd" 3 1 2 3)
251
252(deftest subseq.order.2
253  (let ((i 0) a b)
254    (values
255     (subseq
256      (progn (setf a (incf i)) "abcdefgh")
257      (progn (setf b (incf i)) 1))
258     i a b))
259  "bcdefgh" 2 1 2)
260
261(deftest subseq.order.3
262  (let ((i 0) a b c d
263        (s (copy-seq "abcdefgh")))
264    (values
265     (setf (subseq
266            (progn (setf a (incf i)) s)
267            (progn (setf b (incf i)) 1)
268            (progn (setf c (incf i)) 4))
269           (progn (setf d (incf i)) "xyz"))
270     s i a b c d))
271  "xyz" "axyzefgh" 4 1 2 3 4)
272
273(deftest subseq.order.4
274  (let ((i 0) a b c
275        (s (copy-seq "abcd")))
276    (values
277     (setf (subseq
278            (progn (setf a (incf i)) s)
279            (progn (setf b (incf i)) 1))
280           (progn (setf c (incf i)) "xyz"))
281     s i a b c))
282  "xyz" "axyz" 3 1 2 3)
283
284;;; Constant folding
285
286(def-fold-test subseq.fold.1 (subseq '(1 2 3) 0))
287(def-fold-test subseq.fold.2 (subseq #(1 2 3) 0))
288(def-fold-test subseq.fold.3 (subseq #*011101 0))
289(def-fold-test subseq.fold.4 (subseq "abcdef" 0))
290
291;;; Error cases
292
293(deftest subseq.error.1
294  (signals-error (subseq) program-error)
295  t)
296
297(deftest subseq.error.2
298  (signals-error (subseq nil) program-error)
299  t)
300
301(deftest subseq.error.3
302  (signals-error (subseq nil 0 0 0) program-error)
303  t)
304
305
Note: See TracBrowser for help on using the repository browser.