about summary refs log tree commit diff
path: root/third_party/lisp/alexandria/tests.lisp
diff options
context:
space:
mode:
authorVincent Ambo <mail@tazj.in>2021-12-15T20·10+0300
committerclbot <clbot@tvl.fyi>2021-12-15T21·02+0000
commit28ac55e94a4c71c1594d7ec51846315aed03e815 (patch)
tree3cedf2ff4a608605163b848c727690a39821ee10 /third_party/lisp/alexandria/tests.lisp
parent50b43cfb66a46fb5579e71d0e55174bb77fa2858 (diff)
chore(3p/lisp): Unvendor alexandria and use nixpkgs sources r/3254
Change-Id: Idee3cb18ac42bd820d87aac0c68206436c1f4691
Reviewed-on: https://cl.tvl.fyi/c/depot/+/4338
Autosubmit: tazjin <mail@tazj.in>
Tested-by: BuildkiteCI
Reviewed-by: grfn <grfn@gws.fyi>
Diffstat (limited to 'third_party/lisp/alexandria/tests.lisp')
-rw-r--r--third_party/lisp/alexandria/tests.lisp2047
1 files changed, 0 insertions, 2047 deletions
diff --git a/third_party/lisp/alexandria/tests.lisp b/third_party/lisp/alexandria/tests.lisp
deleted file mode 100644
index b70ef0475e81..000000000000
--- a/third_party/lisp/alexandria/tests.lisp
+++ /dev/null
@@ -1,2047 +0,0 @@
-(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)