Commit f42aa97e authored by pfdietz's avatar pfdietz

Moved most of the cons-related tests to files with more understandable names.

parent 93067235
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Apr 20 07:26:48 2003
;;;; Contains: Tests of ACONS
(in-package :cl-test)
(deftest acons.1
(let* ((x (copy-tree '((c . d) (e . f))))
(xcopy (make-scaffold-copy x))
(result (acons 'a 'b x)))
(and
(check-scaffold-copy x xcopy)
(eqt (cdr result) x)
result))
((a . b) (c . d) (e . f)))
(deftest acons.2
(acons 'a 'b nil)
((a . b)))
(deftest acons.3
(acons 'a 'b 'c)
((a . b) . c))
(deftest acons.4
(acons '((a b)) '(((c d) e) f) '((1 . 2)))
(( ((a b)) . (((c d) e) f)) (1 . 2)))
(deftest acons.5
(acons "ancd" 1.143 nil)
(("ancd" . 1.143)))
(deftest acons.6
(acons #\R :foo :bar)
((#\R . :foo) . :bar))
(deftest acons.order.1
(let ((i 0) x y z)
(values
(acons (progn (setf x (incf i)) 'a)
(progn (setf y (incf i)) 'b)
(progn (setf z (incf i)) '((c . d))))
i x y z))
((a . b)(c . d))
3 1 2 3)
(deftest acons.error.1
(classify-error (acons))
program-error)
(deftest acons.error.2
(classify-error (acons 'a))
program-error)
(deftest acons.error.3
(classify-error (acons 'a 'b))
program-error)
(deftest acons.error.4
(classify-error (acons 'a 'b 'c 'd))
program-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Mar 28 07:33:20 1998
;;;; Contains: Testing of CL Features related to "CONS", part 4
;;;; Contains: Tests of ADJOIN
(in-package :cl-test)
(declaim (optimize (safety 3)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; push
;;; There will be a separate test suite
;;; for ACCESSORS x SETF-like macros
;;; See also places.lsp
(deftest push.1
(let ((x nil))
(push 'a x))
(a))
(deftest push.2
(let ((x 'b))
(push 'a x)
(push 'c x))
(c a . b))
(deftest push.3
(let ((x (copy-tree '(a))))
(push x x)
(and
(eqt (car x) (cdr x))
x))
((a) a))
(deftest push.order.1
(let ((x (list nil)) (i 0) a b)
(values
(push (progn (setf a (incf i)) 'z)
(car (progn (setf b (incf i)) x)))
x
i a b))
(z) ((z)) 2 1 2)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; pop
(deftest pop.1
(let ((x (copy-tree '(a b c))))
(let ((y (pop x)))
(list x y)))
((b c) a))
(deftest pop.2
(let ((x nil))
(let ((y (pop x)))
(list x y)))
(nil nil))
;;; Confirm argument is executed just once.
(deftest pop.order.1
(let ((i 0)
(a (vector (list 'a 'b 'c))))
(pop (aref a (progn (incf i) 0)))
(values a i))
#((b c)) 1)
(deftest push-and-pop
(let* ((x (copy-tree '(a b)))
(y x))
(push 'c x)
(and
(eqt (cdr x) y)
(pop x)))
c)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; pushnew
;;; See also places.lsp
(deftest pushnew.1
(let ((x nil))
(let ((y (pushnew 'a x)))
(and
(eqt x y)
(equal x '(a))
t)))
t)
(deftest pushnew.2
(let* ((x (copy-tree '(b c d a k f q)))
(y (pushnew 'a x)))
(and
(eqt x y)
x))
(b c d a k f q))
(deftest pushnew.3
(let* ((x (copy-tree '(1 2 3 4 5 6 7 8)))
(y (pushnew 7 x)))
(and
(eqt x y)
x))
(1 2 3 4 5 6 7 8))
(deftest pushnew.4
(let* ((x (copy-tree '((a b) 1 "and" c d e)))
(y (pushnew (copy-tree '(c d)) x
:test 'equal)))
(and (eqt x y)
x))
((c d) (a b) 1 "and" c d e))
(deftest pushnew.5
(let* ((x (copy-tree '((a b) 1 "and" c d e)))
(y (pushnew (copy-tree '(a b)) x
:test 'equal)))
(and
(eqt x y)
x))
((a b) 1 "and" c d e))
(deftest pushnew.6
(let* ((x (copy-tree '((a b) (c e) (d f) (g h))))
(y (pushnew (copy-tree '(d i)) x :key #'car))
(z (pushnew (copy-tree '(z 10)) x :key #'car)))
(and (eqt y (cdr z))
(eqt z x)
x))
((z 10) (a b) (c e) (d f) (g h)))
(deftest pushnew.7
(let* ((x (copy-tree '(("abc" 1) ("def" 2) ("ghi" 3))))
(y (pushnew (copy-tree '("def" 4)) x
:key #'car :test #'string=))
(z (pushnew (copy-tree '("xyz" 10))
x
:key #'car :test #'string=)))
(and
(eqt y (cdr x))
(eqt x z)
x))
(("xyz" 10) ("abc" 1) ("def" 2) ("ghi" 3)))
(deftest pushnew.8
(let* ((x (copy-tree '(("abc" 1) ("def" 2) ("ghi" 3))))
(y (pushnew (copy-tree '("def" 4)) x
:key #'car :test-not (complement #'string=)))
(z (pushnew (copy-tree '("xyz" 10)) x
:key #'car :test-not (complement #'string=))))
(and
(eqt y (cdr x))
(eqt x z)
x))
(("xyz" 10) ("abc" 1) ("def" 2) ("ghi" 3)))
(deftest pushnew.9
(let* ((x (copy-tree '(("abc" 1) ("def" 2) ("ghi" 3))))
(y (pushnew (copy-tree '("def" 4)) x
:key 'car :test-not (complement #'string=)))
(z (pushnew (copy-tree '("xyz" 10)) x
:key 'car :test-not (complement #'string=))))
(and
(eqt y (cdr x))
(eqt x z)
x))
(("xyz" 10) ("abc" 1) ("def" 2) ("ghi" 3)))
;; Check that a NIL :key argument is the same as no key argument at all
(deftest pushnew.10
(let* ((x (list 'a 'b 'c 'd))
(result (pushnew 'z x :key nil)))
result)
(z a b c d))
;; Check that a NIL :key argument is the same as no key argument at all
(deftest pushnew.11
(let* ((x (copy-tree '((a b) 1 "and" c d e)))
(y (pushnew (copy-tree '(a b)) x
:test 'equal :key nil)))
(and
(eqt x y)
x))
((a b) 1 "and" c d e))
(deftest pushnew.12
(let ((i 0) x y z (d '(b c)))
(values
(pushnew (progn (setf x (incf i)) 'a)
d
:key (progn (setf y (incf i)) #'identity)
:test (progn (setf z (incf i)) #'eql))
d i x y z))
(a b c) (a b c)
3 1 2 3)
(deftest pushnew.13
(let ((i 0) x y z (d '(b c)))
(values
(pushnew (progn (setf x (incf i)) 'a)
d
:key (progn (setf y (incf i)) #'identity)
:test-not (progn (setf z (incf i)) (complement #'eql)))
d i x y z))
(a b c) (a b c)
3 1 2 3)
(deftest pushnew.14
(let ((i 0) x y z (d '(b c)))
(values
(pushnew (progn (setf x (incf i)) 'a)
d
:test (progn (setf z (incf i)) #'eql)
:key (progn (setf y (incf i)) #'identity))
d i x y z))
(a b c) (a b c)
3 1 3 2)
(deftest pushnew.15
(let ((i 0) x y z (d '(b c)))
(values
(pushnew (progn (setf x (incf i)) 'a)
d
:test-not (progn (setf z (incf i)) (complement #'eql))
:key (progn (setf y (incf i)) #'identity))
d i x y z))
(a b c) (a b c)
3 1 3 2)
(deftest pushnew.error.1
(classify-error
(let ((x '(a b)))
(pushnew 'c x :test #'identity)))
program-error)
(deftest pushnew.error.2
(classify-error
(let ((x '(a b)))
(pushnew 'c x :test-not #'identity)))
program-error)
(deftest pushnew.error.3
(classify-error
(let ((x '(a b)))
(pushnew 'c x :key #'cons)))
program-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; adjoin
(deftest adjoin.1
(adjoin 'a nil)
(a))
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Apr 19 22:36:46 2003
;;;; Contains: Tests of APPEND
(in-package :cl-test)
(deftest append.1
(append)
nil)
(deftest append.2
(append 'x)
x)
(deftest append.3
(let ((x (list 'a 'b 'c 'd))
(y (list 'e 'f 'g)))
(let ((xcopy (make-scaffold-copy x))
(ycopy (make-scaffold-copy y)))
(let ((result (append x y)))
(and
(check-scaffold-copy x xcopy)
(check-scaffold-copy y ycopy)
result))))
(a b c d e f g))
(deftest append.4
(append (list 'a) (list 'b) (list 'c)
(list 'd) (list 'e) (list 'f)
(list 'g) 'h)
(a b c d e f g . h))
(deftest append.5
(append nil nil nil nil nil nil nil nil 'a)
a)
(deftest append.6
(append-6-body)
0)
(deftest append.order.1
(let ((i 0) x y z)
(values
(append (progn (setf x (incf i)) (copy-list '(a b c)))
(progn (setf y (incf i)) (copy-list '(d e f)))
(progn (setf z (incf i)) (copy-list '(g h i))))
i x y z))
(a b c d e f g h i) 3 1 2 3)
(deftest append.order.2
(let ((i 0)) (values (append (incf i)) i))
1 1)
(deftest append.error.1
(classify-error (append '(a . b) '(z)))
type-error)
(deftest append.error.2
(classify-error (append '(x y z) '(a . b) '(z)))
type-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Apr 20 07:28:37 2003
;;;; Contains: Tests of ASSOC-IF-NOT
(in-package :cl-test)
(deftest assoc-if-not.1
(let* ((x (copy-list '((1 . a) (3 . b) (6 . c) (7 . d))))
(xcopy (make-scaffold-copy x))
(result (assoc-if-not #'oddp x)))
(and
(check-scaffold-copy x xcopy)
(eqt result (third x))
result))
(6 . c))
(deftest assoc-if-not.2
(let* ((x (copy-list '((1 . a) (3 . b) (6 . c) (7 . d))))
(xcopy (make-scaffold-copy x))
(result (assoc-if-not #'evenp x :key #'1+)))
(and
(check-scaffold-copy x xcopy)
(eqt result (third x))
result))
(6 . c))
(deftest assoc-if-not.3
(let* ((x (copy-list '((1 . a) nil (3 . b) (6 . c) (7 . d))))
(xcopy (make-scaffold-copy x))
(result (assoc-if-not #'oddp x)))
(and
(check-scaffold-copy x xcopy)
(eqt result (fourth x))
result))
(6 . c))
(deftest assoc-if-not.4
(assoc-if-not #'identity '((a . b) nil (c . d) (nil . e) (f . g)))
(nil . e))
;;; Order of argument evaluation tests
(deftest assoc-if-not.order.1
(let ((i 0) x y)
(values
(assoc-if-not (progn (setf x (incf i)) #'identity)
(progn (setf y (incf i))
'((a . 1) (b . 2) (nil . 17) (d . 4))))
i x y))
(nil . 17) 2 1 2)
(deftest assoc-if-not.order.2
(let ((i 0) x y z)
(values
(assoc-if-not (progn (setf x (incf i)) #'identity)
(progn (setf y (incf i))
'((a . 1) (b . 2) (nil . 17) (d . 4)))
:key (progn (setf z (incf i)) #'null))
i x y z))
(a . 1) 3 1 2 3)
;;; Keyword tests
(deftest assoc-if-not.allow-other-keys.1
(assoc-if-not #'identity
'((a . 1) (nil . 2) (c . 3)) :bad t :allow-other-keys t)
(nil . 2))
(deftest assoc-if-not.allow-other-keys.2
(assoc-if-not #'identity '((a . 1) (nil . 2) (c . 3))
:allow-other-keys t :also-bad t)
(nil . 2))
(deftest assoc-if-not.allow-other-keys.3
(assoc-if-not #'identity '((a . 1) (nil . 2) (c . 3))
:allow-other-keys t :also-bad t :key #'not)
(a . 1))
(deftest assoc-if-not.allow-other-keys.4
(assoc-if-not #'identity '((a . 1) (nil . 2) (c . 3)) :allow-other-keys t)
(nil . 2))
(deftest assoc-if-not.allow-other-keys.5
(assoc-if-not #'identity '((a . 1) (nil . 2) (c . 3)) :allow-other-keys nil)
(nil . 2))
(deftest assoc-if-not.keywords.6
(assoc-if-not #'identity '((a . 1) (nil . 2) (c . 3))
:key #'identity :key #'null)
(nil . 2))
(deftest assoc-if-not.keywords.7
(assoc-if-not #'identity '((a . 1) (nil . 2) (c . 3)) :key nil :key #'null)
(nil . 2))
;;; Error tests
(deftest assoc-if-not.error.1
(classify-error (assoc-if-not))
program-error)
(deftest assoc-if-not.error.2
(classify-error (assoc-if-not #'null))
program-error)
(deftest assoc-if-not.error.3
(classify-error (assoc-if-not #'null nil :bad t))
program-error)
(deftest assoc-if-not.error.4
(classify-error (assoc-if-not #'null nil :key))
program-error)
(deftest assoc-if-not.error.5
(classify-error (assoc-if-not #'null nil 1 1))
program-error)
(deftest assoc-if-not.error.6
(classify-error (assoc-if-not #'null nil :bad t :allow-other-keys nil))
program-error)
(deftest assoc-if-not.error.7
(classify-error (assoc-if-not #'cons '((a b)(c d))))
program-error)
(deftest assoc-if-not.error.8
(classify-error (assoc-if-not #'identity '((a b)(c d)) :key #'cons))
program-error)
(deftest assoc-if-not.error.9
(classify-error (assoc-if-not #'car '((a b)(c d))))
type-error)
(deftest assoc-if-not.error.10
(classify-error (assoc-if-not #'identity '((a b)(c d)) :key #'car))
type-error)
(deftest assoc-if-not.error.11
(classify-error (assoc-if-not #'identity '((a . b) . c)))
type-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Apr 20 07:27:57 2003
;;;; Contains: Tests of ASSOC-IF
(in-package :cl-test)
(deftest assoc-if.1
(let* ((x (copy-list '((1 . a) (3 . b) (6 . c) (7 . d))))
(xcopy (make-scaffold-copy x))
(result (assoc-if #'evenp x)))
(and
(check-scaffold-copy x xcopy)
(eqt result (third x))
result))
(6 . c))
(deftest assoc-if.2
(let* ((x (copy-list '((1 . a) (3 . b) (6 . c) (7 . d))))
(xcopy (make-scaffold-copy x))
(result (assoc-if #'oddp x :key #'1+)))
(and
(check-scaffold-copy x xcopy)
(eqt result (third x))
result))
(6 . c))
(deftest assoc-if.3
(let* ((x (copy-list '((1 . a) nil (3 . b) (6 . c) (7 . d))))
(xcopy (make-scaffold-copy x))
(result (assoc-if #'evenp x)))
(and
(check-scaffold-copy x xcopy)
(eqt result (fourth x))
result))
(6 . c))
(deftest assoc-if.4
(assoc-if #'null '((a . b) nil (c . d) (nil . e) (f . g)))
(nil . e))
;;; Order of argument evaluation
(deftest assoc-if.order.1
(let ((i 0) x y)
(values
(assoc-if (progn (setf x (incf i)) #'null)
(progn (setf y (incf i))
'((a . 1) (b . 2) (nil . 17) (d . 4))))
i x y))
(nil . 17) 2 1 2)
(deftest assoc-if.order.2
(let ((i 0) x y z)
(values
(assoc-if (progn (setf x (incf i)) #'null)
(progn (setf y (incf i))
'((a . 1) (b . 2) (nil . 17) (d . 4)))
:key (progn (setf z (incf i)) #'null))
i x y z))
(a . 1) 3 1 2 3)
;;; Keyword tests
(deftest assoc-if.allow-other-keys.1
(assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :bad t :allow-other-keys t)
(nil . 2))
(deftest assoc-if.allow-other-keys.2
(assoc-if #'null '((a . 1) (nil . 2) (c . 3))
:allow-other-keys t :also-bad t)
(nil . 2))
(deftest assoc-if.allow-other-keys.3
(assoc-if #'null '((a . 1) (nil . 2) (c . 3))
:allow-other-keys t :also-bad t :key #'not)
(a . 1))
(deftest assoc-if.allow-other-keys.4
(assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :allow-other-keys t)
(nil . 2))
(deftest assoc-if.allow-other-keys.5
(assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :allow-other-keys nil)
(nil . 2))
(deftest assoc-if.keywords.6
(assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :key #'identity :key #'null)
(nil . 2))
(deftest assoc-if.keywords.7
(assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :key nil :key #'null)
(nil . 2))
;;; Error cases
(deftest assoc-if.error.1
(classify-error (assoc-if))
program-error)
(deftest assoc-if.error.2
(classify-error (assoc-if #'null))
program-error)
(deftest assoc-if.error.3
(classify-error (assoc-if #'null nil :bad t))
program-error)
(deftest assoc-if.error.4
(classify-error (assoc-if #'null nil :key))
program-error)
(deftest assoc-if.error.5
(classify-error (assoc-if #'null nil 1 1))
program-error)
(deftest assoc-if.error.6
(classify-error (assoc-if #'null nil :bad t :allow-other-keys nil))
program-error)
(deftest assoc-if.error.7
(classify-error (assoc-if #'cons '((a b)(c d))))
program-error)
(deftest assoc-if.error.8
(classify-error (assoc-if #'identity '((a b)(c d)) :key #'cons))
program-error)
(deftest assoc-if.error.9
(classify-error (assoc-if #'car '((a b)(c d))))
type-error)
(deftest assoc-if.error.10
(classify-error (assoc-if #'identity '((a b)(c d)) :key #'car))
type-error)
(deftest assoc-if.error.11
(classify-error (assoc-if #'null '((a . b) . c)))
type-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Apr 19 21:28:09 2003
;;;; Contains: Tests of ATOM
(in-package :cl-test)
(deftest atom.order.1
(let ((i 0))
(values (atom (progn (incf i) '(a b))) i))
nil 1)
(deftest atom.error.1
(classify-error (atom))
program-error)
(deftest atom.error.2
(classify-error (atom 'a 'b))
program-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Apr 19 22:41:14 2003
;;;; Contains: Tests of BUTLAST
(in-package :cl-test)
(deftest butlast.1
(let ((x (list 'a 'b 'c 'd 'e)))
(let ((xcopy (make-scaffold-copy x)))
(let ((result (butlast x 2)))
(and
(check-scaffold-copy x xcopy)
result))))
(a b c))
(deftest butlast.2
(let ((x (list 'a 'b 'c 'd 'e)))
(let ((xcopy (make-scaffold-copy x)))
(let ((result (butlast x 0)))
(and
(check-scaffold-copy x xcopy)
result))))
(a b c d e))
(deftest butlast.3
(let ((x (list 'a 'b 'c 'd 'e)))
(let ((xcopy (make-scaffold-copy x)))
(let ((result (butlast x 5)))
(and
(check-scaffold-copy x xcopy)
result))))
nil)
(deftest butlast.4
(let ((x (list 'a 'b 'c 'd 'e)))
(let ((xcopy (make-scaffold-copy x)))
(let ((result (butlast x 6)))
(and
(check-scaffold-copy x xcopy)
result))))
nil)
(deftest butlast.5
(butlast (copy-tree '(a b c . d)) 1)
(a b))
(deftest butlast.order.1
(let ((i 0) x y)
(values
(butlast (progn (setf x (incf i))
(list 'a 'b 'c 'd 'e))
(progn (setf y (incf i))
2))
i x y))
(a b c) 2 1 2)
(deftest butlast.order.2
(let ((i 0))
(values
(butlast (progn (incf i) '(a b c d)))
i))
(a b c) 1)
(deftest butlast.error.1
(classify-error (butlast (copy-tree '(a b c d)) 'a))
type-error)
(deftest butlast.error.2
(classify-error (butlast 'a 0))