Merge commit '95aeb2ebae32a01ff79644daa523bda5d8552863' as 'third_party/lisp/alexandria' r/394

1 files changed, 2047 insertions, 0 deletions

diff --git a/third_party/lisp/alexandria/tests.lisp b/third_party/lisp/alexandria/tests.lisp
new file mode 100644
index 000000000000..b70ef0475e81
--- /dev/null
+++ b/third_party/lisp/alexandria/tests.lisp
@@ -0,0 +1,2047 @@
+(in-package :cl-user)
+
+(defpackage :alexandria-tests
+  (:use :cl :alexandria #+sbcl :sb-rt #-sbcl :rtest)
+  (:import-from #+sbcl :sb-rt #-sbcl :rtest
+                #:*compile-tests* #:*expected-failures*))
+
+(in-package :alexandria-tests)
+
+(defun run-tests (&key ((:compiled *compile-tests*)))
+  (do-tests))
+
+(defun hash-table-test-name (name)
+  ;; Workaround for Clisp calling EQL in a hash-table FASTHASH-EQL.
+  (hash-table-test (make-hash-table :test name)))
+
+;;;; 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)
+
+;;;; 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
+    (switch (13)
+      ((+ 12 2) :oops)
+      ((- 13 1) :oops2)
+      (t :yay))
+  :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))
+      (errorp err))
+  t)
+
+;;;; Hash tables
+
+(deftest ensure-gethash.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)
+
+(deftest ensure-gethash.2
+    (let ((table (make-hash-table))
+          (count 0))
+      (multiple-value-call #'values
+        (ensure-gethash (progn (incf count) :foo)
+                        (progn (incf count) table)
+                        (progn (incf count) :bar))
+        (gethash :foo table)
+        count))
+  :bar nil :bar t 3)
+
+(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))
+            (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)
+              (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)))
+  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))
+
+(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)
+            (eq (hash-table-test-name 'eql)
+                (hash-table-test table))))
+  (3 (a) (b) (c) t))
+
+(deftest alist-hash-table.duplicate-keys
+    (let* ((alist '((0 a) (1 b) (0 c) (1 d) (2 e)))
+           (table (alist-hash-table alist)))
+      (list (hash-table-count table)
+            (gethash 0 table)
+            (gethash 1 table)
+            (gethash 2 table)))
+  (3 (a) (b) (e)))
+
+(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)
+            (eq (hash-table-test-name 'eq)
+                (hash-table-test table))))
+  (3 1 2 3 nil nil t))
+
+(deftest plist-hash-table.duplicate-keys
+    (let* ((plist '(:a 1 :b 2 :a 3 :b 4 :c 5))
+           (table (plist-hash-table plist)))
+      (list (hash-table-count table)
+            (gethash :a table)
+            (gethash :b table)
+            (gethash :c table)))
+  (3 1 2 5))
+
+;;;; 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))
+
+(deftest conjoin.1
+    (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))
+
+(deftest compose.1
+    (let ((composite (compose '1+
+                              (lambda (x)
+                                (* x 2))
+                              #'read-from-string)))
+      (funcall composite "1"))
+  3)
+
+(deftest compose.2
+    (let ((composite
+           (locally (declare (notinline compose))
+             (compose '1+
+                      (lambda (x)
+                        (* x 2))
+                      #'read-from-string))))
+      (funcall composite "2"))
+  5)
+
+(deftest compose.3
+    (let ((compose-form (funcall (compiler-macro-function 'compose)
+                                 '(compose '1+
+                                   (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))
+
+(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))
+
+(deftest curry.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)
+
+;;;; Lists
+
+(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
+    (let* ((list (list 1 2 3))
+           (orig list))
+      (unionf list (list 1 2 4))
+      (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)
+
+(deftest appendf.1
+    (let* ((list (list 1 2 3))
+           (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)))
+  (t nil nil nil t))
+
+(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 tree1)
+            (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))
+
+(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
+        (progn
+          (lastcar (circular-list 1 2 3))
+          nil)
+      (error ()
+        t))
+  t)
+
+(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)
+
+(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"))
+
+(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))
+
+(deftest remove-from-plist.1
+    (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)
+            (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 delete-from-plist.1
+    (let ((orig '(a 1 b 2 c 3 d 4 d 5)))
+      (list (delete-from-plist (copy-list orig) 'a 'c)
+            (delete-from-plist (copy-list orig) 'b 'd)
+            (delete-from-plist (copy-list orig) 'b)
+            (delete-from-plist (copy-list orig) 'a)
+            (delete-from-plist (copy-list orig) 'd 42 "zot")
+            (delete-from-plist (copy-list orig) 'a 'b 'c 'd)
+            (delete-from-plist (copy-list orig) 'a 'b 'c 'd 'x)
+            (equal orig (delete-from-plist orig))
+            (eq orig (delete-from-plist orig))))
+  ((b 2 d 4 d 5)
+   (a 1 c 3)
+   (a 1 c 3 d 4 d 5)
+   (b 2 c 3 d 4 d 5)
+   (a 1 b 2 c 3)
+   nil
+   nil
+   t
+   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)
+
+#+sbcl
+(deftest gaussian-random.2
+    (handler-case
+        (sb-ext:with-timeout 2
+          (progn
+            (loop
+              :repeat 10000
+              :do (gaussian-random 0 nil))
+            'done))
+      (sb-ext:timeout ()
+        'timed-out))
+  done)
+
+(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)
+  (2.0 5.0 8.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 lerp.3
+    (lerp 0.1 4 25)
+  6.1)
+
+(deftest mean.1
+    (mean '(1 2 3))
+  2)
+
+(deftest mean.2
+    (mean '(1 2 3 4))
+  5/2)
+
+(deftest mean.3
+    (mean '(1 2 10))
+  13/3)
+
+(deftest median.1
+    (median '(100 0 99 1 98 2 97))
+  97)
+
+(deftest median.2
+    (median '(100 0 99 1 98 2 97 96))
+  193/2)
+
+(deftest variance.1
+    (variance (list 1 2 3))
+  2/3)
+
+(deftest standard-deviation.1
+    (< 0 (standard-deviation (list 1 2 3)) 1)
+  t)
+
+(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))
+  (2 #(0 2 0)))
+
+(deftest minf.1
+    (let ((y 1))
+      (minf y 0)
+      y)
+  0)
+
+(deftest minf.2
+    (let ((xv (vector 10 10 10))
+          (p 0))
+      (minf (svref xv (incf p)) (incf p))
+      (list p xv))
+  (2 #(10 2 10)))
+
+(deftest subfactorial.1
+    (mapcar #'subfactorial (iota 22))
+  (1
+   0
+   1
+   2
+   9
+   44
+   265
+   1854
+   14833
+   133496
+   1334961
+   14684570
+   176214841
+   2290792932
+   32071101049
+   481066515734
+   7697064251745
+   130850092279664
+   2355301661033953
+   44750731559645106
+   895014631192902121
+   18795307255050944540))
+
+;;;; Arrays
+
+#+nil
+(deftest array-index.type)
+
+#+nil
+(deftest copy-array)
+
+;;;; Sequences
+
+(deftest rotate.1
+    (list (rotate (list 1 2 3) 0)
+          (rotate (list 1 2 3) 1)
+          (rotate (list 1 2 3) 2)
+          (rotate (list 1 2 3) 3)
+          (rotate (list 1 2 3) 4))
+  ((1 2 3)
+   (3 1 2)
+   (2 3 1)
+   (1 2 3)
+   (3 1 2)))
+
+(deftest rotate.2
+    (list (rotate (vector 1 2 3 4) 0)
+          (rotate (vector 1 2 3 4))
+          (rotate (vector 1 2 3 4) 2)
+          (rotate (vector 1 2 3 4) 3)
+          (rotate (vector 1 2 3 4) 4)
+          (rotate (vector 1 2 3 4) 5))
+  (#(1 2 3 4)
+    #(4 1 2 3)
+    #(3 4 1 2)
+    #(2 3 4 1)
+    #(1 2 3 4)
+    #(4 1 2 3)))
+
+(deftest rotate.3
+    (list (rotate (list 1 2 3) 0)
+          (rotate (list 1 2 3) -1)
+          (rotate (list 1 2 3) -2)
+          (rotate (list 1 2 3) -3)
+          (rotate (list 1 2 3) -4))
+  ((1 2 3)
+   (2 3 1)
+   (3 1 2)
+   (1 2 3)
+   (2 3 1)))
+
+(deftest rotate.4
+    (list (rotate (vector 1 2 3 4) 0)
+          (rotate (vector 1 2 3 4) -1)
+          (rotate (vector 1 2 3 4) -2)
+          (rotate (vector 1 2 3 4) -3)
+          (rotate (vector 1 2 3 4) -4)
+          (rotate (vector 1 2 3 4) -5))
+  (#(1 2 3 4)
+   #(2 3 4 1)
+   #(3 4 1 2)
+   #(4 1 2 3)
+   #(1 2 3 4)
+   #(2 3 4 1)))
+
+(deftest rotate.5
+    (values (rotate (list 1) 17)
+            (rotate (list 1) -5))
+  (1)
+  (1))
+
+(deftest shuffle.1
+    (let ((s (shuffle (iota 100))))
+      (list (equal s (iota 100))
+            (every (lambda (x)
+                     (member x s))
+                   (iota 100))
+            (every (lambda (x)
+                     (typep x '(integer 0 99)))
+                   s)))
+  (nil t t))
+
+(deftest shuffle.2
+    (let ((s (shuffle (coerce (iota 100) 'vector))))
+      (list (equal s (coerce (iota 100) 'vector))
+            (every (lambda (x)
+                     (find x s))
+                   (iota 100))
+            (every (lambda (x)
+                     (typep x '(integer 0 99)))
+                   s)))
+  (nil t t))
+
+(deftest shuffle.3
+    (let* ((orig (coerce (iota 21) 'vector))
+           (copy (copy-seq orig)))
+      (shuffle copy :start 10 :end 15)
+      (list (every #'eql (subseq copy 0 10) (subseq orig 0 10))
+            (every #'eql (subseq copy 15) (subseq orig 15))))
+  (t t))
+
+(deftest random-elt.1
+    (let ((s1 #(1 2 3 4))
+          (s2 '(1 2 3 4)))
+      (list (dotimes (i 1000 nil)
+              (unless (member (random-elt s1) s2)
+                (return nil))
+              (when (/= (random-elt s1) (random-elt s1))
+                (return t)))
+            (dotimes (i 1000 nil)
+              (unless (member (random-elt s2) s2)
+                (return nil))
+              (when (/= (random-elt s2) (random-elt s2))
+                (return t)))))
+  (t t))
+
+(deftest removef.1
+    (let* ((x '(1 2 3))
+           (x* x)
+           (y #(1 2 3))
+           (y* y))
+      (removef x 1)
+      (removef y 3)
+      (list x x* y y*))
+  ((2 3)
+   (1 2 3)
+   #(1 2)
+   #(1 2 3)))
+
+(deftest deletef.1
+    (let* ((x (list 1 2 3))
+           (x* x)
+           (y (vector 1 2 3)))
+      (deletef x 2)
+      (deletef y 1)
+      (list x x* y))
+  ((1 3)
+   (1 3)
+   #(2 3)))
+
+(deftest map-permutations.1
+    (let ((seq (list 1 2 3))
+          (seen nil)
+          (ok t))
+      (map-permutations (lambda (s)
+                          (unless (set-equal s seq)
+                            (setf ok nil))
+                          (when (member s seen :test 'equal)
+                            (setf ok nil))
+                          (push s seen))
+                        seq
+                        :copy t)
+      (values ok (length seen)))
+  t
+  6)
+
+(deftest proper-sequence.type.1
+    (mapcar (lambda (x)
+              (typep x 'proper-sequence))
+            (list (list 1 2 3)
+                  (vector 1 2 3)
+                  #2a((1 2) (3 4))
+                  (circular-list 1 2 3 4)))
+  (t t nil nil))
+
+(deftest emptyp.1
+    (mapcar #'emptyp
+            (list (list 1)
+                  (circular-list 1)
+                  nil
+                  (vector)
+                  (vector 1)))
+  (nil nil t t nil))
+
+(deftest sequence-of-length-p.1
+    (mapcar #'sequence-of-length-p
+            (list nil
+                  #()
+                  (list 1)
+                  (vector 1)
+                  (list 1 2)
+                  (vector 1 2)
+                  (list 1 2)
+                  (vector 1 2)
+                  (list 1 2)
+                  (vector 1 2))
+            (list 0
+                  0
+                  1
+                  1
+                  2
+                  2
+                  1
+                  1
+                  4
+                  4))
+  (t t t t t t nil nil nil nil))
+
+(deftest length=.1
+    (mapcar #'length=
+            (list nil
+                  #()
+                  (list 1)
+                  (vector 1)
+                  (list 1 2)
+                  (vector 1 2)
+                  (list 1 2)
+                  (vector 1 2)
+                  (list 1 2)
+                  (vector 1 2))
+            (list 0
+                  0
+                  1
+                  1
+                  2
+                  2
+                  1
+                  1
+                  4
+                  4))
+  (t t t t t t nil nil nil nil))
+
+(deftest length=.2
+    ;; test the compiler macro
+    (macrolet ((x (&rest args)
+                 (funcall
+                  (compile nil
+                           `(lambda ()
+                              (length= ,@args))))))
+      (list (x 2 '(1 2))
+            (x '(1 2) '(3 4))
+            (x '(1 2) 2)
+            (x '(1 2) 2 '(3 4))
+            (x 1 2 3)))
+  (t t t t nil))
+
+(deftest copy-sequence.1
+    (let ((l (list 1 2 3))
+          (v (vector #\a #\b #\c)))
+      (declare (notinline copy-sequence))
+      (let ((l.list (copy-sequence 'list l))
+            (l.vector (copy-sequence 'vector l))
+            (l.spec-v (copy-sequence '(vector fixnum) l))
+            (v.vector (copy-sequence 'vector v))
+            (v.list (copy-sequence 'list v))
+            (v.string (copy-sequence 'string v)))
+        (list (member l (list l.list l.vector l.spec-v))
+              (member v (list v.vector v.list v.string))
+              (equal l.list l)
+              (equalp l.vector #(1 2 3))
+              (type= (upgraded-array-element-type 'fixnum)
+                     (array-element-type l.spec-v))
+              (equalp v.vector v)
+              (equal v.list '(#\a #\b #\c))
+              (equal "abc" v.string))))
+  (nil nil t t t t t t))
+
+(deftest first-elt.1
+    (mapcar #'first-elt
+            (list (list 1 2 3)
+                  "abc"
+                  (vector :a :b :c)))
+  (1 #\a :a))
+
+(deftest first-elt.error.1
+    (mapcar (lambda (x)
+              (handler-case
+                  (first-elt x)
+                (type-error ()
+                  :type-error)))
+            (list nil
+                  #()
+                  12
+                  :zot))
+  (:type-error
+   :type-error
+   :type-error
+   :type-error))
+
+(deftest setf-first-elt.1
+    (let ((l (list 1 2 3))
+          (s (copy-seq "foobar"))
+          (v (vector :a :b :c)))
+      (setf (first-elt l) -1
+            (first-elt s) #\x
+            (first-elt v) 'zot)
+      (values l s v))
+  (-1 2 3)
+  "xoobar"
+  #(zot :b :c))
+
+(deftest setf-first-elt.error.1
+    (let ((l 'foo))
+      (multiple-value-bind (res err)
+          (ignore-errors (setf (first-elt l) 4))
+        (typep err 'type-error)))
+  t)
+
+(deftest last-elt.1
+    (mapcar #'last-elt
+            (list (list 1 2 3)
+                  (vector :a :b :c)
+                  "FOOBAR"
+                  #*001
+                  #*010))
+  (3 :c #\R 1 0))
+
+(deftest last-elt.error.1
+    (mapcar (lambda (x)
+              (handler-case
+                  (last-elt x)
+                (type-error ()
+                  :type-error)))
+            (list nil
+                  #()
+                  12
+                  :zot
+                  (circular-list 1 2 3)
+                  (list* 1 2 3 (circular-list 4 5))))
+  (:type-error
+   :type-error
+   :type-error
+   :type-error
+   :type-error
+   :type-error))
+
+(deftest setf-last-elt.1
+    (let ((l (list 1 2 3))
+          (s (copy-seq "foobar"))
+          (b (copy-seq #*010101001)))
+      (setf (last-elt l) '???
+            (last-elt s) #\?
+            (last-elt b) 0)
+      (values l s b))
+  (1 2 ???)
+  "fooba?"
+  #*010101000)
+
+(deftest setf-last-elt.error.1
+    (handler-case
+        (setf (last-elt 'foo) 13)
+      (type-error ()
+        :type-error))
+  :type-error)
+
+(deftest starts-with.1
+    (list (starts-with 1 '(1 2 3))
+          (starts-with 1 #(1 2 3))
+          (starts-with #\x "xyz")
+          (starts-with 2 '(1 2 3))
+          (starts-with 3 #(1 2 3))
+          (starts-with 1 1)
+          (starts-with nil nil))
+  (t t t nil nil nil nil))
+
+(deftest starts-with.2
+    (values (starts-with 1 '(-1 2 3) :key '-)
+            (starts-with "foo" '("foo" "bar") :test 'equal)
+            (starts-with "f" '(#\f) :key 'string :test 'equal)
+            (starts-with -1 '(0 1 2) :key #'1+)
+            (starts-with "zot" '("ZOT") :test 'equal))
+  t
+  t
+  t
+  nil
+  nil)
+
+(deftest ends-with.1
+    (list (ends-with 3 '(1 2 3))
+          (ends-with 3 #(1 2 3))
+          (ends-with #\z "xyz")
+          (ends-with 2 '(1 2 3))
+          (ends-with 1 #(1 2 3))
+          (ends-with 1 1)
+          (ends-with nil nil))
+  (t t t nil nil nil nil))
+
+(deftest ends-with.2
+    (values (ends-with 2 '(0 13 1) :key '1+)
+            (ends-with "foo" (vector "bar" "foo") :test 'equal)
+            (ends-with "X" (vector 1 2 #\X) :key 'string :test 'equal)
+            (ends-with "foo" "foo" :test 'equal))
+  t
+  t
+  t
+  nil)
+
+(deftest ends-with.error.1
+    (handler-case
+        (ends-with 3 (circular-list 3 3 3 1 3 3))
+      (type-error ()
+        :type-error))
+  :type-error)
+
+(deftest sequences.passing-improper-lists
+    (macrolet ((signals-error-p (form)
+                 `(handler-case
+                      (progn ,form nil)
+                    (type-error (e)
+                      t)))
+               (cut (fn &rest args)
+                 (with-gensyms (arg)
+                   (print`(lambda (,arg)
+                       (apply ,fn (list ,@(substitute arg '_ args))))))))
+      (let ((circular-list (make-circular-list 5 :initial-element :foo))
+            (dotted-list (list* 'a 'b 'c 'd)))
+        (loop for nth from 0
+              for fn in (list
+                         (cut #'lastcar _)
+                         (cut #'rotate _ 3)
+                         (cut #'rotate _ -3)
+                         (cut #'shuffle _)
+                         (cut #'random-elt _)
+                         (cut #'last-elt _)
+                         (cut #'ends-with :foo _))
+              nconcing
+                 (let ((on-circular-p (signals-error-p (funcall fn circular-list)))
+                       (on-dotted-p (signals-error-p (funcall fn dotted-list))))
+                   (when (or (not on-circular-p) (not on-dotted-p))
+                     (append
+                      (unless on-circular-p
+                        (let ((*print-circle* t))
+                          (list
+                           (format nil
+                                   "No appropriate error signalled when passing ~S to ~Ath entry."
+                                   circular-list nth))))
+                      (unless on-dotted-p
+                        (list
+                         (format nil
+                                 "No appropriate error signalled when passing ~S to ~Ath entry."
+                                 dotted-list nth)))))))))
+  nil)
+
+;;;; IO
+
+(deftest read-stream-content-into-string.1
+    (values (with-input-from-string (stream "foo bar")
+              (read-stream-content-into-string stream))
+            (with-input-from-string (stream "foo bar")
+              (read-stream-content-into-string stream :buffer-size 1))
+            (with-input-from-string (stream "foo bar")
+              (read-stream-content-into-string stream :buffer-size 6))
+            (with-input-from-string (stream "foo bar")
+              (read-stream-content-into-string stream :buffer-size 7)))
+  "foo bar"
+  "foo bar"
+  "foo bar"
+  "foo bar")
+
+(deftest read-stream-content-into-string.2
+    (handler-case
+        (let ((stream (make-broadcast-stream)))
+          (read-stream-content-into-string stream :buffer-size 0))
+      (type-error ()
+        :type-error))
+  :type-error)
+
+#+(or)
+(defvar *octets*
+  (map '(simple-array (unsigned-byte 8) (7)) #'char-code "foo bar"))
+
+#+(or)
+(deftest read-stream-content-into-byte-vector.1
+    (values (with-input-from-byte-vector (stream *octets*)
+              (read-stream-content-into-byte-vector stream))
+            (with-input-from-byte-vector (stream *octets*)
+              (read-stream-content-into-byte-vector stream :initial-size 1))
+            (with-input-from-byte-vector (stream *octets*)
+              (read-stream-content-into-byte-vector stream 'alexandria::%length 6))
+            (with-input-from-byte-vector (stream *octets*)
+              (read-stream-content-into-byte-vector stream 'alexandria::%length 3)))
+  *octets*
+  *octets*
+  *octets*
+  (subseq *octets* 0 3))
+
+(deftest read-stream-content-into-byte-vector.2
+    (handler-case
+        (let ((stream (make-broadcast-stream)))
+          (read-stream-content-into-byte-vector stream :initial-size 0))
+      (type-error ()
+        :type-error))
+  :type-error)
+
+;;;; Macros
+
+(deftest with-unique-names.1
+    (let ((*gensym-counter* 0))
+      (let ((syms (with-unique-names (foo bar quux)
+                    (list foo bar quux))))
+        (list (find-if #'symbol-package syms)
+              (equal '("FOO0" "BAR1" "QUUX2")
+                     (mapcar #'symbol-name syms)))))
+  (nil t))
+
+(deftest with-unique-names.2
+    (let ((*gensym-counter* 0))
+      (let ((syms (with-unique-names ((foo "_foo_") (bar -bar-) (quux #\q))
+                    (list foo bar quux))))
+        (list (find-if #'symbol-package syms)
+              (equal '("_foo_0" "-BAR-1" "q2")
+                     (mapcar #'symbol-name syms)))))
+  (nil t))
+
+(deftest with-unique-names.3
+    (let ((*gensym-counter* 0))
+      (multiple-value-bind (res err)
+          (ignore-errors
+            (eval
+             '(let ((syms
+                     (with-unique-names ((foo "_foo_") (bar -bar-) (quux 42))
+                       (list foo bar quux))))
+               (list (find-if #'symbol-package syms)
+                (equal '("_foo_0" "-BAR-1" "q2")
+                 (mapcar #'symbol-name syms))))))
+        (errorp err)))
+  t)
+
+(deftest once-only.1
+    (macrolet ((cons1.good (x)
+                 (once-only (x)
+                   `(cons ,x ,x)))
+               (cons1.bad (x)
+                 `(cons ,x ,x)))
+      (let ((y 0))
+        (list (cons1.good (incf y))
+              y
+              (cons1.bad (incf y))
+              y)))
+  ((1 . 1) 1 (2 . 3) 3))
+
+(deftest once-only.2
+    (macrolet ((cons1 (x)
+                 (once-only ((y x))
+                   `(cons ,y ,y))))
+      (let ((z 0))
+        (list (cons1 (incf z))
+              z
+              (cons1 (incf z)))))
+  ((1 . 1) 1 (2 . 2)))
+
+(deftest parse-body.1
+    (parse-body '("doc" "body") :documentation t)
+  ("body")
+  nil
+  "doc")
+
+(deftest parse-body.2
+    (parse-body '("body") :documentation t)
+  ("body")
+  nil
+  nil)
+
+(deftest parse-body.3
+    (parse-body '("doc" "body"))
+  ("doc" "body")
+  nil
+  nil)
+
+(deftest parse-body.4
+    (parse-body '((declare (foo)) "doc" (declare (bar)) body) :documentation t)
+  (body)
+  ((declare (foo)) (declare (bar)))
+  "doc")
+
+(deftest parse-body.5
+    (parse-body '((declare (foo)) "doc" (declare (bar)) body))
+  ("doc" (declare (bar)) body)
+  ((declare (foo)))
+  nil)
+
+(deftest parse-body.6
+    (multiple-value-bind (res err)
+        (ignore-errors
+          (parse-body '("foo" "bar" "quux")
+                      :documentation t))
+      (errorp err))
+  t)
+
+;;;; Symbols
+
+(deftest ensure-symbol.1
+    (ensure-symbol :cons :cl)
+  cons
+  :external)
+
+(deftest ensure-symbol.2
+    (ensure-symbol "CONS" :alexandria)
+  cons
+  :inherited)
+
+(deftest ensure-symbol.3
+    (ensure-symbol 'foo :keyword)
+  :foo
+  :external)
+
+(deftest ensure-symbol.4
+    (ensure-symbol #\* :alexandria)
+  *
+  :inherited)
+
+(deftest format-symbol.1
+    (let ((s (format-symbol nil '#:x-~d 13)))
+      (list (symbol-package s)
+            (string= (string '#:x-13) (symbol-name s))))
+  (nil t))
+
+(deftest format-symbol.2
+    (format-symbol :keyword '#:sym-~a (string :bolic))
+  :sym-bolic)
+
+(deftest format-symbol.3
+    (let ((*package* (find-package :cl)))
+      (format-symbol t '#:find-~a (string 'package)))
+  find-package)
+
+(deftest make-keyword.1
+    (list (make-keyword 'zot)
+          (make-keyword "FOO")
+          (make-keyword #\Q))
+  (:zot :foo :q))
+
+(deftest make-gensym-list.1
+    (let ((*gensym-counter* 0))
+      (let ((syms (make-gensym-list 3 "FOO")))
+        (list (find-if 'symbol-package syms)
+              (equal '("FOO0" "FOO1" "FOO2")
+                     (mapcar 'symbol-name syms)))))
+  (nil t))
+
+(deftest make-gensym-list.2
+    (let ((*gensym-counter* 0))
+      (let ((syms (make-gensym-list 3)))
+        (list (find-if 'symbol-package syms)
+              (equal '("G0" "G1" "G2")
+                     (mapcar 'symbol-name syms)))))
+  (nil t))
+
+;;;; Type-system
+
+(deftest of-type.1
+    (locally
+        (declare (notinline of-type))
+    (let ((f (of-type 'string)))
+      (list (funcall f "foo")
+            (funcall f 'bar))))
+  (t nil))
+
+(deftest type=.1
+    (type= 'string 'string)
+  t
+  t)
+
+(deftest type=.2
+    (type= 'list '(or null cons))
+  t
+  t)
+
+(deftest type=.3
+    (type= 'null '(and symbol list))
+  t
+  t)
+
+(deftest type=.4
+    (type= 'string '(satisfies emptyp))
+  nil
+  nil)
+
+(deftest type=.5
+    (type= 'string 'list)
+  nil
+  t)
+
+(macrolet
+    ((test (type numbers)
+       `(deftest ,(format-symbol t '#:cdr5.~a (string type))
+            (let ((numbers ,numbers))
+              (values (mapcar (of-type ',(format-symbol t '#:negative-~a (string type))) numbers)
+                      (mapcar (of-type ',(format-symbol t '#:non-positive-~a (string type))) numbers)
+                      (mapcar (of-type ',(format-symbol t '#:non-negative-~a (string type))) numbers)
+                      (mapcar (of-type ',(format-symbol t '#:positive-~a (string type))) numbers)))
+          (t t t nil nil nil nil)
+          (t t t t nil nil nil)
+          (nil nil nil t t t t)
+          (nil nil nil nil t t t))))
+  (test fixnum       (list most-negative-fixnum       -42      -1     0     1     42      most-positive-fixnum))
+  (test integer      (list (1- most-negative-fixnum)  -42      -1     0     1     42      (1+ most-positive-fixnum)))
+  (test rational     (list (1- most-negative-fixnum)  -42/13   -1     0     1     42/13   (1+ most-positive-fixnum)))
+  (test real         (list most-negative-long-float   -42/13   -1     0     1     42/13   most-positive-long-float))
+  (test float        (list most-negative-short-float  -42.02   -1.0   0.0   1.0   42.02   most-positive-short-float))
+  (test short-float  (list most-negative-short-float  -42.02s0 -1.0s0 0.0s0 1.0s0 42.02s0 most-positive-short-float))
+  (test single-float (list most-negative-single-float -42.02f0 -1.0f0 0.0f0 1.0f0 42.02f0 most-positive-single-float))
+  (test double-float (list most-negative-double-float -42.02d0 -1.0d0 0.0d0 1.0d0 42.02d0 most-positive-double-float))
+  (test long-float   (list most-negative-long-float   -42.02l0 -1.0l0 0.0l0 1.0l0 42.02l0 most-positive-long-float)))
+
+;;;; Bindings
+
+(declaim (notinline opaque))
+(defun opaque (x)
+  x)
+
+(deftest if-let.1
+    (if-let (x (opaque :ok))
+            x
+            :bad)
+  :ok)
+
+(deftest if-let.2
+    (if-let (x (opaque nil))
+            :bad
+            (and (not x) :ok))
+  :ok)
+
+(deftest if-let.3
+    (let ((x 1))
+      (if-let ((x 2)
+               (y x))
+              (+ x y)
+              :oops))
+  3)
+
+(deftest if-let.4
+    (if-let ((x 1)
+             (y nil))
+            :oops
+            (and (not y) x))
+  1)
+
+(deftest if-let.5
+    (if-let (x)
+            :oops
+            (not x))
+  t)
+
+(deftest if-let.error.1
+    (handler-case
+        (eval '(if-let x
+                :oops
+                :oops))
+      (type-error ()
+        :type-error))
+  :type-error)
+
+(deftest when-let.1
+    (when-let (x (opaque :ok))
+      (setf x (cons x x))
+      x)
+  (:ok . :ok))
+
+(deftest when-let.2
+    (when-let ((x 1)
+               (y nil)
+               (z 3))
+      :oops)
+  nil)
+
+(deftest when-let.3
+    (let ((x 1))
+      (when-let ((x 2)
+                 (y x))
+        (+ x y)))
+  3)
+
+(deftest when-let.error.1
+    (handler-case
+        (eval '(when-let x :oops))
+      (type-error ()
+        :type-error))
+  :type-error)
+
+(deftest when-let*.1
+    (let ((x 1))
+      (when-let* ((x 2)
+                  (y x))
+        (+ x y)))
+  4)
+
+(deftest when-let*.2
+    (let ((y 1))
+      (when-let* (x y)
+        (1+ x)))
+  2)
+
+(deftest when-let*.3
+    (when-let* ((x t)
+                (y (consp x))
+                (z (error "OOPS")))
+      t)
+  nil)
+
+(deftest when-let*.error.1
+    (handler-case
+        (eval '(when-let* x :oops))
+      (type-error ()
+        :type-error))
+  :type-error)
+
+(deftest doplist.1
+    (let (keys values)
+      (doplist (k v '(a 1 b 2 c 3) (values t (reverse keys) (reverse values) k v))
+        (push k keys)
+        (push v values)))
+  t
+  (a b c)
+  (1 2 3)
+  nil
+  nil)
+
+(deftest count-permutations.1
+    (values (count-permutations 31 7)
+            (count-permutations 1 1)
+            (count-permutations 2 1)
+            (count-permutations 2 2)
+            (count-permutations 3 2)
+            (count-permutations 3 1))
+  13253058000
+  1
+  2
+  2
+  6
+  3)
+
+(deftest binomial-coefficient.1
+    (alexandria:binomial-coefficient 1239 139)
+  28794902202288970200771694600561826718847179309929858835480006683522184441358211423695124921058123706380656375919763349913245306834194782172712255592710204598527867804110129489943080460154)
+
+;; Exercise bignum case (at least on x86).
+(deftest binomial-coefficient.2
+    (alexandria:binomial-coefficient 2000000000000 20)
+  430998041177272843950422879590338454856322722740402365741730748431530623813012487773080486408378680853987520854296499536311275320016878730999689934464711239072435565454954447356845336730100919970769793030177499999999900000000000)
+
+(deftest copy-stream.1
+    (let ((data "sdkfjhsakfh weior763495ewofhsdfk sdfadlkfjhsadf woif sdlkjfhslkdfh sdklfjh"))
+      (values (equal data
+                     (with-input-from-string (in data)
+                       (with-output-to-string (out)
+                         (alexandria:copy-stream in out))))
+              (equal (subseq data 10 20)
+                     (with-input-from-string (in data)
+                       (with-output-to-string (out)
+                         (alexandria:copy-stream in out :start 10 :end 20))))
+              (equal (subseq data 10)
+                     (with-input-from-string (in data)
+                       (with-output-to-string (out)
+                         (alexandria:copy-stream in out :start 10))))
+              (equal (subseq data 0 20)
+                     (with-input-from-string (in data)
+                       (with-output-to-string (out)
+                         (alexandria:copy-stream in out :end 20))))))
+  t
+  t
+  t
+  t)
+
+(deftest extremum.1
+    (let ((n 0))
+      (dotimes (i 10)
+       (let ((data (shuffle (coerce (iota 10000 :start i) 'vector)))
+             (ok t))
+         (unless (eql i (extremum data #'<))
+           (setf ok nil))
+         (unless (eql i (extremum (coerce data 'list) #'<))
+           (setf ok nil))
+         (unless (eql (+ 9999 i) (extremum data #'>))
+           (setf ok nil))
+         (unless (eql (+ 9999 i) (extremum (coerce  data 'list) #'>))
+           (setf ok nil))
+         (when ok
+           (incf n))))
+      (when (eql 10 (extremum #(100 1 10 1000) #'> :start 1 :end 3))
+        (incf n))
+      (when (eql -1000 (extremum #(100 1 10 -1000) #'> :key 'abs))
+        (incf n))
+      (when (eq nil (extremum "" (lambda (a b) (error "wtf? ~S, ~S" a b))))
+        (incf n))
+      n)
+  13)
+
+(deftest starts-with-subseq.string
+    (starts-with-subseq "f" "foo" :return-suffix t)
+  t
+  "oo")
+
+(deftest starts-with-subseq.vector
+    (starts-with-subseq #(1) #(1 2 3) :return-suffix t)
+  t
+  #(2 3))
+
+(deftest starts-with-subseq.list
+    (starts-with-subseq '(1) '(1 2 3) :return-suffix t)
+  t
+  (2 3))
+
+(deftest starts-with-subseq.start1
+    (starts-with-subseq "foo" "oop" :start1 1)
+  t
+  nil)
+
+(deftest starts-with-subseq.start2
+    (starts-with-subseq "foo" "xfoop" :start2 1)
+  t
+  nil)
+
+(deftest format-symbol.print-case-bound
+    (let ((upper (intern "FOO-BAR"))
+          (lower (intern "foo-bar"))
+          (*print-escape* nil))
+      (values
+       (let ((*print-case* :downcase))
+         (and (eq upper (format-symbol t "~A" upper))
+               (eq lower (format-symbol t "~A" lower))))
+       (let ((*print-case* :upcase))
+         (and (eq upper (format-symbol t "~A" upper))
+               (eq lower (format-symbol t "~A" lower))))
+       (let ((*print-case* :capitalize))
+         (and (eq upper (format-symbol t "~A" upper))
+              (eq lower (format-symbol t "~A" lower))))))
+  t
+  t
+  t)
+
+(deftest iota.fp-start-and-complex-integer-step
+    (equal '(#C(0.0 0.0) #C(0.0 2.0) #C(0.0 4.0))
+           (iota 3 :start 0.0 :step #C(0 2)))
+  t)
+
+(deftest parse-ordinary-lambda-list.1
+    (multiple-value-bind (req opt rest keys allowp aux keyp)
+        (parse-ordinary-lambda-list '(a b c
+                                      &optional o1 (o2 42) (o3 42 o3-supplied?)
+                                      &key (k1) ((:key k2)) (k3 42 k3-supplied?))
+                                    :normalize t)
+      (and (equal '(a b c) req)
+           (equal '((o1 nil nil)
+                    (o2 42 nil)
+                    (o3 42 o3-supplied?))
+                  opt)
+           (equal '(((:k1 k1) nil nil)
+                    ((:key k2) nil nil)
+                    ((:k3 k3) 42 k3-supplied?))
+                  keys)
+           (not allowp)
+           (not aux)
+           (eq t keyp)))
+  t)