adjoin.lsp 5.56 KB
Newer Older
1
2
3
4
5
6
7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Mar 28 07:33:20 1998
;;;; Contains:  Tests of ADJOIN

(in-package :cl-test)

8
9
(compile-and-load "cons-aux.lsp")

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
(deftest adjoin.1
  (adjoin 'a nil)
  (a))

(deftest adjoin.2
  (adjoin nil nil)
  (nil))

(deftest adjoin.3
  (adjoin 'a '(a))
  (a))

;; Check that a NIL :key argument is the same as no key argument at all
(deftest adjoin.4
  (adjoin 'a '(a) :key nil)
  (a))

(deftest adjoin.5
  (adjoin 'a '(a) :key #'identity)
  (a))

(deftest adjoin.6
  (adjoin 'a '(a) :key 'identity)
  (a))

(deftest adjoin.7
  (adjoin (1+ 11) '(4 3 12 2 1))
  (4 3 12 2 1))

;; Check that the test is EQL, not EQ (by adjoining a bignum)
(deftest adjoin.8
  (adjoin (1+ 999999999999) '(4 1 1000000000000 3816734 a "aa"))
  (4 1 1000000000000 3816734 a "aa"))

(deftest adjoin.9
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a))
  ("aaa" aaa "AAA" "aaa" #\a))

(deftest adjoin.10
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) :test #'equal)
  (aaa "AAA" "aaa" #\a))

(deftest adjoin.11
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) :test 'equal)
  (aaa "AAA" "aaa" #\a))

(deftest adjoin.12
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
sds's avatar
sds committed
58
          :test-not (complement #'equal))
59
60
61
62
  (aaa "AAA" "aaa" #\a))

(deftest adjoin.14
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
sds's avatar
sds committed
63
          :test #'equal :key #'identity)
64
65
66
67
  (aaa "AAA" "aaa" #\a))

(deftest adjoin.15
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
sds's avatar
sds committed
68
          :test 'equal :key #'identity)
69
70
71
72
73
  (aaa "AAA" "aaa" #\a))

;; Test that a :key of NIL is the same as no key at all
(deftest adjoin.16
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
sds's avatar
sds committed
74
          :test #'equal :key nil)
75
76
77
78
79
  (aaa "AAA" "aaa" #\a))

;; Test that a :key of NIL is the same as no key at all
(deftest adjoin.17
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
sds's avatar
sds committed
80
          :test 'equal :key nil)
81
82
83
84
85
  (aaa "AAA" "aaa" #\a))

;; Test that a :key of NIL is the same as no key at all
(deftest adjoin.18
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
sds's avatar
sds committed
86
          :test-not (complement #'equal) :key nil)
87
88
  (aaa "AAA" "aaa" #\a))

89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
;;; Ordering in comparison function

(deftest adjoin.19
  (adjoin 10 '(1 2 3) :test #'<)
  (10 1 2 3))

(deftest adjoin.20
  (adjoin 10 '(1 2 3) :test #'>)
  (1 2 3))

(deftest adjoin.21
  (adjoin 10 '(1 2 3) :test-not #'>)
  (10 1 2 3))

(deftest adjoin.22
  (adjoin 10 '(1 2 3) :test-not #'<)
  (1 2 3))

107
108
109
110
111
112
113
114
115
;;; Test that :key satisfies the description in 17.2.1
;;; This contradicts other parts of the spec, particularly
;;; PUSHNEW, so the test is commented out.
;;; (deftest adjoin.23
;;;  (adjoin 1 '(1 2 3) :key '1+)
;;;  (1 1 2 3))

(deftest adjoin.24
  (macrolet ((%m (z) z))
sds's avatar
sds committed
116
117
118
119
120
121
122
123
124
            (values
             (adjoin (expand-in-current-env (%m 'a)) '(b c))
             (adjoin 'a (expand-in-current-env (%m '(b c))))
             (adjoin 'a '(b c) (expand-in-current-env (%m :test)) 'eql)
             (adjoin 'a '(a a) (expand-in-current-env (%m :test-not)) 'eql)
             (adjoin 'a '(b c) :test (expand-in-current-env (%m 'eql)))
             (adjoin 'a '(b c) :test (expand-in-current-env (%m #'eql)))
             (adjoin 1 '(1 2 3) :key (expand-in-current-env (%m 'identity)))
             ))
125
126
127
128
129
130
131
132
  (a b c)
  (a b c)
  (a b c)
  (a a a)
  (a b c)
  (a b c)
  (1 2 3))

133
134
135
136
137
(defharmless adjoin.test-and-test-not.1
  (adjoin 'a '(b c) :test #'eql :test-not #'eql))

(defharmless adjoin.test-and-test-not.2
  (adjoin 'a '(b c) :test-not #'eql :test #'eql))
138

139
140
141
142
(deftest adjoin.order.1
  (let ((i 0) w x y z)
    (values
     (adjoin (progn (setf w (incf i)) 'a)
sds's avatar
sds committed
143
144
145
             (progn (setf x (incf i)) '(b c d a e))
             :key (progn (setf y (incf i)) #'identity)
             :test (progn (setf z (incf i)) #'eql))
146
147
148
149
150
151
152
153
     i w x y z))
  (b c d a e)
  4 1 2 3 4)

(deftest adjoin.order.2
  (let ((i 0) w x y z p)
    (values
     (adjoin (progn (setf w (incf i)) 'a)
sds's avatar
sds committed
154
155
156
157
             (progn (setf x (incf i)) '(b c d e))
             :test-not (progn (setf y (incf i)) (complement #'eql))
             :key (progn (setf z (incf i)) #'identity)
             :key (progn (setf p (incf i)) nil))
158
159
160
161
     i w x y z p))
  (a b c d e)
  5 1 2 3 4 5)

pfdietz's avatar
pfdietz committed
162
163
(def-fold-test adjoin.fold.1 (adjoin 'x '(a b c nil d)))

164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
(deftest adjoin.allow-other-keys.1
  (adjoin 'a '(b c) :bad t :allow-other-keys t)
  (a b c))

(deftest adjoin.allow-other-keys.2
  (adjoin 'a '(b c) :allow-other-keys t :foo t)
  (a b c))

(deftest adjoin.allow-other-keys.3
  (adjoin 'a '(b c) :allow-other-keys t)
  (a b c))

(deftest adjoin.allow-other-keys.4
  (adjoin 'a '(b c) :allow-other-keys nil)
  (a b c))

(deftest adjoin.allow-other-keys.5
  (adjoin 'a '(b c) :allow-other-keys t :allow-other-keys nil 'bad t)
  (a b c))

(deftest adjoin.repeat-key
  (adjoin 'a '(b c) :test #'eq :test (complement #'eq))
186
  (a b c))
187
188

(deftest adjoin.error.1
189
190
  (signals-error (adjoin) program-error)
  t)
191
192

(deftest adjoin.error.2
193
194
  (signals-error (adjoin 'a) program-error)
  t)
195
196

(deftest adjoin.error.3
197
198
  (signals-error (adjoin 'a '(b c) :bad t) program-error)
  t)
199
200

(deftest adjoin.error.4
201
202
  (signals-error (adjoin 'a '(b c) :allow-other-keys nil :bad t) program-error)
  t)
203
204

(deftest adjoin.error.5
205
206
  (signals-error (adjoin 'a '(b c) 1 2) program-error)
  t)
207
208

(deftest adjoin.error.6
209
210
  (signals-error (adjoin 'a '(b c) :test) program-error)
  t)
211
212

(deftest adjoin.error.7
213
214
  (signals-error (adjoin 'a '(b c) :test #'identity) program-error)
  t)
215
216

(deftest adjoin.error.8
217
218
  (signals-error (adjoin 'a '(b c) :test-not #'identity) program-error)
  t)
219
220

(deftest adjoin.error.9
221
222
  (signals-error (adjoin 'a '(b c) :key #'cons) program-error)
  t)
223
224

(deftest adjoin.error.10
225
226
  (signals-error (adjoin 'a (list* 'b 'c 'd)) type-error)
  t)