source: trunk/source/tests/ansi-tests/adjoin.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 5.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Mar 28 07:33:20 1998
4;;;; Contains:  Tests of ADJOIN
5
6(in-package :cl-test)
7
8(compile-and-load "cons-aux.lsp")
9
10(deftest adjoin.1
11  (adjoin 'a nil)
12  (a))
13
14(deftest adjoin.2
15  (adjoin nil nil)
16  (nil))
17
18(deftest adjoin.3
19  (adjoin 'a '(a))
20  (a))
21
22;; Check that a NIL :key argument is the same as no key argument at all
23(deftest adjoin.4
24  (adjoin 'a '(a) :key nil)
25  (a))
26
27(deftest adjoin.5
28  (adjoin 'a '(a) :key #'identity)
29  (a))
30
31(deftest adjoin.6
32  (adjoin 'a '(a) :key 'identity)
33  (a))
34
35(deftest adjoin.7
36  (adjoin (1+ 11) '(4 3 12 2 1))
37  (4 3 12 2 1))
38
39;; Check that the test is EQL, not EQ (by adjoining a bignum)
40(deftest adjoin.8
41  (adjoin (1+ 999999999999) '(4 1 1000000000000 3816734 a "aa"))
42  (4 1 1000000000000 3816734 a "aa"))
43
44(deftest adjoin.9
45  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a))
46  ("aaa" aaa "AAA" "aaa" #\a))
47
48(deftest adjoin.10
49  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) :test #'equal)
50  (aaa "AAA" "aaa" #\a))
51
52(deftest adjoin.11
53  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) :test 'equal)
54  (aaa "AAA" "aaa" #\a))
55
56(deftest adjoin.12
57  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
58          :test-not (complement #'equal))
59  (aaa "AAA" "aaa" #\a))
60
61(deftest adjoin.14
62  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
63          :test #'equal :key #'identity)
64  (aaa "AAA" "aaa" #\a))
65
66(deftest adjoin.15
67  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
68          :test 'equal :key #'identity)
69  (aaa "AAA" "aaa" #\a))
70
71;; Test that a :key of NIL is the same as no key at all
72(deftest adjoin.16
73  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
74          :test #'equal :key nil)
75  (aaa "AAA" "aaa" #\a))
76
77;; Test that a :key of NIL is the same as no key at all
78(deftest adjoin.17
79  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
80          :test 'equal :key nil)
81  (aaa "AAA" "aaa" #\a))
82
83;; Test that a :key of NIL is the same as no key at all
84(deftest adjoin.18
85  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
86          :test-not (complement #'equal) :key nil)
87  (aaa "AAA" "aaa" #\a))
88
89;;; Ordering in comparison function
90
91(deftest adjoin.19
92  (adjoin 10 '(1 2 3) :test #'<)
93  (10 1 2 3))
94
95(deftest adjoin.20
96  (adjoin 10 '(1 2 3) :test #'>)
97  (1 2 3))
98
99(deftest adjoin.21
100  (adjoin 10 '(1 2 3) :test-not #'>)
101  (10 1 2 3))
102
103(deftest adjoin.22
104  (adjoin 10 '(1 2 3) :test-not #'<)
105  (1 2 3))
106
107;;; Test that :key satisfies the description in 17.2.1
108;;; This contradicts other parts of the spec, particularly
109;;; PUSHNEW, so the test is commented out.
110;;; (deftest adjoin.23
111;;;  (adjoin 1 '(1 2 3) :key '1+)
112;;;  (1 1 2 3))
113
114(deftest adjoin.24
115  (macrolet ((%m (z) z))
116            (values
117             (adjoin (expand-in-current-env (%m 'a)) '(b c))
118             (adjoin 'a (expand-in-current-env (%m '(b c))))
119             (adjoin 'a '(b c) (expand-in-current-env (%m :test)) 'eql)
120             (adjoin 'a '(a a) (expand-in-current-env (%m :test-not)) 'eql)
121             (adjoin 'a '(b c) :test (expand-in-current-env (%m 'eql)))
122             (adjoin 'a '(b c) :test (expand-in-current-env (%m #'eql)))
123             (adjoin 1 '(1 2 3) :key (expand-in-current-env (%m 'identity)))
124             ))
125  (a b c)
126  (a b c)
127  (a b c)
128  (a a a)
129  (a b c)
130  (a b c)
131  (1 2 3))
132
133(defharmless adjoin.test-and-test-not.1
134  (adjoin 'a '(b c) :test #'eql :test-not #'eql))
135
136(defharmless adjoin.test-and-test-not.2
137  (adjoin 'a '(b c) :test-not #'eql :test #'eql))
138
139(deftest adjoin.order.1
140  (let ((i 0) w x y z)
141    (values
142     (adjoin (progn (setf w (incf i)) 'a)
143             (progn (setf x (incf i)) '(b c d a e))
144             :key (progn (setf y (incf i)) #'identity)
145             :test (progn (setf z (incf i)) #'eql))
146     i w x y z))
147  (b c d a e)
148  4 1 2 3 4)
149
150(deftest adjoin.order.2
151  (let ((i 0) w x y z p)
152    (values
153     (adjoin (progn (setf w (incf i)) 'a)
154             (progn (setf x (incf i)) '(b c d e))
155             :test-not (progn (setf y (incf i)) (complement #'eql))
156             :key (progn (setf z (incf i)) #'identity)
157             :key (progn (setf p (incf i)) nil))
158     i w x y z p))
159  (a b c d e)
160  5 1 2 3 4 5)
161
162(def-fold-test adjoin.fold.1 (adjoin 'x '(a b c nil d)))
163
164(deftest adjoin.allow-other-keys.1
165  (adjoin 'a '(b c) :bad t :allow-other-keys t)
166  (a b c))
167
168(deftest adjoin.allow-other-keys.2
169  (adjoin 'a '(b c) :allow-other-keys t :foo t)
170  (a b c))
171
172(deftest adjoin.allow-other-keys.3
173  (adjoin 'a '(b c) :allow-other-keys t)
174  (a b c))
175
176(deftest adjoin.allow-other-keys.4
177  (adjoin 'a '(b c) :allow-other-keys nil)
178  (a b c))
179
180(deftest adjoin.allow-other-keys.5
181  (adjoin 'a '(b c) :allow-other-keys t :allow-other-keys nil 'bad t)
182  (a b c))
183
184(deftest adjoin.repeat-key
185  (adjoin 'a '(b c) :test #'eq :test (complement #'eq))
186  (a b c))
187
188(deftest adjoin.error.1
189  (signals-error (adjoin) program-error)
190  t)
191
192(deftest adjoin.error.2
193  (signals-error (adjoin 'a) program-error)
194  t)
195
196(deftest adjoin.error.3
197  (signals-error (adjoin 'a '(b c) :bad t) program-error)
198  t)
199
200(deftest adjoin.error.4
201  (signals-error (adjoin 'a '(b c) :allow-other-keys nil :bad t) program-error)
202  t)
203
204(deftest adjoin.error.5
205  (signals-error (adjoin 'a '(b c) 1 2) program-error)
206  t)
207
208(deftest adjoin.error.6
209  (signals-error (adjoin 'a '(b c) :test) program-error)
210  t)
211
212(deftest adjoin.error.7
213  (signals-error (adjoin 'a '(b c) :test #'identity) program-error)
214  t)
215
216(deftest adjoin.error.8
217  (signals-error (adjoin 'a '(b c) :test-not #'identity) program-error)
218  t)
219
220(deftest adjoin.error.9
221  (signals-error (adjoin 'a '(b c) :key #'cons) program-error)
222  t)
223
224(deftest adjoin.error.10
225  (signals-error (adjoin 'a (list* 'b 'c 'd)) type-error)
226  t)
Note: See TracBrowser for help on using the repository browser.