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