2
;;;; Author: Paul Dietz
3
;;;; Created: Sun Apr 20 07:34:59 2003
4
;;;; Contains: Tests of RASSOC-IF
8
(compile-and-load "cons-aux.lsp")
11
(let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d))))
12
(xcopy (make-scaffold-copy x))
13
(result (rassoc-if #'evenp x)))
15
(check-scaffold-copy x xcopy)
16
(eqt result (third x))
21
(let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d))))
22
(xcopy (make-scaffold-copy x))
23
(result (rassoc-if #'oddp x :key #'1+)))
25
(check-scaffold-copy x xcopy)
26
(eqt result (third x))
31
(let* ((x (rev-assoc-list '((1 . a) nil (3 . b) (6 . c) (7 . d))))
32
(xcopy (make-scaffold-copy x))
33
(result (rassoc-if #'evenp x)))
35
(check-scaffold-copy x xcopy)
36
(eqt result (fourth x))
42
(rev-assoc-list '((a . b) nil (c . d) (nil . e) (f . g))))
45
;;; Order of argument evaluation
47
(deftest rassoc-if.order.1
50
(rassoc-if (progn (setf x (incf i)) #'null)
51
(progn (setf y (incf i))
52
'((1 . a) (2 . b) (17) (4 . d))))
56
(deftest rassoc-if.order.2
59
(rassoc-if (progn (setf x (incf i)) #'null)
60
(progn (setf y (incf i))
61
'((1 . a) (2 . b) (17) (4 . d)))
62
:key (progn (setf z (incf i)) #'null))
69
(deftest rassoc-if.allow-other-keys.1
70
(rassoc-if #'null '((1 . a) (2) (3 . c)) :bad t :allow-other-keys t)
73
(deftest rassoc-if.allow-other-keys.2
74
(rassoc-if #'null '((1 . a) (2) (3 . c)) :allow-other-keys t :bad t)
77
(deftest rassoc-if.allow-other-keys.3
78
(rassoc-if #'identity '((1 . a) (2) (3 . c)) :allow-other-keys t :bad t
82
(deftest rassoc-if.allow-other-keys.4
83
(rassoc-if #'null '((1 . a) (2) (3 . c)) :allow-other-keys t)
86
(deftest rassoc-if.allow-other-keys.5
87
(rassoc-if #'null '((1 . a) (2) (3 . c)) :allow-other-keys nil)
90
(deftest rassoc-if.keywords.6
91
(rassoc-if #'identity '((1 . a) (2) (3 . c)) :key #'not :key #'identity)
96
(deftest rassoc-if.error.1
97
(signals-error (rassoc-if) program-error)
100
(deftest rassoc-if.error.2
101
(signals-error (rassoc-if #'null) program-error)
104
(deftest rassoc-if.error.3
105
(signals-error (rassoc-if #'null nil :bad t) program-error)
108
(deftest rassoc-if.error.4
109
(signals-error (rassoc-if #'null nil :key) program-error)
112
(deftest rassoc-if.error.5
113
(signals-error (rassoc-if #'null nil 1 1) program-error)
116
(deftest rassoc-if.error.6
117
(signals-error (rassoc-if #'null nil :bad t :allow-other-keys nil) program-error)
120
(deftest rassoc-if.error.7
121
(signals-error (rassoc-if #'cons '((a . b)(c . d))) program-error)
124
(deftest rassoc-if.error.8
125
(signals-error (rassoc-if #'car '((a . b)(c . d))) type-error)
128
(deftest rassoc-if.error.9
129
(signals-error (rassoc-if #'identity '((a . b)(c . d)) :key #'cons) program-error)
132
(deftest rassoc-if.error.10
133
(signals-error (rassoc-if #'identity '((a . b)(c . d)) :key #'car) type-error)
136
(deftest rassoc-if.error.11
137
(signals-error (rassoc-if #'not '((a . b) . c)) type-error)