root/trunk/thirdparty/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))

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

;;;; 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-hash-table.1
    (let ((table (make-hash-table))
          (x (list 1)))
      (multiple-value-bind (value already-there)
          (ensure-gethash x table 42)
        (and (= value 42)
             (not already-there)
             (= 42 (gethash x table))
             (multiple-value-bind (value2 already-there2)
                 (ensure-gethash x table 13)
               (and (= value2 42)
                    already-there2
                    (= 42 (gethash x table)))))))
  t)

#+clisp (pushnew 'copy-hash-table.1 *expected-failures*)

(deftest copy-hash-table.1
    (let ((orig (make-hash-table :test 'eq :size 123))
          (foo "foo"))
      (setf (gethash orig orig) t
            (gethash foo orig) t)
      (let ((eq-copy (copy-hash-table orig))
            (eql-copy (copy-hash-table orig :test 'eql))
            (equal-copy (copy-hash-table orig :test 'equal))
            ;; CLISP overflows the stack with this bit.
            ;; See <http://sourceforge.net/tracker/index.php?func=detail&aid=2029069&group_id=1355&atid=101355>.
            #-clisp (equalp-copy (copy-hash-table orig :test 'equalp)))
        (list (eql (hash-table-size eq-copy) (hash-table-size orig))
              (eql (hash-table-rehash-size eq-copy)
                   (hash-table-rehash-size orig))
              (hash-table-count eql-copy)
              (gethash orig eq-copy)
              (gethash (copy-seq foo) eql-copy)
              (gethash foo eql-copy)
              (gethash (copy-seq foo) equal-copy)
              (gethash "FOO" equal-copy)
              #-clisp (gethash "FOO" equalp-copy))))
  (t t 2 t nil t t nil t))

(deftest copy-hash-table.2
    (let ((ht (make-hash-table))
          (list (list :list (vector :A :B :C))))
      (setf (gethash 'list ht) list)
      (let* ((shallow-copy (copy-hash-table ht))
             (deep1-copy (copy-hash-table ht :key 'copy-list))
             (list         (gethash 'list ht))
             (shallow-list (gethash 'list shallow-copy))
             (deep1-list   (gethash 'list deep1-copy)))
        (list (eq ht shallow-copy)
              (eq ht deep1-copy)
              (eq list shallow-list)
              (eq list deep1-list)                   ; outer list was copied.
              (eq (second list) (second shallow-list))
              (eq (second list) (second deep1-list)) ; inner vector wasn't copied.
              )))
  (nil nil t nil t t))

(deftest maphash-keys.1
    (let ((keys nil)
          (table (make-hash-table)))
      (declare (notinline maphash-keys))
      (dotimes (i 10)
        (setf (gethash i table) t))
      (maphash-keys (lambda (k) (push k keys)) table)
      (set-equal keys '(0 1 2 3 4 5 6 7 8 9)))
  t)

(deftest maphash-values.1
    (let ((vals nil)
          (table (make-hash-table)))
      (declare (notinline maphash-values))
      (dotimes (i 10)
        (setf (gethash i table) (- i)))
      (maphash-values (lambda (v) (push v vals)) table)
      (set-equal vals '(0 -1 -2 -3 -4 -5 -6 -7 -8 -9)))
  t)

(deftest hash-table-keys.1
    (let ((table (make-hash-table)))
      (dotimes (i 10)
        (setf (gethash i table) t))
      (set-equal (hash-table-keys table) '(0 1 2 3 4 5 6 7 8 9)))
  t)

(deftest hash-table-values.1
    (let ((table (make-hash-table)))
      (dotimes (i 10)
        (setf (gethash (gensym) table) i))
      (set-equal (hash-table-values table) '(0 1 2 3 4 5 6 7 8 9)))
  t)

(deftest hash-table-alist.1
    (let ((table (make-hash-table)))
      (dotimes (i 10)
        (setf (gethash i table) (- i)))
      (let ((alist (hash-table-alist table)))
        (list (length alist)
              (assoc 0 alist)
              (assoc 3 alist)
              (assoc 9 alist)
              (assoc nil alist))))
  (10 (0 . 0) (3 . -3) (9 . -9) nil))

(deftest hash-table-plist.1
    (let ((table (make-hash-table)))
      (dotimes (i 10)
        (setf (gethash i table) (- i)))
      (let ((plist (hash-table-plist table)))
        (list (length plist)
              (getf plist 0)
              (getf plist 2)
              (getf plist 7)
              (getf plist nil))))
  (20 0 -2 -7 nil))

#+clisp (pushnew 'alist-hash-table.1 *expected-failures*)

(deftest alist-hash-table.1
    (let* ((alist '((0 a) (1 b) (2 c)))
           (table (alist-hash-table alist)))
      (list (hash-table-count table)
            (gethash 0 table)
            (gethash 1 table)
            (gethash 2 table)
            (hash-table-test table))) ; CLISP returns EXT:FASTHASH-EQL.
  (3 (a) (b) (c) eql))

#+clisp (pushnew 'plist-hash-table.1 *expected-failures*)

(deftest plist-hash-table.1
    (let* ((plist '(:a 1 :b 2 :c 3))
           (table (plist-hash-table plist :test 'eq)))
      (list (hash-table-count table)
            (gethash :a table)
            (gethash :b table)
            (gethash :c table)
            (gethash 2 table)
            (gethash nil table)
            (hash-table-test table))) ; CLISP returns EXT:FASTHASH-EQ.
  (3 1 2 3 nil nil eq))

;;;; Functions

(deftest disjoin.1
    (let ((disjunction (disjoin (lambda (x)
                                  (and (consp x) :cons))
                                (lambda (x)
                                  (and (stringp x) :string)))))
      (list (funcall disjunction 'zot)
            (funcall disjunction '(foo bar))
            (funcall disjunction "test")))
  (nil :cons :string))

(deftest 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 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 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 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 rcurry.1
    (let ((r (rcurry '/ 2)))
      (funcall r 8))
  4)

(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 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 mappend.1
    (mappend (compose 'list '*) '(1 2 3) '(1 2 3))
  (1 4 9))

;;;; Numbers

(deftest clamp.1
    (list (clamp 1.5 1 2)
          (clamp 2.0 1 2)
          (clamp 1.0 1 2)
          (clamp 3 1 2)
          (clamp 0 1 2))
  (1.5 2.0 1.0 2 1))

(deftest gaussian-random.1
    (let ((min -0.2)
          (max +0.2))
      (multiple-value-bind (g1 g2)
          (gaussian-random min max)
        (values (<= min g1 max)
                (<= min g2 max)
                (/= g1 g2) ;uh
                )))
  t
  t
  t)

(deftest iota.1
    (iota 3)
  (0 1 2))

(deftest iota.2
    (iota 3 :start 0.0d0)
  (0.0d0 1.0d0 2.0d0))

(deftest iota.3
    (iota 3 :start 2 :step 3.0)
  (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 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))
  195/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)))

;;;; 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 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))
              (eql (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
                  #()
    &n