2
;;;; Author: Paul Dietz
3
;;;; Created: Sun Apr 20 07:27:57 2003
4
;;;; Contains: Tests of ASSOC-IF
8
(compile-and-load "cons-aux.lsp")
11
(let* ((x (copy-list '((1 . a) (3 . b) (6 . c) (7 . d))))
12
(xcopy (make-scaffold-copy x))
13
(result (assoc-if #'evenp x)))
15
(check-scaffold-copy x xcopy)
16
(eqt result (third x))
21
(let* ((x (copy-list '((1 . a) (3 . b) (6 . c) (7 . d))))
22
(xcopy (make-scaffold-copy x))
23
(result (assoc-if #'oddp x :key #'1+)))
25
(check-scaffold-copy x xcopy)
26
(eqt result (third x))
31
(let* ((x (copy-list '((1 . a) nil (3 . b) (6 . c) (7 . d))))
32
(xcopy (make-scaffold-copy x))
33
(result (assoc-if #'evenp x)))
35
(check-scaffold-copy x xcopy)
36
(eqt result (fourth x))
41
(assoc-if #'null '((a . b) nil (c . d) (nil . e) (f . g)))
45
(let () (assoc-if #'null '((a . b) nil (c . d) (nil . e) (f . g))))
49
;;; Order of argument evaluation
51
(deftest assoc-if.order.1
54
(assoc-if (progn (setf x (incf i)) #'null)
55
(progn (setf y (incf i))
56
'((a . 1) (b . 2) (nil . 17) (d . 4))))
60
(deftest assoc-if.order.2
63
(assoc-if (progn (setf x (incf i)) #'null)
64
(progn (setf y (incf i))
65
'((a . 1) (b . 2) (nil . 17) (d . 4)))
66
:key (progn (setf z (incf i)) #'null))
72
(deftest assoc-if.allow-other-keys.1
73
(assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :bad t :allow-other-keys t)
76
(deftest assoc-if.allow-other-keys.2
77
(assoc-if #'null '((a . 1) (nil . 2) (c . 3))
78
:allow-other-keys t :also-bad t)
81
(deftest assoc-if.allow-other-keys.3
82
(assoc-if #'null '((a . 1) (nil . 2) (c . 3))
83
:allow-other-keys t :also-bad t :key #'not)
86
(deftest assoc-if.allow-other-keys.4
87
(assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :allow-other-keys t)
90
(deftest assoc-if.allow-other-keys.5
91
(assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :allow-other-keys nil)
94
(deftest assoc-if.keywords.6
95
(assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :key #'identity :key #'null)
98
(deftest assoc-if.keywords.7
99
(assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :key nil :key #'null)
104
(deftest assoc-if.error.1
105
(signals-error (assoc-if) program-error)
108
(deftest assoc-if.error.2
109
(signals-error (assoc-if #'null) program-error)
112
(deftest assoc-if.error.3
113
(signals-error (assoc-if #'null nil :bad t)
117
(deftest assoc-if.error.4
118
(signals-error (assoc-if #'null nil :key)
122
(deftest assoc-if.error.5
123
(signals-error (assoc-if #'null nil 1 1)
127
(deftest assoc-if.error.6
128
(signals-error (assoc-if #'null nil :bad t :allow-other-keys nil)
132
(deftest assoc-if.error.7
133
(signals-error (assoc-if #'cons '((a b)(c d)))
137
(deftest assoc-if.error.8
138
(signals-error (assoc-if #'identity '((a b)(c d)) :key #'cons)
142
(deftest assoc-if.error.9
143
(signals-error (assoc-if #'car '((a b)(c d)))
147
(deftest assoc-if.error.10
148
(signals-error (assoc-if #'identity '((a b)(c d)) :key #'car)
152
(deftest assoc-if.error.11
153
(signals-error (assoc-if #'null '((a . b) . c))
157
(deftest assoc-if.error.12
158
(signals-error (assoc-if #'null '((a . b) :bad (c . d)))
162
(deftest assoc-if.error.13
163
(signals-error (assoc-if #'null 'y) type-error)