Skip to content
tests.lisp 45.7 KiB
Newer Older
Nikodemus Siivola's avatar
Nikodemus Siivola committed
(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*))
Nikodemus Siivola's avatar
Nikodemus Siivola committed

(in-package :alexandria-tests)
Nikodemus Siivola's avatar
Nikodemus Siivola committed

(defun run-tests (&key ((:compiled *compile-tests*)))
Nikodemus Siivola's avatar
Nikodemus Siivola committed

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(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)
      ((- 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)

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(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.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))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
;;;; Hash tables

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(deftest ensure-hash-table.1
    (let ((table (make-hash-table))
          (x (list 1)))
      (multiple-value-bind (value already-there)
          (ensure-gethash x table 42)
        (and (= value 42)
             (not already-there)
             (= 42 (gethash x table))
             (multiple-value-bind (value2 already-there2)
                 (ensure-gethash x table 13)
               (and (= value2 42)
                    already-there2
                    (= 42 (gethash x table)))))))
  t)

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(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))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
            (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))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
              (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)
Nikodemus Siivola's avatar
Nikodemus Siivola committed
              (gethash "FOO" equalp-copy))))
  (t t 2 t nil t t nil t))
Nikodemus Siivola's avatar
Nikodemus Siivola committed

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

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(deftest maphash-keys.1
    (let ((keys nil)
          (table (make-hash-table)))
      (declare (notinline maphash-keys))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
      (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))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
      (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)))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
  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)
Nikodemus Siivola's avatar
Nikodemus Siivola committed
            (eq (hash-table-test-name 'eql)
                (hash-table-test table))))
  (3 (a) (b) (c) t))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
(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)
Nikodemus Siivola's avatar
Nikodemus Siivola committed
            (eq (hash-table-test-name 'eq)
                (hash-table-test table))))
  (3 1 2 3 nil nil t))
Nikodemus Siivola's avatar
Nikodemus Siivola committed

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

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(deftest conjoin.1
    (let ((conjunction (conjoin #'consp
Nikodemus Siivola's avatar
Nikodemus Siivola committed
                                (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))

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(deftest compose.1
    (let ((composite (compose '1+
Nikodemus Siivola's avatar
Nikodemus Siivola committed
                              (lambda (x)
                                (* x 2))
                              #'read-from-string)))
      (funcall composite "1"))
  3)

(deftest compose.2
    (let ((composite
Nikodemus Siivola's avatar
Nikodemus Siivola committed
           (locally (declare (notinline compose))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
                      (lambda (x)
                        (* x 2))
                      #'read-from-string))))
      (funcall composite "2"))
  5)

(deftest compose.3
    (let ((compose-form (funcall (compiler-macro-function 'compose)
Nikodemus Siivola's avatar
Nikodemus Siivola committed
                                   (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))

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(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
Nikodemus Siivola's avatar
Nikodemus Siivola committed
    (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))

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(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)

Nikodemus Siivola's avatar
Nikodemus Siivola committed
;;;; 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))
      (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)

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(deftest appendf.1
    (let* ((list (list 1 2 3))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
           (orig list))
      (appendf list '(4 5 6) '(7 8))
      (list list (eq list orig)))
  ((1 2 3 4 5 6 7 8) nil))

Luís Oliveira's avatar
Luís Oliveira committed
(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))

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(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)))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
  (t nil nil nil t))
Nikodemus Siivola's avatar
Nikodemus Siivola committed

(deftest circular-list-p.2
    (circular-list-p 'foo)
  nil)

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(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)
Nikodemus Siivola's avatar
Nikodemus Siivola committed
            (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)

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(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)

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(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)

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(deftest lastcar.1
    (let ((l1 (list 1))
          (l2 (list 1 2)))
      (list (lastcar l1)
            (lastcar l2)))
  (1 2))

(deftest lastcar.error.2
    (handler-case
Nikodemus Siivola's avatar
Nikodemus Siivola committed
          (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)

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(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
      (list (remove-from-plist orig 'a 'c)
            (remove-from-plist orig 'b 'd)
            (remove-from-plist orig 'b)
            (remove-from-plist orig 'a)
            (remove-from-plist orig 'd 42 "zot")
            (remove-from-plist orig 'a 'b 'c 'd)
            (remove-from-plist orig 'a 'b 'c 'd 'x)
Nikodemus Siivola's avatar
Nikodemus Siivola committed
  ((b 2 d 4)
   (a 1 c 3)
   (a 1 c 3 d 4)
   (b 2 c 3 d 4)
   (a 1 b 2 c 3)
   nil
   nil
   t))

(deftest mappend.1
    (mappend (compose 'list '*) '(1 2 3) '(1 2 3))
  (1 4 9))

(deftest assoc-value.1
    (let ((key1 '(complex key))
          (key2 'simple-key)
          (alist '())
          (result '()))
      (push 1 (assoc-value alist key1 :test #'equal))
      (push 2 (assoc-value alist key1 :test 'equal))
      (push 42 (assoc-value alist key2))
      (push 43 (assoc-value alist key2 :test 'eq))
      (push (assoc-value alist key1 :test #'equal) result)
      (push (assoc-value alist key2) result)

      (push 'very (rassoc-value alist (list 2 1) :test #'equal))
      (push (cdr (assoc '(very complex key) alist :test #'equal)) result)
      result)
  ((2 1) (43 42) (2 1)))

Nikodemus Siivola's avatar
Nikodemus Siivola committed
;;;; 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)
Nikodemus Siivola's avatar
Nikodemus Siivola committed

(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)
Nikodemus Siivola's avatar
Nikodemus Siivola committed
  (2.0 5.0 8.0))
Nikodemus Siivola's avatar
Nikodemus Siivola committed

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

Nikodemus Siivola's avatar
Nikodemus Siivola committed
(deftest lerp.1
    (lerp 0.5 1 2)
  1.5)

(deftest lerp.2
    (lerp 0.1 1 2)
  1.1)

(deftest mean.1
    (mean '(1 2 3))
  2)

(deftest mean.2
    (mean '(1 2 3 4))
  5/2)

(deftest mean.3
Nikodemus Siivola's avatar
Nikodemus Siivola committed
    (mean '(1 2 10))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
  13/3)
Nikodemus Siivola's avatar
Nikodemus Siivola committed

(deftest median.1
    (median '(100 0 99 1 98 2 97))
  97)

(deftest median.2
    (median '(100 0 99 1 98 2 97 96))
Johan Ur Riise's avatar
Johan Ur Riise committed
  193/2)
Nikodemus Siivola's avatar
Nikodemus Siivola committed

(deftest variance.1
    (variance (list 1 2 3))
  2/3)
Nikodemus Siivola's avatar
Nikodemus Siivola committed

(deftest standard-deviation.1
    (< 0 (standard-deviation (list 1 2 3)) 1)
  t)
Nikodemus Siivola's avatar
Nikodemus Siivola committed

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