30 |
(let ((y (subseq x i j))) |
(let ((y (subseq x i j))) |
31 |
(loop |
(loop |
32 |
for e in y and k from i to (1- j) do |
for e in y and k from i to (1- j) do |
33 |
(unless (eql e k) (return-from done nil))))))) |
(unless (eqlt e k) (return-from done nil))))))) |
34 |
t)) |
t)) |
35 |
|
|
36 |
(deftest subseq-list-4 |
(deftest subseq-list-4 |
42 |
(let ((x (loop for i from 0 to 29 collect i))) |
(let ((x (loop for i from 0 to 29 collect i))) |
43 |
(loop |
(loop |
44 |
for i from 0 to 30 do |
for i from 0 to 30 do |
45 |
(unless (equal (subseq x i) |
(unless (equalt (subseq x i) |
46 |
(loop for j from i to 29 collect j)) |
(loop for j from i to 29 collect j)) |
47 |
(return-from done nil)))) |
(return-from done nil)))) |
48 |
t)) |
t)) |
49 |
|
|
60 |
and f on y |
and f on y |
61 |
and g in z do |
and g in z do |
62 |
(when (or (not (eqt g e)) |
(when (or (not (eqt g e)) |
63 |
(not (eql (car e) (car f))) |
(not (eqlt (car e) (car f))) |
64 |
(car e) |
(car e) |
65 |
(eqt e f)) |
(eqt e f)) |
66 |
(return nil)) |
(return nil)) |
121 |
(return 1)) |
(return 1)) |
122 |
(unless (every #'(lambda (e) (eqt e 'a)) y) |
(unless (every #'(lambda (e) (eqt e 'a)) y) |
123 |
(return 2)) |
(return 2)) |
124 |
(unless (eql (length x) 10) (return 3)) |
(unless (eqlt (length x) 10) (return 3)) |
125 |
(unless (eql (length y) 4) (return 4)) |
(unless (eqlt (length y) 4) (return 4)) |
126 |
(loop for i from 0 to 9 do (setf (aref x i) 'b)) |
(loop for i from 0 to 9 do (setf (aref x i) 'b)) |
127 |
(unless (every #'(lambda (e) (eqt e 'a)) y) |
(unless (every #'(lambda (e) (eqt e 'a)) y) |
128 |
(return 5)) |
(return 5)) |
139 |
(block nil |
(block nil |
140 |
(let* ((x (make-sequence '(vector fixnum) 10 :initial-element 1)) |
(let* ((x (make-sequence '(vector fixnum) 10 :initial-element 1)) |
141 |
(y (subseq x 4 8))) |
(y (subseq x 4 8))) |
142 |
(unless (every #'(lambda (e) (eql e 1)) x) |
(unless (every #'(lambda (e) (eqlt e 1)) x) |
143 |
(return 1)) |
(return 1)) |
144 |
(unless (every #'(lambda (e) (eql e 1)) y) |
(unless (every #'(lambda (e) (eqlt e 1)) y) |
145 |
(return 2)) |
(return 2)) |
146 |
(unless (eql (length x) 10) (return 3)) |
(unless (eqlt (length x) 10) (return 3)) |
147 |
(unless (eql (length y) 4) (return 4)) |
(unless (eqlt (length y) 4) (return 4)) |
148 |
(loop for i from 0 to 9 do (setf (aref x i) 2)) |
(loop for i from 0 to 9 do (setf (aref x i) 2)) |
149 |
(unless (every #'(lambda (e) (eql e 1)) y) |
(unless (every #'(lambda (e) (eqlt e 1)) y) |
150 |
(return 5)) |
(return 5)) |
151 |
(loop for i from 0 to 3 do (setf (aref y i) 3)) |
(loop for i from 0 to 3 do (setf (aref y i) 3)) |
152 |
(or |
(or |
153 |
(not (not (every #'(lambda (e) (eql e 2)) x))) |
(not (not (every #'(lambda (e) (eqlt e 2)) x))) |
154 |
6)))) |
6)))) |
155 |
|
|
156 |
(deftest subseq-vector-2 |
(deftest subseq-vector-2 |
165 |
(return 1)) |
(return 1)) |
166 |
(unless (every #'(lambda (e) (= e 1.0)) y) |
(unless (every #'(lambda (e) (= e 1.0)) y) |
167 |
(return 2)) |
(return 2)) |
168 |
(unless (eql (length x) 10) (return 3)) |
(unless (eqlt (length x) 10) (return 3)) |
169 |
(unless (eql (length y) 4) (return 4)) |
(unless (eqlt (length y) 4) (return 4)) |
170 |
(loop for i from 0 to 9 do (setf (aref x i) 2.0)) |
(loop for i from 0 to 9 do (setf (aref x i) 2.0)) |
171 |
(unless (every #'(lambda (e) (= e 1.0)) y) |
(unless (every #'(lambda (e) (= e 1.0)) y) |
172 |
(return 5)) |
(return 5)) |
187 |
(return 1)) |
(return 1)) |
188 |
(unless (every #'(lambda (e) (= e 1.0)) y) |
(unless (every #'(lambda (e) (= e 1.0)) y) |
189 |
(return 2)) |
(return 2)) |
190 |
(unless (eql (length x) 10) (return 3)) |
(unless (eqlt (length x) 10) (return 3)) |
191 |
(unless (eql (length y) 4) (return 4)) |
(unless (eqlt (length y) 4) (return 4)) |
192 |
(loop for i from 0 to 9 do (setf (aref x i) 2.0d0)) |
(loop for i from 0 to 9 do (setf (aref x i) 2.0d0)) |
193 |
(unless (every #'(lambda (e) (= e 1.0)) y) |
(unless (every #'(lambda (e) (= e 1.0)) y) |
194 |
(return 5)) |
(return 5)) |
209 |
(return 1)) |
(return 1)) |
210 |
(unless (every #'(lambda (e) (= e 1.0)) y) |
(unless (every #'(lambda (e) (= e 1.0)) y) |
211 |
(return 2)) |
(return 2)) |
212 |
(unless (eql (length x) 10) (return 3)) |
(unless (eqlt (length x) 10) (return 3)) |
213 |
(unless (eql (length y) 4) (return 4)) |
(unless (eqlt (length y) 4) (return 4)) |
214 |
(loop for i from 0 to 9 do (setf (aref x i) 2.0s0)) |
(loop for i from 0 to 9 do (setf (aref x i) 2.0s0)) |
215 |
(unless (every #'(lambda (e) (= e 1.0)) y) |
(unless (every #'(lambda (e) (= e 1.0)) y) |
216 |
(return 5)) |
(return 5)) |
220 |
6)))) |
6)))) |
221 |
|
|
222 |
(deftest subseq-vector-5 |
(deftest subseq-vector-5 |
223 |
(subseq-vector-5-body) |
(subseq-vector-5-body) |
224 |
t) |
t) |
225 |
|
|
226 |
(defun subseq-vector-6-body () |
(defun subseq-vector-6-body () |
231 |
(return 1)) |
(return 1)) |
232 |
(unless (every #'(lambda (e) (= e 1.0)) y) |
(unless (every #'(lambda (e) (= e 1.0)) y) |
233 |
(return 2)) |
(return 2)) |
234 |
(unless (eql (length x) 10) (return 3)) |
(unless (eqlt (length x) 10) (return 3)) |
235 |
(unless (eql (length y) 4) (return 4)) |
(unless (eqlt (length y) 4) (return 4)) |
236 |
(loop for i from 0 to 9 do (setf (aref x i) 2.0l0)) |
(loop for i from 0 to 9 do (setf (aref x i) 2.0l0)) |
237 |
(unless (every #'(lambda (e) (= e 1.0)) y) |
(unless (every #'(lambda (e) (= e 1.0)) y) |
238 |
(return 5)) |
(return 5)) |
242 |
6)))) |
6)))) |
243 |
|
|
244 |
(deftest subseq-vector-6 |
(deftest subseq-vector-6 |
245 |
(subseq-vector-6-body) |
(subseq-vector-6-body) |
|
t) |
|
|
|
|
|
;;; slipped this in here for the moment |
|
|
(deftest copy-seq-vector-1 |
|
|
(let* ((x (make-array '(10) :initial-contents '(a b c d e f g h i j))) |
|
|
(y (copy-seq x))) |
|
|
(equal-array x y)) |
|
246 |
t) |
t) |
247 |
|
|
248 |
(deftest subseq-vector-7 |
(deftest subseq-vector-7 |
255 |
(let* ((x (make-array '(200) :initial-element 107 |
(let* ((x (make-array '(200) :initial-element 107 |
256 |
:element-type 'fixnum)) |
:element-type 'fixnum)) |
257 |
(y (subseq x 17 95))) |
(y (subseq x 17 95))) |
258 |
(and (eql (length y) (- 95 17)) |
(and (eqlt (length y) (- 95 17)) |
259 |
(equal-array y |
(equal-array y |
260 |
(make-array (list (- 95 17)) |
(make-array (list (- 95 17)) |
261 |
:initial-element 107 |
:initial-element 107 |
268 |
(lo 164) |
(lo 164) |
269 |
(hi 873) |
(hi 873) |
270 |
(y (subseq x lo hi))) |
(y (subseq x lo hi))) |
271 |
(and (eql (length y) (- hi lo)) |
(and (eqlt (length y) (- hi lo)) |
272 |
(equal-array y |
(equal-array y |
273 |
(make-array (list (- hi lo)) |
(make-array (list (- hi lo)) |
274 |
:initial-element 17.6e-1 |
:initial-element 17.6e-1 |
281 |
(lo 731) |
(lo 731) |
282 |
(hi 1942) |
(hi 1942) |
283 |
(y (subseq x lo hi))) |
(y (subseq x lo hi))) |
284 |
(and (eql (length y) (- hi lo)) |
(and (eqlt (length y) (- hi lo)) |
285 |
(equal-array y |
(equal-array y |
286 |
(make-array (list (- hi lo)) |
(make-array (list (- hi lo)) |
287 |
:initial-element 3.1415927d4 |
:initial-element 3.1415927d4 |
288 |
:element-type 'double-float)))) |
:element-type 'double-float)))) |
289 |
t) |
t) |
290 |
|
|
291 |
|
;;; subseq on strings |
292 |
|
|
293 |
|
(deftest subseq-string-1 |
294 |
|
(let* ((s1 "abcdefgh") |
295 |
|
(len (length s1))) |
296 |
|
(loop for start from 0 below len |
297 |
|
always |
298 |
|
(string= (subseq s1 start) |
299 |
|
(coerce (loop for i from start to (1- len) |
300 |
|
collect (aref s1 i)) |
301 |
|
'string)))) |
302 |
|
t) |
303 |
|
|
304 |
|
(deftest subseq-string-2 |
305 |
|
(let* ((s1 "abcdefgh") |
306 |
|
(len (length s1))) |
307 |
|
(loop for start from 0 below len |
308 |
|
always |
309 |
|
(loop for end from (1+ start) to len |
310 |
|
always |
311 |
|
(string= (subseq s1 start end) |
312 |
|
(coerce (loop for i from start below end |
313 |
|
collect (aref s1 i)) |
314 |
|
'string))))) |
315 |
|
t) |
316 |
|
|
317 |
|
(deftest subseq-string-3 |
318 |
|
(let* ((s1 (make-array '(10) :initial-contents |
319 |
|
(coerce "abcdefghij" 'list) |
320 |
|
:fill-pointer 8 |
321 |
|
:element-type 'character)) |
322 |
|
(len (length s1))) |
323 |
|
(and |
324 |
|
(eqlt len 8) |
325 |
|
(loop for start from 0 below len |
326 |
|
always |
327 |
|
(string= (subseq s1 start) |
328 |
|
(coerce (loop for i from start to (1- len) |
329 |
|
collect (aref s1 i)) |
330 |
|
'string))) |
331 |
|
(loop for start from 0 below len |
332 |
|
always |
333 |
|
(loop for end from (1+ start) to len |
334 |
|
always |
335 |
|
(string= (subseq s1 start end) |
336 |
|
(coerce (loop for i from start below end |
337 |
|
collect (aref s1 i)) |
338 |
|
'string)))))) |
339 |
|
t) |
340 |
|
|
341 |
|
;;; Tests on bit vectors |
342 |
|
|
343 |
|
(deftest subseq-bit-vector-1 |
344 |
|
(let* ((s1 #*11001000) |
345 |
|
(len (length s1))) |
346 |
|
(loop for start from 0 below len |
347 |
|
always |
348 |
|
(equalp (subseq s1 start) |
349 |
|
(coerce (loop for i from start to (1- len) |
350 |
|
collect (aref s1 i)) |
351 |
|
'bit-vector)))) |
352 |
|
t) |
353 |
|
|
354 |
|
(deftest subseq-bit-vector-2 |
355 |
|
(let* ((s1 #*01101011) |
356 |
|
(len (length s1))) |
357 |
|
(loop for start from 0 below len |
358 |
|
always |
359 |
|
(loop for end from (1+ start) to len |
360 |
|
always |
361 |
|
(equalp (subseq s1 start end) |
362 |
|
(coerce (loop for i from start below end |
363 |
|
collect (aref s1 i)) |
364 |
|
'bit-vector))))) |
365 |
|
t) |
366 |
|
|
367 |
|
(deftest subseq-bit-vector-3 |
368 |
|
(let* ((s1 (make-array '(10) :initial-contents |
369 |
|
(coerce #*1101100110 'list) |
370 |
|
:fill-pointer 8 |
371 |
|
:element-type 'bit)) |
372 |
|
(len (length s1))) |
373 |
|
(and |
374 |
|
(eqlt len 8) |
375 |
|
(loop for start from 0 below len |
376 |
|
always |
377 |
|
(equalp (subseq s1 start) |
378 |
|
(coerce (loop for i from start to (1- len) |
379 |
|
collect (aref s1 i)) |
380 |
|
'bit-vector))) |
381 |
|
(loop for start from 0 below len |
382 |
|
always |
383 |
|
(loop for end from (1+ start) to len |
384 |
|
always |
385 |
|
(equalp (subseq s1 start end) |
386 |
|
(coerce (loop for i from start below end |
387 |
|
collect (aref s1 i)) |
388 |
|
'bit-vector)))))) |
389 |
|
t) |