subseq.lsp 6.78 KB
Newer Older
1
2
3
4
5
6
7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Oct 12 19:41:14 2002
;;;; Contains: Tests on SUBSEQ

(in-package :cl-test)

8
9
(compile-and-load "subseq-aux.lsp")

10
11
12
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; subseq, on lists

13
(deftest subseq-list.1
14
15
16
  (subseq '(a b c d e) 0 0)
  nil)

17
(deftest subseq-list.2
18
19
20
  (subseq '(a b c) 0)
  (a b c))

21
(deftest subseq-list.3
22
23
24
25
  (subseq '(a b c) 1)
  (b c))


26
27
(deftest subseq-list.4
  (subseq-list.4-body)
28
29
  t)

30
31
(deftest subseq-list.5
  (subseq-list.5-body)
32
33
  t)

34
35
(deftest subseq-list.6    ;; check that no structure is shared
  (subseq-list.6-body)
36
37
  t)

38
(deftest subseq-list.7
39
40
41
42
43
  (let ((x (loop for i from 0 to 9 collect i)))
    (setf (subseq x 0 3) (list 'a 'b 'c))
    x)
  (a b c 3 4 5 6 7 8 9))

44
(deftest subseq-list.8
45
46
47
48
49
50
  (let* ((x '(a b c d e))
	 (y (copy-seq x)))
    (setf (subseq y 0) '(f g h))
    (list x y))
  ((a b c d e) (f g h d e)))

51
(deftest subseq-list.9
52
53
54
55
56
57
  (let* ((x '(a b c d e))
	 (y (copy-seq x)))
    (setf (subseq y 1 3) '(1 2 3 4 5))
    (list x y))
  ((a b c d e) (a 1 2 d e)))

58
(deftest subseq-list.10
59
60
61
62
63
64
  (let* ((x '(a b c d e))
	 (y (copy-seq x)))
    (setf (subseq y 5) '(1 2 3 4 5))
    (list x y))
  ((a b c d e) (a b c d e)))

65
(deftest subseq-list.11
66
67
68
69
70
71
  (let* ((x '(a b c d e))
	 (y (copy-seq x)))
    (setf (subseq y 2 5) '(1))
    (list x y))
  ((a b c d e) (a b 1 d e)))

72
(deftest subseq-list.12
73
74
75
76
77
78
79
80
81
  (let* ((x '(a b c d e))
	 (y (copy-seq x)))
    (setf (subseq y 0 0) '(1 2))
    (list x y))
  ((a b c d e) (a b c d e)))

;; subseq on vectors


82
83
(deftest subseq-vector.1
  (subseq-vector.1-body)
84
  t)
85
86


87
88
(deftest subseq-vector.2
    (subseq-vector.2-body)
89
90
91
  t) 


92
93
(deftest subseq-vector.3
    (subseq-vector.3-body)
94
95
  t) 

96
97
(deftest subseq-vector.4
    (subseq-vector.4-body)
98
99
  t) 

100
101
(deftest subseq-vector.5
  (subseq-vector.5-body)
102
103
  t) 

104
105
(deftest subseq-vector.6
  (subseq-vector.6-body)
106
107
  t)

108
(deftest subseq-vector.7
109
110
111
112
113
    (let* ((x (make-array '(10) :initial-contents '(a b c d e f g h i j)))
	   (y (subseq x 2 8)))
      (equal-array y (make-array '(6) :initial-contents '(c d e f g h))))
  t)

114
(deftest subseq-vector.8
115
116
117
    (let* ((x (make-array '(200) :initial-element 107
			  :element-type 'fixnum))
	   (y (subseq x 17 95)))
118
      (and (eqlt (length y) (- 95 17))
119
120
121
122
123
124
	   (equal-array y
			(make-array (list (- 95 17))
				    :initial-element 107
				    :element-type 'fixnum))))
  t)

125
(deftest subseq-vector.9
pfdietz's avatar
pfdietz committed
126
    (let* ((x (make-array '(1000) :initial-element 17.6e-1
127
128
129
130
			  :element-type 'single-float))
	   (lo 164)
	   (hi 873)
	   (y (subseq x lo hi)))
131
      (and (eqlt (length y) (- hi lo))
132
133
	   (equal-array y
			(make-array (list (- hi lo))
pfdietz's avatar
pfdietz committed
134
				    :initial-element 17.6e-1
135
136
137
				    :element-type 'single-float))))
  t)

138
(deftest subseq-vector.10
139
140
141
142
143
    (let* ((x (make-array '(2000) :initial-element 3.1415927d4
			  :element-type 'double-float))
	   (lo 731)
	   (hi 1942)
	   (y (subseq x lo hi)))
144
      (and (eqlt (length y) (- hi lo))
145
146
147
148
149
150
	   (equal-array y
			(make-array (list (- hi lo))
				    :initial-element  3.1415927d4
				    :element-type 'double-float))))
  t)

151
152
;;; subseq on strings

153
154
(deftest subseq-string.1
  (subseq-string.1-body)
155
156
  t)

157
158
(deftest subseq-string.2
  (subseq-string.2-body)
159
160
  t)

161
162
(deftest subseq-string.3
  (subseq-string.3-body)
163
164
  t)

165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
;;; Specialized string tests

(deftest subseq.specialized-string.1
  (let* ((s0 "abcde")
	 (len (length s0)))
    (do-special-strings
     (s "abcde" nil)
     (loop for i from 0 below len
	   for s1 = (subseq s i)
	   do (assert (typep s1 'simple-array))
	   do (assert (string= (subseq s i) (subseq s0 i)))
	   do (loop for j from i to len
		    for s2 = (subseq s i j)
		    do (assert (typep s2 'simple-array))
		    (assert (string= s2 (subseq s0 i j)))))))
  nil)

182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
;;; Other specialized vectors

(deftest subseq.specialized-vector.1
  (let* ((v0 #(1 0 1 1 0 1 1 0))
	 (len (length v0)))
    (do-special-integer-vectors
     (v (copy-seq v0) nil)
     (loop for i from 0 below len
	   for v1 = (subseq v i)
	   do (assert (typep v1 'simple-array))
	   do (assert (equalp (subseq v i) (subseq v0 i)))
	   do (loop for j from i to len
		    for v2 = (subseq v i j)
		    do (assert (typep v2 'simple-array))
		    (assert (equalp v2 (subseq v0 i j)))))))
  nil)

(deftest subseq.specialized-vector.2
  (loop for type in '(short-float single-float long-float double-float)
	for len = 10
	for vals = (loop for i from 1 to len collect (coerce i type))
	for vec = (make-array len :element-type type :initial-contents vals)
	for result = (subseq vec 1 9)
	unless (and (= (length result) 8)
		    (equal (array-element-type vec) (array-element-type result))
		    (equalp result (apply #'vector (subseq vals 1 9))))
	collect (list type vals result))
  nil)

(deftest subseq.specialized-vector.3
  (loop for etype in '(short-float single-float long-float double-float
				   integer rational)
	for type = `(complex ,etype)
	for len = 10
	for vals = (loop for i from 1 to len collect (complex (coerce i etype)
							      (coerce (- i) etype)))
	for vec = (make-array len :element-type type :initial-contents vals)
	for result = (subseq vec 1 9)
	unless (and (= (length result) 8)
		    (equal (array-element-type vec) (array-element-type result))
		    (equalp result (apply #'vector (subseq vals 1 9))))
	collect (list type vals result))
  nil)

226
227
;;; Tests on bit vectors

228
229
(deftest subseq-bit-vector.1
  (subseq-bit-vector.1-body)
230
231
  t)

232
233
(deftest subseq-bit-vector.2
  (subseq-bit-vector.2-body)
234
235
  t)

236
237
(deftest subseq-bit-vector.3
  (subseq-bit-vector.3-body)
238
  t)
239

240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
;;; Order of evaluation

(deftest subseq.order.1
  (let ((i 0) a b c)
    (values
     (subseq
      (progn (setf a (incf i)) "abcdefgh")
      (progn (setf b (incf i)) 1)
      (progn (setf c (incf i)) 4))
     i a b c))
  "bcd" 3 1 2 3)

(deftest subseq.order.2
  (let ((i 0) a b)
    (values
     (subseq
      (progn (setf a (incf i)) "abcdefgh")
      (progn (setf b (incf i)) 1))
     i a b))
  "bcdefgh" 2 1 2)

(deftest subseq.order.3
  (let ((i 0) a b c d
	(s (copy-seq "abcdefgh")))
    (values
     (setf (subseq
	    (progn (setf a (incf i)) s)
	    (progn (setf b (incf i)) 1)
	    (progn (setf c (incf i)) 4))
	   (progn (setf d (incf i)) "xyz"))
     s i a b c d))
  "xyz" "axyzefgh" 4 1 2 3 4)

(deftest subseq.order.4
  (let ((i 0) a b c
	(s (copy-seq "abcd")))
    (values
     (setf (subseq
	    (progn (setf a (incf i)) s)
	    (progn (setf b (incf i)) 1))
	   (progn (setf c (incf i)) "xyz"))
     s i a b c))
  "xyz" "axyz" 3 1 2 3)

284
285
;;; Constant folding

286
287
288
289
(def-fold-test subseq.fold.1 (subseq '(1 2 3) 0))
(def-fold-test subseq.fold.2 (subseq #(1 2 3) 0))
(def-fold-test subseq.fold.3 (subseq #*011101 0))
(def-fold-test subseq.fold.4 (subseq "abcdef" 0))
290

291
292
293
;;; Error cases

(deftest subseq.error.1
294
295
  (signals-error (subseq) program-error)
  t)
296
297

(deftest subseq.error.2
298
299
  (signals-error (subseq nil) program-error)
  t)
300
301

(deftest subseq.error.3
302
303
  (signals-error (subseq nil 0 0 0) program-error)
  t)
304
305