Newer
Older
(defpackage :alexandria-tests
(:use :cl :alexandria #+sbcl :sb-rt #-sbcl :rtest)
(:import-from #+sbcl :sb-rt #-sbcl :rtest
#:*compile-tests* #:*expected-failures*))
(defun run-tests (&key ((:compiled *compile-tests*)))
;;;; Arrays
(deftest copy-array.1
(let* ((orig (vector 1 2 3))
(copy (copy-array orig)))
(values (eq orig copy) (equalp orig copy)))
nil t)
(deftest copy-array.2
(let ((orig (make-array 1024 :fill-pointer 0)))
(vector-push-extend 1 orig)
(vector-push-extend 2 orig)
(vector-push-extend 3 orig)
(let ((copy (copy-array orig)))
(values (eq orig copy) (equalp orig copy)
(array-has-fill-pointer-p copy)
(eql (fill-pointer orig) (fill-pointer copy)))))
nil t t t)
(deftest copy-array.3
(let* ((orig (vector 1 2 3))
(copy (copy-array orig)))
(typep copy 'simple-array))
t)
(deftest copy-array.4
(let ((orig (make-array 21
:adjustable t
:fill-pointer 0)))
(dotimes (n 42)
(vector-push-extend n orig))
(let ((copy (copy-array orig
:adjustable nil
:fill-pointer nil)))
(typep copy 'simple-array)))
t)
(deftest array-index.1
(typep 0 'array-index)
t)
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
;;;; Conditions
(deftest unwind-protect-case.1
(let (result)
(unwind-protect-case ()
(random 10)
(:normal (push :normal result))
(:abort (push :abort result))
(:always (push :always result)))
result)
(:always :normal))
(deftest unwind-protect-case.2
(let (result)
(unwind-protect-case ()
(random 10)
(:always (push :always result))
(:normal (push :normal result))
(:abort (push :abort result)))
result)
(:normal :always))
(deftest unwind-protect-case.3
(let (result1 result2 result3)
(ignore-errors
(unwind-protect-case ()
(error "FOOF!")
(:normal (push :normal result1))
(:abort (push :abort result1))
(:always (push :always result1))))
(catch 'foof
(unwind-protect-case ()
(throw 'foof 42)
(:normal (push :normal result2))
(:abort (push :abort result2))
(:always (push :always result2))))
(block foof
(unwind-protect-case ()
(return-from foof 42)
(:normal (push :normal result3))
(:abort (push :abort result3))
(:always (push :always result3))))
(values result1 result2 result3))
(:always :abort)
(:always :abort)
(:always :abort))
(deftest unwind-protect-case.4
(let (result)
(unwind-protect-case (aborted-p)
(random 42)
(:always (setq result aborted-p)))
result)
nil)
(deftest unwind-protect-case.5
(let (result)
(block foof
(unwind-protect-case (aborted-p)
(return-from foof)
(:always (setq result aborted-p))))
result)
t)
;;;; Control flow
(deftest switch.1
(switch (13 :test =)
(12 :oops)
(13.0 :yay))
:yay)
(deftest switch.2
((+ 12 2) :oops)
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
:yay)
(deftest eswitch.1
(let ((x 13))
(eswitch (x :test =)
(12 :oops)
(13.0 :yay)))
:yay)
(deftest eswitch.2
(let ((x 13))
(eswitch (x :key 1+)
(11 :oops)
(14 :yay)))
:yay)
(deftest cswitch.1
(cswitch (13 :test =)
(12 :oops)
(13.0 :yay))
:yay)
(deftest cswitch.2
(cswitch (13 :key 1-)
(12 :yay)
(13.0 :oops))
:yay)
(deftest multiple-value-prog2.1
(multiple-value-prog2
(values 1 1 1)
(values 2 20 200)
(values 3 3 3))
2 20 200)
(deftest nth-value-or.1
(multiple-value-bind (a b c)
(nth-value-or 1
(values 1 nil 1)
(values 2 2 2))
(= a b c 2))
t)
(deftest whichever.1
(let ((x (whichever 1 2 3)))
(and (member x '(1 2 3)) t))
t)
(deftest whichever.2
(let* ((a 1)
(b 2)
(c 3)
(x (whichever a b c)))
(and (member x '(1 2 3)) t))
t)
(deftest xor.1
(xor nil nil 1 nil)
1
t)
(deftest xor.2
(xor nil nil 1 2)
nil
nil)
(deftest xor.3
(xor nil nil nil)
nil
t)
;;;; Definitions
(deftest define-constant.1
(let ((name (gensym)))
(eval `(define-constant ,name "FOO" :test 'equal))
(eval `(define-constant ,name "FOO" :test 'equal))
(values (equal "FOO" (symbol-value name))
(constantp name)))
t
t)
(deftest define-constant.2
(let ((name (gensym)))
(eval `(define-constant ,name 13))
(eval `(define-constant ,name 13))
(values (eql 13 (symbol-value name))
(constantp name)))
t
t)
;;;; Errors
;;; TYPEP is specified to return a generalized boolean and, for
;;; example, ECL exploits this by returning the superclasses of ERROR
;;; in this case.
(defun errorp (x)
(not (null (typep x 'error))))
(deftest required-argument.1
(multiple-value-bind (res err)
(ignore-errors (required-argument))
(deftest ensure-hash-table.1
(let ((table (make-hash-table))
(x (list 1)))
(multiple-value-bind (value already-there)
(ensure-gethash x table 42)
(and (= value 42)
(not already-there)
(= 42 (gethash x table))
(multiple-value-bind (value2 already-there2)
(ensure-gethash x table 13)
(and (= value2 42)
already-there2
(= 42 (gethash x table)))))))
t)
#+clisp (pushnew 'copy-hash-table.1 *expected-failures*)
(deftest copy-hash-table.1
(let ((orig (make-hash-table :test 'eq :size 123))
(foo "foo"))
(setf (gethash orig orig) t
(gethash foo orig) t)
(let ((eq-copy (copy-hash-table orig))
(eql-copy (copy-hash-table orig :test 'eql))
(equal-copy (copy-hash-table orig :test 'equal))
;; CLISP overflows the stack with this bit.
;; See <http://sourceforge.net/tracker/index.php?func=detail&aid=2029069&group_id=1355&atid=101355>.
#-clisp (equalp-copy (copy-hash-table orig :test 'equalp)))
(list (eql (hash-table-size eq-copy) (hash-table-size orig))
(eql (hash-table-rehash-size eq-copy)
(hash-table-rehash-size orig))
(hash-table-count eql-copy)
(gethash orig eq-copy)
(gethash (copy-seq foo) eql-copy)
(gethash foo eql-copy)
(gethash (copy-seq foo) equal-copy)
(gethash "FOO" equal-copy)
#-clisp (gethash "FOO" equalp-copy))))
(t t 2 t nil t t nil t))
(deftest copy-hash-table.2
(let ((ht (make-hash-table))
(list (list :list (vector :A :B :C))))
(setf (gethash 'list ht) list)
(let* ((shallow-copy (copy-hash-table ht))
(deep1-copy (copy-hash-table ht :key 'copy-list))
(list (gethash 'list ht))
(shallow-list (gethash 'list shallow-copy))
(deep1-list (gethash 'list deep1-copy)))
(list (eq ht shallow-copy)
(eq ht deep1-copy)
(eq list shallow-list)
(eq list deep1-list) ; outer list was copied.
(eq (second list) (second shallow-list))
(eq (second list) (second deep1-list)) ; inner vector wasn't copied.
)))
(nil nil t nil t t))
(deftest maphash-keys.1
(let ((keys nil)
(table (make-hash-table)))
(declare (notinline maphash-keys))
(dotimes (i 10)
(setf (gethash i table) t))
(maphash-keys (lambda (k) (push k keys)) table)
(set-equal keys '(0 1 2 3 4 5 6 7 8 9)))
t)
(deftest maphash-values.1
(let ((vals nil)
(table (make-hash-table)))
(declare (notinline maphash-values))
(dotimes (i 10)
(setf (gethash i table) (- i)))
(maphash-values (lambda (v) (push v vals)) table)
(set-equal vals '(0 -1 -2 -3 -4 -5 -6 -7 -8 -9)))
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
t)
(deftest hash-table-keys.1
(let ((table (make-hash-table)))
(dotimes (i 10)
(setf (gethash i table) t))
(set-equal (hash-table-keys table) '(0 1 2 3 4 5 6 7 8 9)))
t)
(deftest hash-table-values.1
(let ((table (make-hash-table)))
(dotimes (i 10)
(setf (gethash (gensym) table) i))
(set-equal (hash-table-values table) '(0 1 2 3 4 5 6 7 8 9)))
t)
(deftest hash-table-alist.1
(let ((table (make-hash-table)))
(dotimes (i 10)
(setf (gethash i table) (- i)))
(let ((alist (hash-table-alist table)))
(list (length alist)
(assoc 0 alist)
(assoc 3 alist)
(assoc 9 alist)
(assoc nil alist))))
(10 (0 . 0) (3 . -3) (9 . -9) nil))
(deftest hash-table-plist.1
(let ((table (make-hash-table)))
(dotimes (i 10)
(setf (gethash i table) (- i)))
(let ((plist (hash-table-plist table)))
(list (length plist)
(getf plist 0)
(getf plist 2)
(getf plist 7)
(getf plist nil))))
(20 0 -2 -7 nil))
#+clisp (pushnew 'alist-hash-table.1 *expected-failures*)
(deftest alist-hash-table.1
(let* ((alist '((0 a) (1 b) (2 c)))
(table (alist-hash-table alist)))
(list (hash-table-count table)
(gethash 0 table)
(gethash 1 table)
(gethash 2 table)
(hash-table-test table))) ; CLISP returns EXT:FASTHASH-EQL.
#+clisp (pushnew 'plist-hash-table.1 *expected-failures*)
(deftest plist-hash-table.1
(let* ((plist '(:a 1 :b 2 :c 3))
(table (plist-hash-table plist :test 'eq)))
(list (hash-table-count table)
(gethash :a table)
(gethash :b table)
(gethash :c table)
(gethash 2 table)
(gethash nil table)
(hash-table-test table))) ; CLISP returns EXT:FASTHASH-EQ.
(3 1 2 3 nil nil eq))
;;;; Functions
(deftest disjoin.1
(let ((disjunction (disjoin (lambda (x)
(and (consp x) :cons))
(lambda (x)
(and (stringp x) :string)))))
(list (funcall disjunction 'zot)
(funcall disjunction '(foo bar))
(funcall disjunction "test")))
(nil :cons :string))
(deftest disjoin.2
(let ((disjunction (disjoin #'zerop)))
(list (funcall disjunction 0)
(funcall disjunction 1)))
(t nil))
(let ((conjunction (conjoin #'consp
(lambda (x)
(stringp (car x)))
(lambda (x)
(char (car x) 0)))))
(list (funcall conjunction 'zot)
(funcall conjunction '(foo))
(funcall conjunction '("foo"))))
(nil nil #\f))
(deftest conjoin.2
(let ((conjunction (conjoin #'zerop)))
(list (funcall conjunction 0)
(funcall conjunction 1)))
(t nil))
(lambda (x)
(* x 2))
#'read-from-string)))
(funcall composite "1"))
3)
(deftest compose.2
(lambda (x)
(* x 2))
#'read-from-string))))
(funcall composite "2"))
5)
(deftest compose.3
(let ((compose-form (funcall (compiler-macro-function 'compose)
(lambda (x)
(* x 2))
#'read-from-string)
nil)))
(let ((fun (funcall (compile nil `(lambda () ,compose-form)))))
(funcall fun "3")))
7)
(deftest compose.4
(let ((composite (compose #'zerop)))
(list (funcall composite 0)
(funcall composite 1)))
(t nil))
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
(deftest multiple-value-compose.1
(let ((composite (multiple-value-compose
#'truncate
(lambda (x y)
(values y x))
(lambda (x)
(with-input-from-string (s x)
(values (read s) (read s)))))))
(multiple-value-list (funcall composite "2 7")))
(3 1))
(deftest multiple-value-compose.2
(let ((composite (locally (declare (notinline multiple-value-compose))
(multiple-value-compose
#'truncate
(lambda (x y)
(values y x))
(lambda (x)
(with-input-from-string (s x)
(values (read s) (read s))))))))
(multiple-value-list (funcall composite "2 11")))
(5 1))
(deftest multiple-value-compose.3
(let ((compose-form (funcall (compiler-macro-function 'multiple-value-compose)
'(multiple-value-compose
#'truncate
(lambda (x y)
(values y x))
(lambda (x)
(with-input-from-string (s x)
(values (read s) (read s)))))
nil)))
(let ((fun (funcall (compile nil `(lambda () ,compose-form)))))
(multiple-value-list (funcall fun "2 9"))))
(4 1))
(deftest multiple-value-compose.4
(let ((composite (multiple-value-compose #'truncate)))
(multiple-value-list (funcall composite 9 2)))
(4 1))
(let ((curried (curry '+ 3)))
(funcall curried 1 5))
9)
(deftest curry.2
(let ((curried (locally (declare (notinline curry))
(curry '* 2 3))))
(funcall curried 7))
42)
(deftest curry.3
(let ((curried-form (funcall (compiler-macro-function 'curry)
'(curry '/ 8)
nil)))
(let ((fun (funcall (compile nil `(lambda () ,curried-form)))))
(funcall fun 2)))
4)
(deftest curry.4
(let* ((x 1)
(curried (curry (progn
(incf x)
(lambda (y z) (* x y z)))
3)))
(list (funcall curried 7)
(funcall curried 7)
x))
(42 42 2))
(deftest rcurry.1
(let ((r (rcurry '/ 2)))
(funcall r 8))
4)
(deftest rcurry.2
(let* ((x 1)
(curried (rcurry (progn
(incf x)
(lambda (y z) (* x y z)))
3)))
(list (funcall curried 7)
(funcall curried 7)
x))
(42 42 2))
(deftest named-lambda.1
(let ((fac (named-lambda fac (x)
(if (> x 1)
(* x (fac (- x 1)))
x))))
(funcall fac 5))
120)
(deftest named-lambda.2
(let ((fac (named-lambda fac (&key x)
(if (> x 1)
(* x (fac :x (- x 1)))
x))))
(funcall fac :x 5))
120)
(deftest alist-plist.1
(alist-plist '((a . 1) (b . 2) (c . 3)))
(a 1 b 2 c 3))
(deftest plist-alist.1
(plist-alist '(a 1 b 2 c 3))
((a . 1) (b . 2) (c . 3)))
(deftest unionf.1
(values (equal orig (list 1 2 3))
(eql (length list) 4)
(set-difference list (list 1 2 3 4))
(set-difference (list 1 2 3 4) list)))
t
t
nil
nil)
(deftest nunionf.1
(let ((list (list 1 2 3)))
(nunionf list (list 1 2 4))
(values (eql (length list) 4)
(set-difference (list 1 2 3 4) list)
(set-difference list (list 1 2 3 4))))
t
nil
nil)
(orig list))
(appendf list '(4 5 6) '(7 8))
(list list (eq list orig)))
((1 2 3 4 5 6 7 8) nil))
(deftest nconcf.1
(let ((list1 (list 1 2 3))
(list2 (list 4 5 6)))
(nconcf list1 list2 (list 7 8 9))
list1)
(1 2 3 4 5 6 7 8 9))
(deftest circular-list.1
(let ((circle (circular-list 1 2 3)))
(list (first circle)
(second circle)
(third circle)
(fourth circle)
(eq circle (nthcdr 3 circle))))
(1 2 3 1 t))
(deftest circular-list-p.1
(let* ((circle (circular-list 1 2 3 4))
(tree (list circle circle))
(dotted (cons circle t))
(proper (list 1 2 3 circle))
(tailcirc (list* 1 2 3 circle)))
(list (circular-list-p circle)
(circular-list-p tree)
(circular-list-p dotted)
(circular-list-p proper)
(circular-list-p tailcirc)))
(deftest circular-list-p.2
(circular-list-p 'foo)
nil)
(deftest circular-tree-p.1
(let* ((circle (circular-list 1 2 3 4))
(tree1 (list circle circle))
(tree2 (let* ((level2 (list 1 nil 2))
(level1 (list level2)))
(setf (second level2) level1)
level1))
(dotted (cons circle t))
(proper (list 1 2 3 circle))
(tailcirc (list* 1 2 3 circle))
(quite-proper (list 1 2 3))
(quite-dotted (list 1 (cons 2 3))))
(list (circular-tree-p circle)
(circular-tree-p tree2)
(circular-tree-p dotted)
(circular-tree-p proper)
(circular-tree-p tailcirc)
(circular-tree-p quite-proper)
(circular-tree-p quite-dotted)))
(t t t t t t nil nil))
(deftest circular-tree-p.2
(alexandria:circular-tree-p '#1=(#1#))
t)
(deftest proper-list-p.1
(let ((l1 (list 1))
(l2 (list 1 2))
(l3 (cons 1 2))
(l4 (list (cons 1 2) 3))
(l5 (circular-list 1 2)))
(list (proper-list-p l1)
(proper-list-p l2)
(proper-list-p l3)
(proper-list-p l4)
(proper-list-p l5)))
(t t nil t nil))
(deftest proper-list-p.2
(proper-list-p '(1 2 . 3))
nil)
(deftest proper-list.type.1
(let ((l1 (list 1))
(l2 (list 1 2))
(l3 (cons 1 2))
(l4 (list (cons 1 2) 3))
(l5 (circular-list 1 2)))
(list (typep l1 'proper-list)
(typep l2 'proper-list)
(typep l3 'proper-list)
(typep l4 'proper-list)
(typep l5 'proper-list)))
(t t nil t nil))
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
(deftest proper-list-length.1
(values
(proper-list-length nil)
(proper-list-length (list 1))
(proper-list-length (list 2 2))
(proper-list-length (list 3 3 3))
(proper-list-length (list 4 4 4 4))
(proper-list-length (list 5 5 5 5 5))
(proper-list-length (list 6 6 6 6 6 6))
(proper-list-length (list 7 7 7 7 7 7 7))
(proper-list-length (list 8 8 8 8 8 8 8 8))
(proper-list-length (list 9 9 9 9 9 9 9 9 9)))
0 1 2 3 4 5 6 7 8 9)
(deftest proper-list-length.2
(flet ((plength (x)
(handler-case
(proper-list-length x)
(type-error ()
:ok))))
(values
(plength (list* 1))
(plength (list* 2 2))
(plength (list* 3 3 3))
(plength (list* 4 4 4 4))
(plength (list* 5 5 5 5 5))
(plength (list* 6 6 6 6 6 6))
(plength (list* 7 7 7 7 7 7 7))
(plength (list* 8 8 8 8 8 8 8 8))
(plength (list* 9 9 9 9 9 9 9 9 9))))
:ok :ok :ok
:ok :ok :ok
:ok :ok :ok)
(deftest lastcar.1
(let ((l1 (list 1))
(l2 (list 1 2)))
(list (lastcar l1)
(lastcar l2)))
(1 2))
(deftest lastcar.error.2
(handler-case
(lastcar (circular-list 1 2 3))
nil)
(error ()
t))
t)
Nikodemus Siivola
committed
(deftest setf-lastcar.1
(let ((l (list 1 2 3 4)))
(values (lastcar l)
(progn
(setf (lastcar l) 42)
(lastcar l))))
4
42)
(deftest setf-lastcar.2
(let ((l (circular-list 1 2 3)))
(multiple-value-bind (res err)
(ignore-errors (setf (lastcar l) 4))
(typep err 'type-error)))
t)
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
(deftest make-circular-list.1
(let ((l (make-circular-list 3 :initial-element :x)))
(setf (car l) :y)
(list (eq l (nthcdr 3 l))
(first l)
(second l)
(third l)
(fourth l)))
(t :y :x :x :y))
(deftest circular-list.type.1
(let* ((l1 (list 1 2 3))
(l2 (circular-list 1 2 3))
(l3 (list* 1 2 3 l2)))
(list (typep l1 'circular-list)
(typep l2 'circular-list)
(typep l3 'circular-list)))
(nil t t))
(deftest ensure-list.1
(let ((x (list 1))
(y 2))
(list (ensure-list x)
(ensure-list y)))
((1) (2)))
(deftest ensure-cons.1
(let ((x (cons 1 2))
(y nil)
(z "foo"))
(values (ensure-cons x)
(ensure-cons y)
(ensure-cons z)))
(1 . 2)
(nil)
("foo"))
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
(deftest setp.1
(setp '(1))
t)
(deftest setp.2
(setp nil)
t)
(deftest setp.3
(setp "foo")
nil)
(deftest setp.4
(setp '(1 2 3 1))
nil)
(deftest setp.5
(setp '(1 2 3))
t)
(deftest setp.6
(setp '(a :a))
t)
(deftest setp.7
(setp '(a :a) :key 'character)
nil)
(deftest setp.8
(setp '(a :a) :key 'character :test (constantly nil))
t)
(deftest set-equal.1
(set-equal '(1 2 3) '(3 1 2))
t)
(deftest set-equal.2
(set-equal '("Xa") '("Xb")
:test (lambda (a b) (eql (char a 0) (char b 0))))
t)
(deftest set-equal.3
(set-equal '(1 2) '(4 2))
nil)
(deftest set-equal.4
(set-equal '(a b c) '(:a :b :c) :key 'string :test 'equal)
t)
(deftest set-equal.5
(set-equal '(a d c) '(:a :b :c) :key 'string :test 'equal)
nil)
(deftest set-equal.6
(set-equal '(a b c) '(a b c d))
nil)
(deftest map-product.1
(map-product 'cons '(2 3) '(1 4))
((2 . 1) (2 . 4) (3 . 1) (3 . 4)))
(deftest map-product.2
(map-product #'cons '(2 3) '(1 4))
((2 . 1) (2 . 4) (3 . 1) (3 . 4)))
(deftest flatten.1
(flatten '((1) 2 (((3 4))) ((((5)) 6)) 7))
(1 2 3 4 5 6 7))
Nikodemus Siivola
committed
(let ((orig '(a 1 b 2 c 3 d 4)))
(list (remove-from-plist orig 'a 'c)
(remove-from-plist orig 'b 'd)
(remove-from-plist orig 'b)
(remove-from-plist orig 'a)
(remove-from-plist orig 'd 42 "zot")
(remove-from-plist orig 'a 'b 'c 'd)
(remove-from-plist orig 'a 'b 'c 'd 'x)
Nikodemus Siivola
committed
(equal orig '(a 1 b 2 c 3 d 4))))
((b 2 d 4)
(a 1 c 3)
(a 1 c 3 d 4)
(b 2 c 3 d 4)
(a 1 b 2 c 3)
nil
nil
t))
(deftest mappend.1
(mappend (compose 'list '*) '(1 2 3) '(1 2 3))
(1 4 9))
(deftest assoc-value.1
(let ((key1 '(complex key))
(key2 'simple-key)
(alist '())
(result '()))
(push 1 (assoc-value alist key1 :test #'equal))
(push 2 (assoc-value alist key1 :test 'equal))
(push 42 (assoc-value alist key2))
(push 43 (assoc-value alist key2 :test 'eq))
(push (assoc-value alist key1 :test #'equal) result)
(push (assoc-value alist key2) result)
(push 'very (rassoc-value alist (list 2 1) :test #'equal))
(push (cdr (assoc '(very complex key) alist :test #'equal)) result)
result)
((2 1) (43 42) (2 1)))
;;;; Numbers
(deftest clamp.1
(list (clamp 1.5 1 2)
(clamp 2.0 1 2)
(clamp 1.0 1 2)
(clamp 3 1 2)
(clamp 0 1 2))
(1.5 2.0 1.0 2 1))
(deftest gaussian-random.1
(let ((min -0.2)
(max +0.2))
(multiple-value-bind (g1 g2)
(gaussian-random min max)
(values (<= min g1 max)
(<= min g2 max)
(/= g1 g2) ;uh
)))
t
t
t)
(deftest iota.1
(iota 3)
(0 1 2))
(deftest iota.2
(iota 3 :start 0.0d0)
(0.0d0 1.0d0 2.0d0))
(deftest iota.3
(iota 3 :start 2 :step 3.0)
(deftest map-iota.1
(let (all)
(declare (notinline map-iota))
(values (map-iota (lambda (x) (push x all))
3
:start 2
:step 1.1d0)
all))
3
(4.2d0 3.1d0 2.0d0))
(deftest lerp.1
(lerp 0.5 1 2)
1.5)
(deftest lerp.2
(lerp 0.1 1 2)
1.1)
(deftest mean.1
(mean '(1 2 3))
2)
(deftest mean.2
(mean '(1 2 3 4))
5/2)
(deftest median.1
(median '(100 0 99 1 98 2 97))
97)
(deftest median.2
(median '(100 0 99 1 98 2 97 96))
(deftest variance.1
(variance (list 1 2 3))
2/3)
(deftest standard-deviation.1
(< 0 (standard-deviation (list 1 2 3)) 1)
t)
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(deftest maxf.1
(let ((x 1))
(maxf x 2)
x)
2)
(deftest maxf.2
(let ((x 1))
(maxf x 0)
x)
1)
(deftest maxf.3
(let ((x 1)
(c 0))
(maxf x (incf c))
(list x c))
(1 1))
(deftest maxf.4
(let ((xv (vector 0 0 0))
(p 0))
(maxf (svref xv (incf p)) (incf p))
(list p xv))