tvl-depot/third_party/lisp/alexandria/tests.lisp

(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)