tests.lisp - clic - Clic is an command line interactive client for gopher writt… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
tests.lisp (54526B) | |
--- | |
1 (in-package :cl-user) | |
2 | |
3 (defpackage :alexandria-tests | |
4 (:use :cl :alexandria #+sbcl :sb-rt #-sbcl :rtest) | |
5 (:import-from #+sbcl :sb-rt #-sbcl :rtest | |
6 #:*compile-tests* #:*expected-failures*)) | |
7 | |
8 (in-package :alexandria-tests) | |
9 | |
10 (defun run-tests (&key ((:compiled *compile-tests*))) | |
11 (do-tests)) | |
12 | |
13 (defun hash-table-test-name (name) | |
14 ;; Workaround for Clisp calling EQL in a hash-table FASTHASH-EQL. | |
15 (hash-table-test (make-hash-table :test name))) | |
16 | |
17 ;;;; Arrays | |
18 | |
19 (deftest copy-array.1 | |
20 (let* ((orig (vector 1 2 3)) | |
21 (copy (copy-array orig))) | |
22 (values (eq orig copy) (equalp orig copy))) | |
23 nil t) | |
24 | |
25 (deftest copy-array.2 | |
26 (let ((orig (make-array 1024 :fill-pointer 0))) | |
27 (vector-push-extend 1 orig) | |
28 (vector-push-extend 2 orig) | |
29 (vector-push-extend 3 orig) | |
30 (let ((copy (copy-array orig))) | |
31 (values (eq orig copy) (equalp orig copy) | |
32 (array-has-fill-pointer-p copy) | |
33 (eql (fill-pointer orig) (fill-pointer copy))))) | |
34 nil t t t) | |
35 | |
36 (deftest copy-array.3 | |
37 (let* ((orig (vector 1 2 3)) | |
38 (copy (copy-array orig))) | |
39 (typep copy 'simple-array)) | |
40 t) | |
41 | |
42 (deftest copy-array.4 | |
43 (let ((orig (make-array 21 | |
44 :adjustable t | |
45 :fill-pointer 0))) | |
46 (dotimes (n 42) | |
47 (vector-push-extend n orig)) | |
48 (let ((copy (copy-array orig | |
49 :adjustable nil | |
50 :fill-pointer nil))) | |
51 (typep copy 'simple-array))) | |
52 t) | |
53 | |
54 (deftest array-index.1 | |
55 (typep 0 'array-index) | |
56 t) | |
57 | |
58 ;;;; Conditions | |
59 | |
60 (deftest unwind-protect-case.1 | |
61 (let (result) | |
62 (unwind-protect-case () | |
63 (random 10) | |
64 (:normal (push :normal result)) | |
65 (:abort (push :abort result)) | |
66 (:always (push :always result))) | |
67 result) | |
68 (:always :normal)) | |
69 | |
70 (deftest unwind-protect-case.2 | |
71 (let (result) | |
72 (unwind-protect-case () | |
73 (random 10) | |
74 (:always (push :always result)) | |
75 (:normal (push :normal result)) | |
76 (:abort (push :abort result))) | |
77 result) | |
78 (:normal :always)) | |
79 | |
80 (deftest unwind-protect-case.3 | |
81 (let (result1 result2 result3) | |
82 (ignore-errors | |
83 (unwind-protect-case () | |
84 (error "FOOF!") | |
85 (:normal (push :normal result1)) | |
86 (:abort (push :abort result1)) | |
87 (:always (push :always result1)))) | |
88 (catch 'foof | |
89 (unwind-protect-case () | |
90 (throw 'foof 42) | |
91 (:normal (push :normal result2)) | |
92 (:abort (push :abort result2)) | |
93 (:always (push :always result2)))) | |
94 (block foof | |
95 (unwind-protect-case () | |
96 (return-from foof 42) | |
97 (:normal (push :normal result3)) | |
98 (:abort (push :abort result3)) | |
99 (:always (push :always result3)))) | |
100 (values result1 result2 result3)) | |
101 (:always :abort) | |
102 (:always :abort) | |
103 (:always :abort)) | |
104 | |
105 (deftest unwind-protect-case.4 | |
106 (let (result) | |
107 (unwind-protect-case (aborted-p) | |
108 (random 42) | |
109 (:always (setq result aborted-p))) | |
110 result) | |
111 nil) | |
112 | |
113 (deftest unwind-protect-case.5 | |
114 (let (result) | |
115 (block foof | |
116 (unwind-protect-case (aborted-p) | |
117 (return-from foof) | |
118 (:always (setq result aborted-p)))) | |
119 result) | |
120 t) | |
121 | |
122 ;;;; Control flow | |
123 | |
124 (deftest switch.1 | |
125 (switch (13 :test =) | |
126 (12 :oops) | |
127 (13.0 :yay)) | |
128 :yay) | |
129 | |
130 (deftest switch.2 | |
131 (switch (13) | |
132 ((+ 12 2) :oops) | |
133 ((- 13 1) :oops2) | |
134 (t :yay)) | |
135 :yay) | |
136 | |
137 (deftest eswitch.1 | |
138 (let ((x 13)) | |
139 (eswitch (x :test =) | |
140 (12 :oops) | |
141 (13.0 :yay))) | |
142 :yay) | |
143 | |
144 (deftest eswitch.2 | |
145 (let ((x 13)) | |
146 (eswitch (x :key 1+) | |
147 (11 :oops) | |
148 (14 :yay))) | |
149 :yay) | |
150 | |
151 (deftest cswitch.1 | |
152 (cswitch (13 :test =) | |
153 (12 :oops) | |
154 (13.0 :yay)) | |
155 :yay) | |
156 | |
157 (deftest cswitch.2 | |
158 (cswitch (13 :key 1-) | |
159 (12 :yay) | |
160 (13.0 :oops)) | |
161 :yay) | |
162 | |
163 (deftest multiple-value-prog2.1 | |
164 (multiple-value-prog2 | |
165 (values 1 1 1) | |
166 (values 2 20 200) | |
167 (values 3 3 3)) | |
168 2 20 200) | |
169 | |
170 (deftest nth-value-or.1 | |
171 (multiple-value-bind (a b c) | |
172 (nth-value-or 1 | |
173 (values 1 nil 1) | |
174 (values 2 2 2)) | |
175 (= a b c 2)) | |
176 t) | |
177 | |
178 (deftest whichever.1 | |
179 (let ((x (whichever 1 2 3))) | |
180 (and (member x '(1 2 3)) t)) | |
181 t) | |
182 | |
183 (deftest whichever.2 | |
184 (let* ((a 1) | |
185 (b 2) | |
186 (c 3) | |
187 (x (whichever a b c))) | |
188 (and (member x '(1 2 3)) t)) | |
189 t) | |
190 | |
191 ;; https://gitlab.common-lisp.net/alexandria/alexandria/issues/13 | |
192 (deftest whichever.3 | |
193 (multiple-value-bind (code warnings?) | |
194 (compile nil `(lambda (x) | |
195 (whichever (1+ x)))) | |
196 (and (not warnings?) | |
197 (= 6 (funcall code 5)))) | |
198 t) | |
199 | |
200 (deftest xor.1 | |
201 (xor nil nil 1 nil) | |
202 1 | |
203 t) | |
204 | |
205 (deftest xor.2 | |
206 (xor nil nil 1 2) | |
207 nil | |
208 nil) | |
209 | |
210 (deftest xor.3 | |
211 (xor nil nil nil) | |
212 nil | |
213 t) | |
214 | |
215 ;;;; Definitions | |
216 | |
217 (deftest define-constant.1 | |
218 (let ((name (gensym))) | |
219 (eval `(define-constant ,name "FOO" :test 'equal)) | |
220 (eval `(define-constant ,name "FOO" :test 'equal)) | |
221 (values (equal "FOO" (symbol-value name)) | |
222 (constantp name))) | |
223 t | |
224 t) | |
225 | |
226 (deftest define-constant.2 | |
227 (let ((name (gensym))) | |
228 (eval `(define-constant ,name 13)) | |
229 (eval `(define-constant ,name 13)) | |
230 (values (eql 13 (symbol-value name)) | |
231 (constantp name))) | |
232 t | |
233 t) | |
234 | |
235 ;;;; Errors | |
236 | |
237 ;;; TYPEP is specified to return a generalized boolean and, for | |
238 ;;; example, ECL exploits this by returning the superclasses of ERROR | |
239 ;;; in this case. | |
240 (defun errorp (x) | |
241 (not (null (typep x 'error)))) | |
242 | |
243 (deftest required-argument.1 | |
244 (multiple-value-bind (res err) | |
245 (ignore-errors (required-argument)) | |
246 (errorp err)) | |
247 t) | |
248 | |
249 ;;;; Hash tables | |
250 | |
251 (deftest ensure-gethash.1 | |
252 (let ((table (make-hash-table)) | |
253 (x (list 1))) | |
254 (multiple-value-bind (value already-there) | |
255 (ensure-gethash x table 42) | |
256 (and (= value 42) | |
257 (not already-there) | |
258 (= 42 (gethash x table)) | |
259 (multiple-value-bind (value2 already-there2) | |
260 (ensure-gethash x table 13) | |
261 (and (= value2 42) | |
262 already-there2 | |
263 (= 42 (gethash x table))))))) | |
264 t) | |
265 | |
266 (deftest ensure-gethash.2 | |
267 (let ((table (make-hash-table)) | |
268 (count 0)) | |
269 (multiple-value-call #'values | |
270 (ensure-gethash (progn (incf count) :foo) | |
271 (progn (incf count) table) | |
272 (progn (incf count) :bar)) | |
273 (gethash :foo table) | |
274 count)) | |
275 :bar nil :bar t 3) | |
276 | |
277 (deftest copy-hash-table.1 | |
278 (let ((orig (make-hash-table :test 'eq :size 123)) | |
279 (foo "foo")) | |
280 (setf (gethash orig orig) t | |
281 (gethash foo orig) t) | |
282 (let ((eq-copy (copy-hash-table orig)) | |
283 (eql-copy (copy-hash-table orig :test 'eql)) | |
284 (equal-copy (copy-hash-table orig :test 'equal)) | |
285 (equalp-copy (copy-hash-table orig :test 'equalp))) | |
286 (list (eql (hash-table-size eq-copy) (hash-table-size orig)) | |
287 (eql (hash-table-rehash-size eq-copy) | |
288 (hash-table-rehash-size orig)) | |
289 (hash-table-count eql-copy) | |
290 (gethash orig eq-copy) | |
291 (gethash (copy-seq foo) eql-copy) | |
292 (gethash foo eql-copy) | |
293 (gethash (copy-seq foo) equal-copy) | |
294 (gethash "FOO" equal-copy) | |
295 (gethash "FOO" equalp-copy)))) | |
296 (t t 2 t nil t t nil t)) | |
297 | |
298 (deftest copy-hash-table.2 | |
299 (let ((ht (make-hash-table)) | |
300 (list (list :list (vector :A :B :C)))) | |
301 (setf (gethash 'list ht) list) | |
302 (let* ((shallow-copy (copy-hash-table ht)) | |
303 (deep1-copy (copy-hash-table ht :key 'copy-list)) | |
304 (list (gethash 'list ht)) | |
305 (shallow-list (gethash 'list shallow-copy)) | |
306 (deep1-list (gethash 'list deep1-copy))) | |
307 (list (eq ht shallow-copy) | |
308 (eq ht deep1-copy) | |
309 (eq list shallow-list) | |
310 (eq list deep1-list) ; outer list was co… | |
311 (eq (second list) (second shallow-list)) | |
312 (eq (second list) (second deep1-list)) ; inner vector wasn… | |
313 ))) | |
314 (nil nil t nil t t)) | |
315 | |
316 (deftest maphash-keys.1 | |
317 (let ((keys nil) | |
318 (table (make-hash-table))) | |
319 (declare (notinline maphash-keys)) | |
320 (dotimes (i 10) | |
321 (setf (gethash i table) t)) | |
322 (maphash-keys (lambda (k) (push k keys)) table) | |
323 (set-equal keys '(0 1 2 3 4 5 6 7 8 9))) | |
324 t) | |
325 | |
326 (deftest maphash-values.1 | |
327 (let ((vals nil) | |
328 (table (make-hash-table))) | |
329 (declare (notinline maphash-values)) | |
330 (dotimes (i 10) | |
331 (setf (gethash i table) (- i))) | |
332 (maphash-values (lambda (v) (push v vals)) table) | |
333 (set-equal vals '(0 -1 -2 -3 -4 -5 -6 -7 -8 -9))) | |
334 t) | |
335 | |
336 (deftest hash-table-keys.1 | |
337 (let ((table (make-hash-table))) | |
338 (dotimes (i 10) | |
339 (setf (gethash i table) t)) | |
340 (set-equal (hash-table-keys table) '(0 1 2 3 4 5 6 7 8 9))) | |
341 t) | |
342 | |
343 (deftest hash-table-values.1 | |
344 (let ((table (make-hash-table))) | |
345 (dotimes (i 10) | |
346 (setf (gethash (gensym) table) i)) | |
347 (set-equal (hash-table-values table) '(0 1 2 3 4 5 6 7 8 9))) | |
348 t) | |
349 | |
350 (deftest hash-table-alist.1 | |
351 (let ((table (make-hash-table))) | |
352 (dotimes (i 10) | |
353 (setf (gethash i table) (- i))) | |
354 (let ((alist (hash-table-alist table))) | |
355 (list (length alist) | |
356 (assoc 0 alist) | |
357 (assoc 3 alist) | |
358 (assoc 9 alist) | |
359 (assoc nil alist)))) | |
360 (10 (0 . 0) (3 . -3) (9 . -9) nil)) | |
361 | |
362 (deftest hash-table-plist.1 | |
363 (let ((table (make-hash-table))) | |
364 (dotimes (i 10) | |
365 (setf (gethash i table) (- i))) | |
366 (let ((plist (hash-table-plist table))) | |
367 (list (length plist) | |
368 (getf plist 0) | |
369 (getf plist 2) | |
370 (getf plist 7) | |
371 (getf plist nil)))) | |
372 (20 0 -2 -7 nil)) | |
373 | |
374 (deftest alist-hash-table.1 | |
375 (let* ((alist '((0 a) (1 b) (2 c))) | |
376 (table (alist-hash-table alist))) | |
377 (list (hash-table-count table) | |
378 (gethash 0 table) | |
379 (gethash 1 table) | |
380 (gethash 2 table) | |
381 (eq (hash-table-test-name 'eql) | |
382 (hash-table-test table)))) | |
383 (3 (a) (b) (c) t)) | |
384 | |
385 (deftest alist-hash-table.duplicate-keys | |
386 (let* ((alist '((0 a) (1 b) (0 c) (1 d) (2 e))) | |
387 (table (alist-hash-table alist))) | |
388 (list (hash-table-count table) | |
389 (gethash 0 table) | |
390 (gethash 1 table) | |
391 (gethash 2 table))) | |
392 (3 (a) (b) (e))) | |
393 | |
394 (deftest plist-hash-table.1 | |
395 (let* ((plist '(:a 1 :b 2 :c 3)) | |
396 (table (plist-hash-table plist :test 'eq))) | |
397 (list (hash-table-count table) | |
398 (gethash :a table) | |
399 (gethash :b table) | |
400 (gethash :c table) | |
401 (gethash 2 table) | |
402 (gethash nil table) | |
403 (eq (hash-table-test-name 'eq) | |
404 (hash-table-test table)))) | |
405 (3 1 2 3 nil nil t)) | |
406 | |
407 (deftest plist-hash-table.duplicate-keys | |
408 (let* ((plist '(:a 1 :b 2 :a 3 :b 4 :c 5)) | |
409 (table (plist-hash-table plist))) | |
410 (list (hash-table-count table) | |
411 (gethash :a table) | |
412 (gethash :b table) | |
413 (gethash :c table))) | |
414 (3 1 2 5)) | |
415 | |
416 ;;;; Functions | |
417 | |
418 (deftest disjoin.1 | |
419 (let ((disjunction (disjoin (lambda (x) | |
420 (and (consp x) :cons)) | |
421 (lambda (x) | |
422 (and (stringp x) :string))))) | |
423 (list (funcall disjunction 'zot) | |
424 (funcall disjunction '(foo bar)) | |
425 (funcall disjunction "test"))) | |
426 (nil :cons :string)) | |
427 | |
428 (deftest disjoin.2 | |
429 (let ((disjunction (disjoin #'zerop))) | |
430 (list (funcall disjunction 0) | |
431 (funcall disjunction 1))) | |
432 (t nil)) | |
433 | |
434 (deftest conjoin.1 | |
435 (let ((conjunction (conjoin #'consp | |
436 (lambda (x) | |
437 (stringp (car x))) | |
438 (lambda (x) | |
439 (char (car x) 0))))) | |
440 (list (funcall conjunction 'zot) | |
441 (funcall conjunction '(foo)) | |
442 (funcall conjunction '("foo")))) | |
443 (nil nil #\f)) | |
444 | |
445 (deftest conjoin.2 | |
446 (let ((conjunction (conjoin #'zerop))) | |
447 (list (funcall conjunction 0) | |
448 (funcall conjunction 1))) | |
449 (t nil)) | |
450 | |
451 (deftest compose.1 | |
452 (let ((composite (compose '1+ | |
453 (lambda (x) | |
454 (* x 2)) | |
455 #'read-from-string))) | |
456 (funcall composite "1")) | |
457 3) | |
458 | |
459 (deftest compose.2 | |
460 (let ((composite | |
461 (locally (declare (notinline compose)) | |
462 (compose '1+ | |
463 (lambda (x) | |
464 (* x 2)) | |
465 #'read-from-string)))) | |
466 (funcall composite "2")) | |
467 5) | |
468 | |
469 (deftest compose.3 | |
470 (let ((compose-form (funcall (compiler-macro-function 'compose) | |
471 '(compose '1+ | |
472 (lambda (x) | |
473 (* x 2)) | |
474 #'read-from-string) | |
475 nil))) | |
476 (let ((fun (funcall (compile nil `(lambda () ,compose-form))))) | |
477 (funcall fun "3"))) | |
478 7) | |
479 | |
480 (deftest compose.4 | |
481 (let ((composite (compose #'zerop))) | |
482 (list (funcall composite 0) | |
483 (funcall composite 1))) | |
484 (t nil)) | |
485 | |
486 (deftest multiple-value-compose.1 | |
487 (let ((composite (multiple-value-compose | |
488 #'truncate | |
489 (lambda (x y) | |
490 (values y x)) | |
491 (lambda (x) | |
492 (with-input-from-string (s x) | |
493 (values (read s) (read s))))))) | |
494 (multiple-value-list (funcall composite "2 7"))) | |
495 (3 1)) | |
496 | |
497 (deftest multiple-value-compose.2 | |
498 (let ((composite (locally (declare (notinline multiple-value-compose… | |
499 (multiple-value-compose | |
500 #'truncate | |
501 (lambda (x y) | |
502 (values y x)) | |
503 (lambda (x) | |
504 (with-input-from-string (s x) | |
505 (values (read s) (read s)))))))) | |
506 (multiple-value-list (funcall composite "2 11"))) | |
507 (5 1)) | |
508 | |
509 (deftest multiple-value-compose.3 | |
510 (let ((compose-form (funcall (compiler-macro-function 'multiple-valu… | |
511 '(multiple-value-compose | |
512 #'truncate | |
513 (lambda (x y) | |
514 (values y x)) | |
515 (lambda (x) | |
516 (with-input-from-string (s x) | |
517 (values (read s) (read s))))) | |
518 nil))) | |
519 (let ((fun (funcall (compile nil `(lambda () ,compose-form))))) | |
520 (multiple-value-list (funcall fun "2 9")))) | |
521 (4 1)) | |
522 | |
523 (deftest multiple-value-compose.4 | |
524 (let ((composite (multiple-value-compose #'truncate))) | |
525 (multiple-value-list (funcall composite 9 2))) | |
526 (4 1)) | |
527 | |
528 (deftest curry.1 | |
529 (let ((curried (curry '+ 3))) | |
530 (funcall curried 1 5)) | |
531 9) | |
532 | |
533 (deftest curry.2 | |
534 (let ((curried (locally (declare (notinline curry)) | |
535 (curry '* 2 3)))) | |
536 (funcall curried 7)) | |
537 42) | |
538 | |
539 (deftest curry.3 | |
540 (let ((curried-form (funcall (compiler-macro-function 'curry) | |
541 '(curry '/ 8) | |
542 nil))) | |
543 (let ((fun (funcall (compile nil `(lambda () ,curried-form))))) | |
544 (funcall fun 2))) | |
545 4) | |
546 | |
547 (deftest curry.4 | |
548 (let* ((x 1) | |
549 (curried (curry (progn | |
550 (incf x) | |
551 (lambda (y z) (* x y z))) | |
552 3))) | |
553 (list (funcall curried 7) | |
554 (funcall curried 7) | |
555 x)) | |
556 (42 42 2)) | |
557 | |
558 (deftest rcurry.1 | |
559 (let ((r (rcurry '/ 2))) | |
560 (funcall r 8)) | |
561 4) | |
562 | |
563 (deftest rcurry.2 | |
564 (let* ((x 1) | |
565 (curried (rcurry (progn | |
566 (incf x) | |
567 (lambda (y z) (* x y z))) | |
568 3))) | |
569 (list (funcall curried 7) | |
570 (funcall curried 7) | |
571 x)) | |
572 (42 42 2)) | |
573 | |
574 (deftest named-lambda.1 | |
575 (let ((fac (named-lambda fac (x) | |
576 (if (> x 1) | |
577 (* x (fac (- x 1))) | |
578 x)))) | |
579 (funcall fac 5)) | |
580 120) | |
581 | |
582 (deftest named-lambda.2 | |
583 (let ((fac (named-lambda fac (&key x) | |
584 (if (> x 1) | |
585 (* x (fac :x (- x 1))) | |
586 x)))) | |
587 (funcall fac :x 5)) | |
588 120) | |
589 | |
590 ;;;; Lists | |
591 | |
592 (deftest alist-plist.1 | |
593 (alist-plist '((a . 1) (b . 2) (c . 3))) | |
594 (a 1 b 2 c 3)) | |
595 | |
596 (deftest plist-alist.1 | |
597 (plist-alist '(a 1 b 2 c 3)) | |
598 ((a . 1) (b . 2) (c . 3))) | |
599 | |
600 (deftest unionf.1 | |
601 (let* ((list (list 1 2 3)) | |
602 (orig list)) | |
603 (unionf list (list 1 2 4)) | |
604 (values (equal orig (list 1 2 3)) | |
605 (eql (length list) 4) | |
606 (set-difference list (list 1 2 3 4)) | |
607 (set-difference (list 1 2 3 4) list))) | |
608 t | |
609 t | |
610 nil | |
611 nil) | |
612 | |
613 (deftest nunionf.1 | |
614 (let ((list (list 1 2 3))) | |
615 (nunionf list (list 1 2 4)) | |
616 (values (eql (length list) 4) | |
617 (set-difference (list 1 2 3 4) list) | |
618 (set-difference list (list 1 2 3 4)))) | |
619 t | |
620 nil | |
621 nil) | |
622 | |
623 (deftest appendf.1 | |
624 (let* ((list (list 1 2 3)) | |
625 (orig list)) | |
626 (appendf list '(4 5 6) '(7 8)) | |
627 (list list (eq list orig))) | |
628 ((1 2 3 4 5 6 7 8) nil)) | |
629 | |
630 (deftest nconcf.1 | |
631 (let ((list1 (list 1 2 3)) | |
632 (list2 (list 4 5 6))) | |
633 (nconcf list1 list2 (list 7 8 9)) | |
634 list1) | |
635 (1 2 3 4 5 6 7 8 9)) | |
636 | |
637 (deftest circular-list.1 | |
638 (let ((circle (circular-list 1 2 3))) | |
639 (list (first circle) | |
640 (second circle) | |
641 (third circle) | |
642 (fourth circle) | |
643 (eq circle (nthcdr 3 circle)))) | |
644 (1 2 3 1 t)) | |
645 | |
646 (deftest circular-list-p.1 | |
647 (let* ((circle (circular-list 1 2 3 4)) | |
648 (tree (list circle circle)) | |
649 (dotted (cons circle t)) | |
650 (proper (list 1 2 3 circle)) | |
651 (tailcirc (list* 1 2 3 circle))) | |
652 (list (circular-list-p circle) | |
653 (circular-list-p tree) | |
654 (circular-list-p dotted) | |
655 (circular-list-p proper) | |
656 (circular-list-p tailcirc))) | |
657 (t nil nil nil t)) | |
658 | |
659 (deftest circular-list-p.2 | |
660 (circular-list-p 'foo) | |
661 nil) | |
662 | |
663 (deftest circular-tree-p.1 | |
664 (let* ((circle (circular-list 1 2 3 4)) | |
665 (tree1 (list circle circle)) | |
666 (tree2 (let* ((level2 (list 1 nil 2)) | |
667 (level1 (list level2))) | |
668 (setf (second level2) level1) | |
669 level1)) | |
670 (dotted (cons circle t)) | |
671 (proper (list 1 2 3 circle)) | |
672 (tailcirc (list* 1 2 3 circle)) | |
673 (quite-proper (list 1 2 3)) | |
674 (quite-dotted (list 1 (cons 2 3)))) | |
675 (list (circular-tree-p circle) | |
676 (circular-tree-p tree1) | |
677 (circular-tree-p tree2) | |
678 (circular-tree-p dotted) | |
679 (circular-tree-p proper) | |
680 (circular-tree-p tailcirc) | |
681 (circular-tree-p quite-proper) | |
682 (circular-tree-p quite-dotted))) | |
683 (t t t t t t nil nil)) | |
684 | |
685 (deftest circular-tree-p.2 | |
686 (alexandria:circular-tree-p '#1=(#1#)) | |
687 t) | |
688 | |
689 (deftest proper-list-p.1 | |
690 (let ((l1 (list 1)) | |
691 (l2 (list 1 2)) | |
692 (l3 (cons 1 2)) | |
693 (l4 (list (cons 1 2) 3)) | |
694 (l5 (circular-list 1 2))) | |
695 (list (proper-list-p l1) | |
696 (proper-list-p l2) | |
697 (proper-list-p l3) | |
698 (proper-list-p l4) | |
699 (proper-list-p l5))) | |
700 (t t nil t nil)) | |
701 | |
702 (deftest proper-list-p.2 | |
703 (proper-list-p '(1 2 . 3)) | |
704 nil) | |
705 | |
706 (deftest proper-list.type.1 | |
707 (let ((l1 (list 1)) | |
708 (l2 (list 1 2)) | |
709 (l3 (cons 1 2)) | |
710 (l4 (list (cons 1 2) 3)) | |
711 (l5 (circular-list 1 2))) | |
712 (list (typep l1 'proper-list) | |
713 (typep l2 'proper-list) | |
714 (typep l3 'proper-list) | |
715 (typep l4 'proper-list) | |
716 (typep l5 'proper-list))) | |
717 (t t nil t nil)) | |
718 | |
719 (deftest proper-list-length.1 | |
720 (values | |
721 (proper-list-length nil) | |
722 (proper-list-length (list 1)) | |
723 (proper-list-length (list 2 2)) | |
724 (proper-list-length (list 3 3 3)) | |
725 (proper-list-length (list 4 4 4 4)) | |
726 (proper-list-length (list 5 5 5 5 5)) | |
727 (proper-list-length (list 6 6 6 6 6 6)) | |
728 (proper-list-length (list 7 7 7 7 7 7 7)) | |
729 (proper-list-length (list 8 8 8 8 8 8 8 8)) | |
730 (proper-list-length (list 9 9 9 9 9 9 9 9 9))) | |
731 0 1 2 3 4 5 6 7 8 9) | |
732 | |
733 (deftest proper-list-length.2 | |
734 (flet ((plength (x) | |
735 (handler-case | |
736 (proper-list-length x) | |
737 (type-error () | |
738 :ok)))) | |
739 (values | |
740 (plength (list* 1)) | |
741 (plength (list* 2 2)) | |
742 (plength (list* 3 3 3)) | |
743 (plength (list* 4 4 4 4)) | |
744 (plength (list* 5 5 5 5 5)) | |
745 (plength (list* 6 6 6 6 6 6)) | |
746 (plength (list* 7 7 7 7 7 7 7)) | |
747 (plength (list* 8 8 8 8 8 8 8 8)) | |
748 (plength (list* 9 9 9 9 9 9 9 9 9)))) | |
749 :ok :ok :ok | |
750 :ok :ok :ok | |
751 :ok :ok :ok) | |
752 | |
753 (deftest lastcar.1 | |
754 (let ((l1 (list 1)) | |
755 (l2 (list 1 2))) | |
756 (list (lastcar l1) | |
757 (lastcar l2))) | |
758 (1 2)) | |
759 | |
760 (deftest lastcar.error.2 | |
761 (handler-case | |
762 (progn | |
763 (lastcar (circular-list 1 2 3)) | |
764 nil) | |
765 (error () | |
766 t)) | |
767 t) | |
768 | |
769 (deftest setf-lastcar.1 | |
770 (let ((l (list 1 2 3 4))) | |
771 (values (lastcar l) | |
772 (progn | |
773 (setf (lastcar l) 42) | |
774 (lastcar l)))) | |
775 4 | |
776 42) | |
777 | |
778 (deftest setf-lastcar.2 | |
779 (let ((l (circular-list 1 2 3))) | |
780 (multiple-value-bind (res err) | |
781 (ignore-errors (setf (lastcar l) 4)) | |
782 (typep err 'type-error))) | |
783 t) | |
784 | |
785 (deftest make-circular-list.1 | |
786 (let ((l (make-circular-list 3 :initial-element :x))) | |
787 (setf (car l) :y) | |
788 (list (eq l (nthcdr 3 l)) | |
789 (first l) | |
790 (second l) | |
791 (third l) | |
792 (fourth l))) | |
793 (t :y :x :x :y)) | |
794 | |
795 (deftest circular-list.type.1 | |
796 (let* ((l1 (list 1 2 3)) | |
797 (l2 (circular-list 1 2 3)) | |
798 (l3 (list* 1 2 3 l2))) | |
799 (list (typep l1 'circular-list) | |
800 (typep l2 'circular-list) | |
801 (typep l3 'circular-list))) | |
802 (nil t t)) | |
803 | |
804 (deftest ensure-list.1 | |
805 (let ((x (list 1)) | |
806 (y 2)) | |
807 (list (ensure-list x) | |
808 (ensure-list y))) | |
809 ((1) (2))) | |
810 | |
811 (deftest ensure-cons.1 | |
812 (let ((x (cons 1 2)) | |
813 (y nil) | |
814 (z "foo")) | |
815 (values (ensure-cons x) | |
816 (ensure-cons y) | |
817 (ensure-cons z))) | |
818 (1 . 2) | |
819 (nil) | |
820 ("foo")) | |
821 | |
822 (deftest setp.1 | |
823 (setp '(1)) | |
824 t) | |
825 | |
826 (deftest setp.2 | |
827 (setp nil) | |
828 t) | |
829 | |
830 (deftest setp.3 | |
831 (setp "foo") | |
832 nil) | |
833 | |
834 (deftest setp.4 | |
835 (setp '(1 2 3 1)) | |
836 nil) | |
837 | |
838 (deftest setp.5 | |
839 (setp '(1 2 3)) | |
840 t) | |
841 | |
842 (deftest setp.6 | |
843 (setp '(a :a)) | |
844 t) | |
845 | |
846 (deftest setp.7 | |
847 (setp '(a :a) :key 'character) | |
848 nil) | |
849 | |
850 (deftest setp.8 | |
851 (setp '(a :a) :key 'character :test (constantly nil)) | |
852 t) | |
853 | |
854 (deftest set-equal.1 | |
855 (set-equal '(1 2 3) '(3 1 2)) | |
856 t) | |
857 | |
858 (deftest set-equal.2 | |
859 (set-equal '("Xa") '("Xb") | |
860 :test (lambda (a b) (eql (char a 0) (char b 0)))) | |
861 t) | |
862 | |
863 (deftest set-equal.3 | |
864 (set-equal '(1 2) '(4 2)) | |
865 nil) | |
866 | |
867 (deftest set-equal.4 | |
868 (set-equal '(a b c) '(:a :b :c) :key 'string :test 'equal) | |
869 t) | |
870 | |
871 (deftest set-equal.5 | |
872 (set-equal '(a d c) '(:a :b :c) :key 'string :test 'equal) | |
873 nil) | |
874 | |
875 (deftest set-equal.6 | |
876 (set-equal '(a b c) '(a b c d)) | |
877 nil) | |
878 | |
879 (deftest map-product.1 | |
880 (map-product 'cons '(2 3) '(1 4)) | |
881 ((2 . 1) (2 . 4) (3 . 1) (3 . 4))) | |
882 | |
883 (deftest map-product.2 | |
884 (map-product #'cons '(2 3) '(1 4)) | |
885 ((2 . 1) (2 . 4) (3 . 1) (3 . 4))) | |
886 | |
887 (deftest flatten.1 | |
888 (flatten '((1) 2 (((3 4))) ((((5)) 6)) 7)) | |
889 (1 2 3 4 5 6 7)) | |
890 | |
891 (deftest remove-from-plist.1 | |
892 (let ((orig '(a 1 b 2 c 3 d 4))) | |
893 (list (remove-from-plist orig 'a 'c) | |
894 (remove-from-plist orig 'b 'd) | |
895 (remove-from-plist orig 'b) | |
896 (remove-from-plist orig 'a) | |
897 (remove-from-plist orig 'd 42 "zot") | |
898 (remove-from-plist orig 'a 'b 'c 'd) | |
899 (remove-from-plist orig 'a 'b 'c 'd 'x) | |
900 (equal orig '(a 1 b 2 c 3 d 4)))) | |
901 ((b 2 d 4) | |
902 (a 1 c 3) | |
903 (a 1 c 3 d 4) | |
904 (b 2 c 3 d 4) | |
905 (a 1 b 2 c 3) | |
906 nil | |
907 nil | |
908 t)) | |
909 | |
910 (deftest delete-from-plist.1 | |
911 (let ((orig '(a 1 b 2 c 3 d 4 d 5))) | |
912 (list (delete-from-plist (copy-list orig) 'a 'c) | |
913 (delete-from-plist (copy-list orig) 'b 'd) | |
914 (delete-from-plist (copy-list orig) 'b) | |
915 (delete-from-plist (copy-list orig) 'a) | |
916 (delete-from-plist (copy-list orig) 'd 42 "zot") | |
917 (delete-from-plist (copy-list orig) 'a 'b 'c 'd) | |
918 (delete-from-plist (copy-list orig) 'a 'b 'c 'd 'x) | |
919 (equal orig (delete-from-plist orig)) | |
920 (eq orig (delete-from-plist orig)))) | |
921 ((b 2 d 4 d 5) | |
922 (a 1 c 3) | |
923 (a 1 c 3 d 4 d 5) | |
924 (b 2 c 3 d 4 d 5) | |
925 (a 1 b 2 c 3) | |
926 nil | |
927 nil | |
928 t | |
929 t)) | |
930 | |
931 (deftest mappend.1 | |
932 (mappend (compose 'list '*) '(1 2 3) '(1 2 3)) | |
933 (1 4 9)) | |
934 | |
935 (deftest assoc-value.1 | |
936 (let ((key1 '(complex key)) | |
937 (key2 'simple-key) | |
938 (alist '()) | |
939 (result '())) | |
940 (push 1 (assoc-value alist key1 :test #'equal)) | |
941 (push 2 (assoc-value alist key1 :test 'equal)) | |
942 (push 42 (assoc-value alist key2)) | |
943 (push 43 (assoc-value alist key2 :test 'eq)) | |
944 (push (assoc-value alist key1 :test #'equal) result) | |
945 (push (assoc-value alist key2) result) | |
946 | |
947 (push 'very (rassoc-value alist (list 2 1) :test #'equal)) | |
948 (push (cdr (assoc '(very complex key) alist :test #'equal)) result) | |
949 result) | |
950 ((2 1) (43 42) (2 1))) | |
951 | |
952 ;;;; Numbers | |
953 | |
954 (deftest clamp.1 | |
955 (list (clamp 1.5 1 2) | |
956 (clamp 2.0 1 2) | |
957 (clamp 1.0 1 2) | |
958 (clamp 3 1 2) | |
959 (clamp 0 1 2)) | |
960 (1.5 2.0 1.0 2 1)) | |
961 | |
962 (deftest gaussian-random.1 | |
963 (let ((min -0.2) | |
964 (max +0.2)) | |
965 (multiple-value-bind (g1 g2) | |
966 (gaussian-random min max) | |
967 (values (<= min g1 max) | |
968 (<= min g2 max) | |
969 (/= g1 g2) ;uh | |
970 ))) | |
971 t | |
972 t | |
973 t) | |
974 | |
975 #+sbcl | |
976 (deftest gaussian-random.2 | |
977 (handler-case | |
978 (sb-ext:with-timeout 2 | |
979 (progn | |
980 (loop | |
981 :repeat 10000 | |
982 :do (gaussian-random 0 nil)) | |
983 'done)) | |
984 (sb-ext:timeout () | |
985 'timed-out)) | |
986 done) | |
987 | |
988 (deftest iota.1 | |
989 (iota 3) | |
990 (0 1 2)) | |
991 | |
992 (deftest iota.2 | |
993 (iota 3 :start 0.0d0) | |
994 (0.0d0 1.0d0 2.0d0)) | |
995 | |
996 (deftest iota.3 | |
997 (iota 3 :start 2 :step 3.0) | |
998 (2.0 5.0 8.0)) | |
999 | |
1000 (deftest map-iota.1 | |
1001 (let (all) | |
1002 (declare (notinline map-iota)) | |
1003 (values (map-iota (lambda (x) (push x all)) | |
1004 3 | |
1005 :start 2 | |
1006 :step 1.1d0) | |
1007 all)) | |
1008 3 | |
1009 (4.2d0 3.1d0 2.0d0)) | |
1010 | |
1011 (deftest lerp.1 | |
1012 (lerp 0.5 1 2) | |
1013 1.5) | |
1014 | |
1015 (deftest lerp.2 | |
1016 (lerp 0.1 1 2) | |
1017 1.1) | |
1018 | |
1019 (deftest lerp.3 | |
1020 (lerp 0.1 4 25) | |
1021 6.1) | |
1022 | |
1023 (deftest mean.1 | |
1024 (mean '(1 2 3)) | |
1025 2) | |
1026 | |
1027 (deftest mean.2 | |
1028 (mean '(1 2 3 4)) | |
1029 5/2) | |
1030 | |
1031 (deftest mean.3 | |
1032 (mean '(1 2 10)) | |
1033 13/3) | |
1034 | |
1035 (deftest median.1 | |
1036 (median '(100 0 99 1 98 2 97)) | |
1037 97) | |
1038 | |
1039 (deftest median.2 | |
1040 (median '(100 0 99 1 98 2 97 96)) | |
1041 193/2) | |
1042 | |
1043 (deftest variance.1 | |
1044 (variance (list 1 2 3)) | |
1045 2/3) | |
1046 | |
1047 (deftest standard-deviation.1 | |
1048 (< 0 (standard-deviation (list 1 2 3)) 1) | |
1049 t) | |
1050 | |
1051 (deftest maxf.1 | |
1052 (let ((x 1)) | |
1053 (maxf x 2) | |
1054 x) | |
1055 2) | |
1056 | |
1057 (deftest maxf.2 | |
1058 (let ((x 1)) | |
1059 (maxf x 0) | |
1060 x) | |
1061 1) | |
1062 | |
1063 (deftest maxf.3 | |
1064 (let ((x 1) | |
1065 (c 0)) | |
1066 (maxf x (incf c)) | |
1067 (list x c)) | |
1068 (1 1)) | |
1069 | |
1070 (deftest maxf.4 | |
1071 (let ((xv (vector 0 0 0)) | |
1072 (p 0)) | |
1073 (maxf (svref xv (incf p)) (incf p)) | |
1074 (list p xv)) | |
1075 (2 #(0 2 0))) | |
1076 | |
1077 (deftest minf.1 | |
1078 (let ((y 1)) | |
1079 (minf y 0) | |
1080 y) | |
1081 0) | |
1082 | |
1083 (deftest minf.2 | |
1084 (let ((xv (vector 10 10 10)) | |
1085 (p 0)) | |
1086 (minf (svref xv (incf p)) (incf p)) | |
1087 (list p xv)) | |
1088 (2 #(10 2 10))) | |
1089 | |
1090 (deftest subfactorial.1 | |
1091 (mapcar #'subfactorial (iota 22)) | |
1092 (1 | |
1093 0 | |
1094 1 | |
1095 2 | |
1096 9 | |
1097 44 | |
1098 265 | |
1099 1854 | |
1100 14833 | |
1101 133496 | |
1102 1334961 | |
1103 14684570 | |
1104 176214841 | |
1105 2290792932 | |
1106 32071101049 | |
1107 481066515734 | |
1108 7697064251745 | |
1109 130850092279664 | |
1110 2355301661033953 | |
1111 44750731559645106 | |
1112 895014631192902121 | |
1113 18795307255050944540)) | |
1114 | |
1115 ;;;; Arrays | |
1116 | |
1117 #+nil | |
1118 (deftest array-index.type) | |
1119 | |
1120 #+nil | |
1121 (deftest copy-array) | |
1122 | |
1123 ;;;; Sequences | |
1124 | |
1125 (deftest rotate.1 | |
1126 (list (rotate (list 1 2 3) 0) | |
1127 (rotate (list 1 2 3) 1) | |
1128 (rotate (list 1 2 3) 2) | |
1129 (rotate (list 1 2 3) 3) | |
1130 (rotate (list 1 2 3) 4)) | |
1131 ((1 2 3) | |
1132 (3 1 2) | |
1133 (2 3 1) | |
1134 (1 2 3) | |
1135 (3 1 2))) | |
1136 | |
1137 (deftest rotate.2 | |
1138 (list (rotate (vector 1 2 3 4) 0) | |
1139 (rotate (vector 1 2 3 4)) | |
1140 (rotate (vector 1 2 3 4) 2) | |
1141 (rotate (vector 1 2 3 4) 3) | |
1142 (rotate (vector 1 2 3 4) 4) | |
1143 (rotate (vector 1 2 3 4) 5)) | |
1144 (#(1 2 3 4) | |
1145 #(4 1 2 3) | |
1146 #(3 4 1 2) | |
1147 #(2 3 4 1) | |
1148 #(1 2 3 4) | |
1149 #(4 1 2 3))) | |
1150 | |
1151 (deftest rotate.3 | |
1152 (list (rotate (list 1 2 3) 0) | |
1153 (rotate (list 1 2 3) -1) | |
1154 (rotate (list 1 2 3) -2) | |
1155 (rotate (list 1 2 3) -3) | |
1156 (rotate (list 1 2 3) -4)) | |
1157 ((1 2 3) | |
1158 (2 3 1) | |
1159 (3 1 2) | |
1160 (1 2 3) | |
1161 (2 3 1))) | |
1162 | |
1163 (deftest rotate.4 | |
1164 (list (rotate (vector 1 2 3 4) 0) | |
1165 (rotate (vector 1 2 3 4) -1) | |
1166 (rotate (vector 1 2 3 4) -2) | |
1167 (rotate (vector 1 2 3 4) -3) | |
1168 (rotate (vector 1 2 3 4) -4) | |
1169 (rotate (vector 1 2 3 4) -5)) | |
1170 (#(1 2 3 4) | |
1171 #(2 3 4 1) | |
1172 #(3 4 1 2) | |
1173 #(4 1 2 3) | |
1174 #(1 2 3 4) | |
1175 #(2 3 4 1))) | |
1176 | |
1177 (deftest rotate.5 | |
1178 (values (rotate (list 1) 17) | |
1179 (rotate (list 1) -5)) | |
1180 (1) | |
1181 (1)) | |
1182 | |
1183 (deftest shuffle.1 | |
1184 (let ((s (shuffle (iota 100)))) | |
1185 (list (equal s (iota 100)) | |
1186 (every (lambda (x) | |
1187 (member x s)) | |
1188 (iota 100)) | |
1189 (every (lambda (x) | |
1190 (typep x '(integer 0 99))) | |
1191 s))) | |
1192 (nil t t)) | |
1193 | |
1194 (deftest shuffle.2 | |
1195 (let ((s (shuffle (coerce (iota 100) 'vector)))) | |
1196 (list (equal s (coerce (iota 100) 'vector)) | |
1197 (every (lambda (x) | |
1198 (find x s)) | |
1199 (iota 100)) | |
1200 (every (lambda (x) | |
1201 (typep x '(integer 0 99))) | |
1202 s))) | |
1203 (nil t t)) | |
1204 | |
1205 (deftest shuffle.3 | |
1206 (let* ((orig (coerce (iota 21) 'vector)) | |
1207 (copy (copy-seq orig))) | |
1208 (shuffle copy :start 10 :end 15) | |
1209 (list (every #'eql (subseq copy 0 10) (subseq orig 0 10)) | |
1210 (every #'eql (subseq copy 15) (subseq orig 15)))) | |
1211 (t t)) | |
1212 | |
1213 (deftest random-elt.1 | |
1214 (let ((s1 #(1 2 3 4)) | |
1215 (s2 '(1 2 3 4))) | |
1216 (list (dotimes (i 1000 nil) | |
1217 (unless (member (random-elt s1) s2) | |
1218 (return nil)) | |
1219 (when (/= (random-elt s1) (random-elt s1)) | |
1220 (return t))) | |
1221 (dotimes (i 1000 nil) | |
1222 (unless (member (random-elt s2) s2) | |
1223 (return nil)) | |
1224 (when (/= (random-elt s2) (random-elt s2)) | |
1225 (return t))))) | |
1226 (t t)) | |
1227 | |
1228 (deftest removef.1 | |
1229 (let* ((x '(1 2 3)) | |
1230 (x* x) | |
1231 (y #(1 2 3)) | |
1232 (y* y)) | |
1233 (removef x 1) | |
1234 (removef y 3) | |
1235 (list x x* y y*)) | |
1236 ((2 3) | |
1237 (1 2 3) | |
1238 #(1 2) | |
1239 #(1 2 3))) | |
1240 | |
1241 (deftest deletef.1 | |
1242 (let* ((x (list 1 2 3)) | |
1243 (x* x) | |
1244 (y (vector 1 2 3))) | |
1245 (deletef x 2) | |
1246 (deletef y 1) | |
1247 (list x x* y)) | |
1248 ((1 3) | |
1249 (1 3) | |
1250 #(2 3))) | |
1251 | |
1252 (deftest map-permutations.1 | |
1253 (let ((seq (list 1 2 3)) | |
1254 (seen nil) | |
1255 (ok t)) | |
1256 (map-permutations (lambda (s) | |
1257 (unless (set-equal s seq) | |
1258 (setf ok nil)) | |
1259 (when (member s seen :test 'equal) | |
1260 (setf ok nil)) | |
1261 (push s seen)) | |
1262 seq | |
1263 :copy t) | |
1264 (values ok (length seen))) | |
1265 t | |
1266 6) | |
1267 | |
1268 (deftest proper-sequence.type.1 | |
1269 (mapcar (lambda (x) | |
1270 (typep x 'proper-sequence)) | |
1271 (list (list 1 2 3) | |
1272 (vector 1 2 3) | |
1273 #2a((1 2) (3 4)) | |
1274 (circular-list 1 2 3 4))) | |
1275 (t t nil nil)) | |
1276 | |
1277 (deftest emptyp.1 | |
1278 (mapcar #'emptyp | |
1279 (list (list 1) | |
1280 (circular-list 1) | |
1281 nil | |
1282 (vector) | |
1283 (vector 1))) | |
1284 (nil nil t t nil)) | |
1285 | |
1286 (deftest sequence-of-length-p.1 | |
1287 (mapcar #'sequence-of-length-p | |
1288 (list nil | |
1289 #() | |
1290 (list 1) | |
1291 (vector 1) | |
1292 (list 1 2) | |
1293 (vector 1 2) | |
1294 (list 1 2) | |
1295 (vector 1 2) | |
1296 (list 1 2) | |
1297 (vector 1 2)) | |
1298 (list 0 | |
1299 0 | |
1300 1 | |
1301 1 | |
1302 2 | |
1303 2 | |
1304 1 | |
1305 1 | |
1306 4 | |
1307 4)) | |
1308 (t t t t t t nil nil nil nil)) | |
1309 | |
1310 (deftest length=.1 | |
1311 (mapcar #'length= | |
1312 (list nil | |
1313 #() | |
1314 (list 1) | |
1315 (vector 1) | |
1316 (list 1 2) | |
1317 (vector 1 2) | |
1318 (list 1 2) | |
1319 (vector 1 2) | |
1320 (list 1 2) | |
1321 (vector 1 2)) | |
1322 (list 0 | |
1323 0 | |
1324 1 | |
1325 1 | |
1326 2 | |
1327 2 | |
1328 1 | |
1329 1 | |
1330 4 | |
1331 4)) | |
1332 (t t t t t t nil nil nil nil)) | |
1333 | |
1334 (deftest length=.2 | |
1335 ;; test the compiler macro | |
1336 (macrolet ((x (&rest args) | |
1337 (funcall | |
1338 (compile nil | |
1339 `(lambda () | |
1340 (length= ,@args)))))) | |
1341 (list (x 2 '(1 2)) | |
1342 (x '(1 2) '(3 4)) | |
1343 (x '(1 2) 2) | |
1344 (x '(1 2) 2 '(3 4)) | |
1345 (x 1 2 3))) | |
1346 (t t t t nil)) | |
1347 | |
1348 (deftest copy-sequence.1 | |
1349 (let ((l (list 1 2 3)) | |
1350 (v (vector #\a #\b #\c))) | |
1351 (declare (notinline copy-sequence)) | |
1352 (let ((l.list (copy-sequence 'list l)) | |
1353 (l.vector (copy-sequence 'vector l)) | |
1354 (l.spec-v (copy-sequence '(vector fixnum) l)) | |
1355 (v.vector (copy-sequence 'vector v)) | |
1356 (v.list (copy-sequence 'list v)) | |
1357 (v.string (copy-sequence 'string v))) | |
1358 (list (member l (list l.list l.vector l.spec-v)) | |
1359 (member v (list v.vector v.list v.string)) | |
1360 (equal l.list l) | |
1361 (equalp l.vector #(1 2 3)) | |
1362 (type= (upgraded-array-element-type 'fixnum) | |
1363 (array-element-type l.spec-v)) | |
1364 (equalp v.vector v) | |
1365 (equal v.list '(#\a #\b #\c)) | |
1366 (equal "abc" v.string)))) | |
1367 (nil nil t t t t t t)) | |
1368 | |
1369 (deftest first-elt.1 | |
1370 (mapcar #'first-elt | |
1371 (list (list 1 2 3) | |
1372 "abc" | |
1373 (vector :a :b :c))) | |
1374 (1 #\a :a)) | |
1375 | |
1376 (deftest first-elt.error.1 | |
1377 (mapcar (lambda (x) | |
1378 (handler-case | |
1379 (first-elt x) | |
1380 (type-error () | |
1381 :type-error))) | |
1382 (list nil | |
1383 #() | |
1384 12 | |
1385 :zot)) | |
1386 (:type-error | |
1387 :type-error | |
1388 :type-error | |
1389 :type-error)) | |
1390 | |
1391 (deftest setf-first-elt.1 | |
1392 (let ((l (list 1 2 3)) | |
1393 (s (copy-seq "foobar")) | |
1394 (v (vector :a :b :c))) | |
1395 (setf (first-elt l) -1 | |
1396 (first-elt s) #\x | |
1397 (first-elt v) 'zot) | |
1398 (values l s v)) | |
1399 (-1 2 3) | |
1400 "xoobar" | |
1401 #(zot :b :c)) | |
1402 | |
1403 (deftest setf-first-elt.error.1 | |
1404 (let ((l 'foo)) | |
1405 (multiple-value-bind (res err) | |
1406 (ignore-errors (setf (first-elt l) 4)) | |
1407 (typep err 'type-error))) | |
1408 t) | |
1409 | |
1410 (deftest last-elt.1 | |
1411 (mapcar #'last-elt | |
1412 (list (list 1 2 3) | |
1413 (vector :a :b :c) | |
1414 "FOOBAR" | |
1415 #*001 | |
1416 #*010)) | |
1417 (3 :c #\R 1 0)) | |
1418 | |
1419 (deftest last-elt.error.1 | |
1420 (mapcar (lambda (x) | |
1421 (handler-case | |
1422 (last-elt x) | |
1423 (type-error () | |
1424 :type-error))) | |
1425 (list nil | |
1426 #() | |
1427 12 | |
1428 :zot | |
1429 (circular-list 1 2 3) | |
1430 (list* 1 2 3 (circular-list 4 5)))) | |
1431 (:type-error | |
1432 :type-error | |
1433 :type-error | |
1434 :type-error | |
1435 :type-error | |
1436 :type-error)) | |
1437 | |
1438 (deftest setf-last-elt.1 | |
1439 (let ((l (list 1 2 3)) | |
1440 (s (copy-seq "foobar")) | |
1441 (b (copy-seq #*010101001))) | |
1442 (setf (last-elt l) '??? | |
1443 (last-elt s) #\? | |
1444 (last-elt b) 0) | |
1445 (values l s b)) | |
1446 (1 2 ???) | |
1447 "fooba?" | |
1448 #*010101000) | |
1449 | |
1450 (deftest setf-last-elt.error.1 | |
1451 (handler-case | |
1452 (setf (last-elt 'foo) 13) | |
1453 (type-error () | |
1454 :type-error)) | |
1455 :type-error) | |
1456 | |
1457 (deftest starts-with.1 | |
1458 (list (starts-with 1 '(1 2 3)) | |
1459 (starts-with 1 #(1 2 3)) | |
1460 (starts-with #\x "xyz") | |
1461 (starts-with 2 '(1 2 3)) | |
1462 (starts-with 3 #(1 2 3)) | |
1463 (starts-with 1 1) | |
1464 (starts-with nil nil)) | |
1465 (t t t nil nil nil nil)) | |
1466 | |
1467 (deftest starts-with.2 | |
1468 (values (starts-with 1 '(-1 2 3) :key '-) | |
1469 (starts-with "foo" '("foo" "bar") :test 'equal) | |
1470 (starts-with "f" '(#\f) :key 'string :test 'equal) | |
1471 (starts-with -1 '(0 1 2) :key #'1+) | |
1472 (starts-with "zot" '("ZOT") :test 'equal)) | |
1473 t | |
1474 t | |
1475 t | |
1476 nil | |
1477 nil) | |
1478 | |
1479 (deftest ends-with.1 | |
1480 (list (ends-with 3 '(1 2 3)) | |
1481 (ends-with 3 #(1 2 3)) | |
1482 (ends-with #\z "xyz") | |
1483 (ends-with 2 '(1 2 3)) | |
1484 (ends-with 1 #(1 2 3)) | |
1485 (ends-with 1 1) | |
1486 (ends-with nil nil)) | |
1487 (t t t nil nil nil nil)) | |
1488 | |
1489 (deftest ends-with.2 | |
1490 (values (ends-with 2 '(0 13 1) :key '1+) | |
1491 (ends-with "foo" (vector "bar" "foo") :test 'equal) | |
1492 (ends-with "X" (vector 1 2 #\X) :key 'string :test 'equal) | |
1493 (ends-with "foo" "foo" :test 'equal)) | |
1494 t | |
1495 t | |
1496 t | |
1497 nil) | |
1498 | |
1499 (deftest ends-with.error.1 | |
1500 (handler-case | |
1501 (ends-with 3 (circular-list 3 3 3 1 3 3)) | |
1502 (type-error () | |
1503 :type-error)) | |
1504 :type-error) | |
1505 | |
1506 (deftest sequences.passing-improper-lists | |
1507 (macrolet ((signals-error-p (form) | |
1508 `(handler-case | |
1509 (progn ,form nil) | |
1510 (type-error (e) | |
1511 t))) | |
1512 (cut (fn &rest args) | |
1513 (with-gensyms (arg) | |
1514 (print`(lambda (,arg) | |
1515 (apply ,fn (list ,@(substitute arg '_ args)))))))) | |
1516 (let ((circular-list (make-circular-list 5 :initial-element :foo)) | |
1517 (dotted-list (list* 'a 'b 'c 'd))) | |
1518 (loop for nth from 0 | |
1519 for fn in (list | |
1520 (cut #'lastcar _) | |
1521 (cut #'rotate _ 3) | |
1522 (cut #'rotate _ -3) | |
1523 (cut #'shuffle _) | |
1524 (cut #'random-elt _) | |
1525 (cut #'last-elt _) | |
1526 (cut #'ends-with :foo _)) | |
1527 nconcing | |
1528 (let ((on-circular-p (signals-error-p (funcall fn circu… | |
1529 (on-dotted-p (signals-error-p (funcall fn dotted-… | |
1530 (when (or (not on-circular-p) (not on-dotted-p)) | |
1531 (append | |
1532 (unless on-circular-p | |
1533 (let ((*print-circle* t)) | |
1534 (list | |
1535 (format nil | |
1536 "No appropriate error signalled when … | |
1537 circular-list nth)))) | |
1538 (unless on-dotted-p | |
1539 (list | |
1540 (format nil | |
1541 "No appropriate error signalled when pa… | |
1542 dotted-list nth))))))))) | |
1543 nil) | |
1544 | |
1545 ;;;; IO | |
1546 | |
1547 (deftest read-stream-content-into-string.1 | |
1548 (values (with-input-from-string (stream "foo bar") | |
1549 (read-stream-content-into-string stream)) | |
1550 (with-input-from-string (stream "foo bar") | |
1551 (read-stream-content-into-string stream :buffer-size 1)) | |
1552 (with-input-from-string (stream "foo bar") | |
1553 (read-stream-content-into-string stream :buffer-size 6)) | |
1554 (with-input-from-string (stream "foo bar") | |
1555 (read-stream-content-into-string stream :buffer-size 7))) | |
1556 "foo bar" | |
1557 "foo bar" | |
1558 "foo bar" | |
1559 "foo bar") | |
1560 | |
1561 (deftest read-stream-content-into-string.2 | |
1562 (handler-case | |
1563 (let ((stream (make-broadcast-stream))) | |
1564 (read-stream-content-into-string stream :buffer-size 0)) | |
1565 (type-error () | |
1566 :type-error)) | |
1567 :type-error) | |
1568 | |
1569 #+(or) | |
1570 (defvar *octets* | |
1571 (map '(simple-array (unsigned-byte 8) (7)) #'char-code "foo bar")) | |
1572 | |
1573 #+(or) | |
1574 (deftest read-stream-content-into-byte-vector.1 | |
1575 (values (with-input-from-byte-vector (stream *octets*) | |
1576 (read-stream-content-into-byte-vector stream)) | |
1577 (with-input-from-byte-vector (stream *octets*) | |
1578 (read-stream-content-into-byte-vector stream :initial-size… | |
1579 (with-input-from-byte-vector (stream *octets*) | |
1580 (read-stream-content-into-byte-vector stream 'alexandria::… | |
1581 (with-input-from-byte-vector (stream *octets*) | |
1582 (read-stream-content-into-byte-vector stream 'alexandria::… | |
1583 *octets* | |
1584 *octets* | |
1585 *octets* | |
1586 (subseq *octets* 0 3)) | |
1587 | |
1588 (deftest read-stream-content-into-byte-vector.2 | |
1589 (handler-case | |
1590 (let ((stream (make-broadcast-stream))) | |
1591 (read-stream-content-into-byte-vector stream :initial-size 0)) | |
1592 (type-error () | |
1593 :type-error)) | |
1594 :type-error) | |
1595 | |
1596 ;;;; Macros | |
1597 | |
1598 (deftest with-unique-names.1 | |
1599 (let ((*gensym-counter* 0)) | |
1600 (let ((syms (with-unique-names (foo bar quux) | |
1601 (list foo bar quux)))) | |
1602 (list (find-if #'symbol-package syms) | |
1603 (equal '("FOO0" "BAR1" "QUUX2") | |
1604 (mapcar #'symbol-name syms))))) | |
1605 (nil t)) | |
1606 | |
1607 (deftest with-unique-names.2 | |
1608 (let ((*gensym-counter* 0)) | |
1609 (let ((syms (with-unique-names ((foo "_foo_") (bar -bar-) (quux #\… | |
1610 (list foo bar quux)))) | |
1611 (list (find-if #'symbol-package syms) | |
1612 (equal '("_foo_0" "-BAR-1" "q2") | |
1613 (mapcar #'symbol-name syms))))) | |
1614 (nil t)) | |
1615 | |
1616 (deftest with-unique-names.3 | |
1617 (let ((*gensym-counter* 0)) | |
1618 (multiple-value-bind (res err) | |
1619 (ignore-errors | |
1620 (eval | |
1621 '(let ((syms | |
1622 (with-unique-names ((foo "_foo_") (bar -bar-) (quux… | |
1623 (list foo bar quux)))) | |
1624 (list (find-if #'symbol-package syms) | |
1625 (equal '("_foo_0" "-BAR-1" "q2") | |
1626 (mapcar #'symbol-name syms)))))) | |
1627 (errorp err))) | |
1628 t) | |
1629 | |
1630 (deftest once-only.1 | |
1631 (macrolet ((cons1.good (x) | |
1632 (once-only (x) | |
1633 `(cons ,x ,x))) | |
1634 (cons1.bad (x) | |
1635 `(cons ,x ,x))) | |
1636 (let ((y 0)) | |
1637 (list (cons1.good (incf y)) | |
1638 y | |
1639 (cons1.bad (incf y)) | |
1640 y))) | |
1641 ((1 . 1) 1 (2 . 3) 3)) | |
1642 | |
1643 (deftest once-only.2 | |
1644 (macrolet ((cons1 (x) | |
1645 (once-only ((y x)) | |
1646 `(cons ,y ,y)))) | |
1647 (let ((z 0)) | |
1648 (list (cons1 (incf z)) | |
1649 z | |
1650 (cons1 (incf z))))) | |
1651 ((1 . 1) 1 (2 . 2))) | |
1652 | |
1653 (deftest parse-body.1 | |
1654 (parse-body '("doc" "body") :documentation t) | |
1655 ("body") | |
1656 nil | |
1657 "doc") | |
1658 | |
1659 (deftest parse-body.2 | |
1660 (parse-body '("body") :documentation t) | |
1661 ("body") | |
1662 nil | |
1663 nil) | |
1664 | |
1665 (deftest parse-body.3 | |
1666 (parse-body '("doc" "body")) | |
1667 ("doc" "body") | |
1668 nil | |
1669 nil) | |
1670 | |
1671 (deftest parse-body.4 | |
1672 (parse-body '((declare (foo)) "doc" (declare (bar)) body) :documenta… | |
1673 (body) | |
1674 ((declare (foo)) (declare (bar))) | |
1675 "doc") | |
1676 | |
1677 (deftest parse-body.5 | |
1678 (parse-body '((declare (foo)) "doc" (declare (bar)) body)) | |
1679 ("doc" (declare (bar)) body) | |
1680 ((declare (foo))) | |
1681 nil) | |
1682 | |
1683 (deftest parse-body.6 | |
1684 (multiple-value-bind (res err) | |
1685 (ignore-errors | |
1686 (parse-body '("foo" "bar" "quux") | |
1687 :documentation t)) | |
1688 (errorp err)) | |
1689 t) | |
1690 | |
1691 ;;;; Symbols | |
1692 | |
1693 (deftest ensure-symbol.1 | |
1694 (ensure-symbol :cons :cl) | |
1695 cons | |
1696 :external) | |
1697 | |
1698 (deftest ensure-symbol.2 | |
1699 (ensure-symbol "CONS" :alexandria) | |
1700 cons | |
1701 :inherited) | |
1702 | |
1703 (deftest ensure-symbol.3 | |
1704 (ensure-symbol 'foo :keyword) | |
1705 :foo | |
1706 :external) | |
1707 | |
1708 (deftest ensure-symbol.4 | |
1709 (ensure-symbol #\* :alexandria) | |
1710 * | |
1711 :inherited) | |
1712 | |
1713 (deftest format-symbol.1 | |
1714 (let ((s (format-symbol nil '#:x-~d 13))) | |
1715 (list (symbol-package s) | |
1716 (string= (string '#:x-13) (symbol-name s)))) | |
1717 (nil t)) | |
1718 | |
1719 (deftest format-symbol.2 | |
1720 (format-symbol :keyword '#:sym-~a (string :bolic)) | |
1721 :sym-bolic) | |
1722 | |
1723 (deftest format-symbol.3 | |
1724 (let ((*package* (find-package :cl))) | |
1725 (format-symbol t '#:find-~a (string 'package))) | |
1726 find-package) | |
1727 | |
1728 (deftest make-keyword.1 | |
1729 (list (make-keyword 'zot) | |
1730 (make-keyword "FOO") | |
1731 (make-keyword #\Q)) | |
1732 (:zot :foo :q)) | |
1733 | |
1734 (deftest make-gensym-list.1 | |
1735 (let ((*gensym-counter* 0)) | |
1736 (let ((syms (make-gensym-list 3 "FOO"))) | |
1737 (list (find-if 'symbol-package syms) | |
1738 (equal '("FOO0" "FOO1" "FOO2") | |
1739 (mapcar 'symbol-name syms))))) | |
1740 (nil t)) | |
1741 | |
1742 (deftest make-gensym-list.2 | |
1743 (let ((*gensym-counter* 0)) | |
1744 (let ((syms (make-gensym-list 3))) | |
1745 (list (find-if 'symbol-package syms) | |
1746 (equal '("G0" "G1" "G2") | |
1747 (mapcar 'symbol-name syms))))) | |
1748 (nil t)) | |
1749 | |
1750 ;;;; Type-system | |
1751 | |
1752 (deftest of-type.1 | |
1753 (locally | |
1754 (declare (notinline of-type)) | |
1755 (let ((f (of-type 'string))) | |
1756 (list (funcall f "foo") | |
1757 (funcall f 'bar)))) | |
1758 (t nil)) | |
1759 | |
1760 (deftest type=.1 | |
1761 (type= 'string 'string) | |
1762 t | |
1763 t) | |
1764 | |
1765 (deftest type=.2 | |
1766 (type= 'list '(or null cons)) | |
1767 t | |
1768 t) | |
1769 | |
1770 (deftest type=.3 | |
1771 (type= 'null '(and symbol list)) | |
1772 t | |
1773 t) | |
1774 | |
1775 (deftest type=.4 | |
1776 (type= 'string '(satisfies emptyp)) | |
1777 nil | |
1778 nil) | |
1779 | |
1780 (deftest type=.5 | |
1781 (type= 'string 'list) | |
1782 nil | |
1783 t) | |
1784 | |
1785 (macrolet | |
1786 ((test (type numbers) | |
1787 `(deftest ,(format-symbol t '#:cdr5.~a (string type)) | |
1788 (let ((numbers ,numbers)) | |
1789 (values (mapcar (of-type ',(format-symbol t '#:negative-~a… | |
1790 (mapcar (of-type ',(format-symbol t '#:non-positiv… | |
1791 (mapcar (of-type ',(format-symbol t '#:non-negativ… | |
1792 (mapcar (of-type ',(format-symbol t '#:positive-~a… | |
1793 (t t t nil nil nil nil) | |
1794 (t t t t nil nil nil) | |
1795 (nil nil nil t t t t) | |
1796 (nil nil nil nil t t t)))) | |
1797 (test fixnum (list most-negative-fixnum -42 -1 0 … | |
1798 (test integer (list (1- most-negative-fixnum) -42 -1 0 … | |
1799 (test rational (list (1- most-negative-fixnum) -42/13 -1 0 … | |
1800 (test real (list most-negative-long-float -42/13 -1 0 … | |
1801 (test float (list most-negative-short-float -42.02 -1.0 0.… | |
1802 (test short-float (list most-negative-short-float -42.02s0 -1.0s0 0.… | |
1803 (test single-float (list most-negative-single-float -42.02f0 -1.0f0 0.… | |
1804 (test double-float (list most-negative-double-float -42.02d0 -1.0d0 0.… | |
1805 (test long-float (list most-negative-long-float -42.02l0 -1.0l0 0.… | |
1806 | |
1807 ;;;; Bindings | |
1808 | |
1809 (declaim (notinline opaque)) | |
1810 (defun opaque (x) | |
1811 x) | |
1812 | |
1813 (deftest if-let.1 | |
1814 (if-let (x (opaque :ok)) | |
1815 x | |
1816 :bad) | |
1817 :ok) | |
1818 | |
1819 (deftest if-let.2 | |
1820 (if-let (x (opaque nil)) | |
1821 :bad | |
1822 (and (not x) :ok)) | |
1823 :ok) | |
1824 | |
1825 (deftest if-let.3 | |
1826 (let ((x 1)) | |
1827 (if-let ((x 2) | |
1828 (y x)) | |
1829 (+ x y) | |
1830 :oops)) | |
1831 3) | |
1832 | |
1833 (deftest if-let.4 | |
1834 (if-let ((x 1) | |
1835 (y nil)) | |
1836 :oops | |
1837 (and (not y) x)) | |
1838 1) | |
1839 | |
1840 (deftest if-let.5 | |
1841 (if-let (x) | |
1842 :oops | |
1843 (not x)) | |
1844 t) | |
1845 | |
1846 (deftest if-let.error.1 | |
1847 (handler-case | |
1848 (eval '(if-let x | |
1849 :oops | |
1850 :oops)) | |
1851 (type-error () | |
1852 :type-error)) | |
1853 :type-error) | |
1854 | |
1855 (deftest when-let.1 | |
1856 (when-let (x (opaque :ok)) | |
1857 (setf x (cons x x)) | |
1858 x) | |
1859 (:ok . :ok)) | |
1860 | |
1861 (deftest when-let.2 | |
1862 (when-let ((x 1) | |
1863 (y nil) | |
1864 (z 3)) | |
1865 :oops) | |
1866 nil) | |
1867 | |
1868 (deftest when-let.3 | |
1869 (let ((x 1)) | |
1870 (when-let ((x 2) | |
1871 (y x)) | |
1872 (+ x y))) | |
1873 3) | |
1874 | |
1875 (deftest when-let.error.1 | |
1876 (handler-case | |
1877 (eval '(when-let x :oops)) | |
1878 (type-error () | |
1879 :type-error)) | |
1880 :type-error) | |
1881 | |
1882 (deftest when-let*.1 | |
1883 (let ((x 1)) | |
1884 (when-let* ((x 2) | |
1885 (y x)) | |
1886 (+ x y))) | |
1887 4) | |
1888 | |
1889 (deftest when-let*.2 | |
1890 (let ((y 1)) | |
1891 (when-let* (x y) | |
1892 (1+ x))) | |
1893 2) | |
1894 | |
1895 (deftest when-let*.3 | |
1896 (when-let* ((x t) | |
1897 (y (consp x)) | |
1898 (z (error "OOPS"))) | |
1899 t) | |
1900 nil) | |
1901 | |
1902 (deftest when-let*.error.1 | |
1903 (handler-case | |
1904 (eval '(when-let* x :oops)) | |
1905 (type-error () | |
1906 :type-error)) | |
1907 :type-error) | |
1908 | |
1909 (deftest doplist.1 | |
1910 (let (keys values) | |
1911 (doplist (k v '(a 1 b 2 c 3) (values t (reverse keys) (reverse val… | |
1912 (push k keys) | |
1913 (push v values))) | |
1914 t | |
1915 (a b c) | |
1916 (1 2 3) | |
1917 nil | |
1918 nil) | |
1919 | |
1920 (deftest count-permutations.1 | |
1921 (values (count-permutations 31 7) | |
1922 (count-permutations 1 1) | |
1923 (count-permutations 2 1) | |
1924 (count-permutations 2 2) | |
1925 (count-permutations 3 2) | |
1926 (count-permutations 3 1)) | |
1927 13253058000 | |
1928 1 | |
1929 2 | |
1930 2 | |
1931 6 | |
1932 3) | |
1933 | |
1934 (deftest binomial-coefficient.1 | |
1935 (alexandria:binomial-coefficient 1239 139) | |
1936 2879490220228897020077169460056182671884717930992985883548000668352218… | |
1937 | |
1938 ;; Exercise bignum case (at least on x86). | |
1939 (deftest binomial-coefficient.2 | |
1940 (alexandria:binomial-coefficient 2000000000000 20) | |
1941 4309980411772728439504228795903384548563227227404023657417307484315306… | |
1942 | |
1943 (deftest copy-stream.1 | |
1944 (let ((data "sdkfjhsakfh weior763495ewofhsdfk sdfadlkfjhsadf woif sd… | |
1945 (values (equal data | |
1946 (with-input-from-string (in data) | |
1947 (with-output-to-string (out) | |
1948 (alexandria:copy-stream in out)))) | |
1949 (equal (subseq data 10 20) | |
1950 (with-input-from-string (in data) | |
1951 (with-output-to-string (out) | |
1952 (alexandria:copy-stream in out :start 10 :end 2… | |
1953 (equal (subseq data 10) | |
1954 (with-input-from-string (in data) | |
1955 (with-output-to-string (out) | |
1956 (alexandria:copy-stream in out :start 10)))) | |
1957 (equal (subseq data 0 20) | |
1958 (with-input-from-string (in data) | |
1959 (with-output-to-string (out) | |
1960 (alexandria:copy-stream in out :end 20)))))) | |
1961 t | |
1962 t | |
1963 t | |
1964 t) | |
1965 | |
1966 (deftest extremum.1 | |
1967 (let ((n 0)) | |
1968 (dotimes (i 10) | |
1969 (let ((data (shuffle (coerce (iota 10000 :start i) 'vector))) | |
1970 (ok t)) | |
1971 (unless (eql i (extremum data #'<)) | |
1972 (setf ok nil)) | |
1973 (unless (eql i (extremum (coerce data 'list) #'<)) | |
1974 (setf ok nil)) | |
1975 (unless (eql (+ 9999 i) (extremum data #'>)) | |
1976 (setf ok nil)) | |
1977 (unless (eql (+ 9999 i) (extremum (coerce data 'list) #'>)) | |
1978 (setf ok nil)) | |
1979 (when ok | |
1980 (incf n)))) | |
1981 (when (eql 10 (extremum #(100 1 10 1000) #'> :start 1 :end 3)) | |
1982 (incf n)) | |
1983 (when (eql -1000 (extremum #(100 1 10 -1000) #'> :key 'abs)) | |
1984 (incf n)) | |
1985 (when (eq nil (extremum "" (lambda (a b) (error "wtf? ~S, ~S" a b)… | |
1986 (incf n)) | |
1987 n) | |
1988 13) | |
1989 | |
1990 (deftest starts-with-subseq.string | |
1991 (starts-with-subseq "f" "foo" :return-suffix t) | |
1992 t | |
1993 "oo") | |
1994 | |
1995 (deftest starts-with-subseq.vector | |
1996 (starts-with-subseq #(1) #(1 2 3) :return-suffix t) | |
1997 t | |
1998 #(2 3)) | |
1999 | |
2000 (deftest starts-with-subseq.list | |
2001 (starts-with-subseq '(1) '(1 2 3) :return-suffix t) | |
2002 t | |
2003 (2 3)) | |
2004 | |
2005 (deftest starts-with-subseq.start1 | |
2006 (starts-with-subseq "foo" "oop" :start1 1) | |
2007 t | |
2008 nil) | |
2009 | |
2010 (deftest starts-with-subseq.start2 | |
2011 (starts-with-subseq "foo" "xfoop" :start2 1) | |
2012 t | |
2013 nil) | |
2014 | |
2015 (deftest format-symbol.print-case-bound | |
2016 (let ((upper (intern "FOO-BAR")) | |
2017 (lower (intern "foo-bar")) | |
2018 (*print-escape* nil)) | |
2019 (values | |
2020 (let ((*print-case* :downcase)) | |
2021 (and (eq upper (format-symbol t "~A" upper)) | |
2022 (eq lower (format-symbol t "~A" lower)))) | |
2023 (let ((*print-case* :upcase)) | |
2024 (and (eq upper (format-symbol t "~A" upper)) | |
2025 (eq lower (format-symbol t "~A" lower)))) | |
2026 (let ((*print-case* :capitalize)) | |
2027 (and (eq upper (format-symbol t "~A" upper)) | |
2028 (eq lower (format-symbol t "~A" lower)))))) | |
2029 t | |
2030 t | |
2031 t) | |
2032 | |
2033 (deftest iota.fp-start-and-complex-integer-step | |
2034 (equal '(#C(0.0 0.0) #C(0.0 2.0) #C(0.0 4.0)) | |
2035 (iota 3 :start 0.0 :step #C(0 2))) | |
2036 t) | |
2037 | |
2038 (deftest parse-ordinary-lambda-list.1 | |
2039 (multiple-value-bind (req opt rest keys allowp aux keyp) | |
2040 (parse-ordinary-lambda-list '(a b c | |
2041 &optional o1 (o2 42) (o3 42 o3-sup… | |
2042 &key (k1) ((:key k2)) (k3 42 k3-su… | |
2043 :normalize t) | |
2044 (and (equal '(a b c) req) | |
2045 (equal '((o1 nil nil) | |
2046 (o2 42 nil) | |
2047 (o3 42 o3-supplied?)) | |
2048 opt) | |
2049 (equal '(((:k1 k1) nil nil) | |
2050 ((:key k2) nil nil) | |
2051 ((:k3 k3) 42 k3-supplied?)) | |
2052 keys) | |
2053 (not allowp) | |
2054 (not aux) | |
2055 (eq t keyp))) | |
2056 t) |