/[gcl]/gcl/ansi-tests/cons-test-20.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/cons-test-20.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8 by pfdietz, Fri Jan 24 04:22:54 2003 UTC revision 1.9 by pfdietz, Mon Feb 10 03:09:37 2003 UTC
# Line 10  Line 10 
10  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11  ;;; union  ;;; union
12    
13  (deftest union-1  (deftest union.1
14      (union nil nil)    (union nil nil)
15    nil)    nil)
16    
17  (deftest union-2  (deftest union.2
18      (union-with-check (list 'a) nil)    (union-with-check (list 'a) nil)
19    (a))    (a))
20    
21  (deftest union-3  (deftest union.3
22      (union-with-check (list 'a) (list 'a))    (union-with-check (list 'a) (list 'a))
23    (a))    (a))
24    
25  (deftest union-4  (deftest union-4
26      (union-with-check (list 1) (list 1))    (union-with-check (list 1) (list 1))
27    (1))    (1))
28    
29  (deftest union-5  (deftest union.5
30      (let ((x (list 'a 'b)))    (let ((x (list 'a 'b)))
31        (union-with-check (list x) (list x)))      (union-with-check (list x) (list x)))
32    ((a b)))    ((a b)))
33    
34  (deftest union-6  (deftest union.6
35      (let ((x (copy-list '(a b c d e f)))    (let ((x (copy-list '(a b c d e f)))
36            (y (copy-list '(z c y a v b))))          (y (copy-list '(z c y a v b))))
37        (let ((result (union-with-check x y)))      (let ((result (union-with-check x y)))
38          (check-union x y result)))        (check-union x y result)))
39    t)    t)
40    
41  (deftest union-6-a  (deftest union.6-a
42      (let ((x (copy-list '(a b c d e f)))    (let ((x (copy-list '(a b c d e f)))
43            (y (copy-list '(z c y a v b))))          (y (copy-list '(z c y a v b))))
44        (let ((result (union-with-check x y :test #'eq)))      (let ((result (union-with-check x y :test #'eq)))
45          (check-union x y result)))        (check-union x y result)))
46    t)    t)
47    
48  (deftest union-7  (deftest union.7
49      (let ((x (copy-list '(a b c d e f)))    (let ((x (copy-list '(a b c d e f)))
50            (y (copy-list '(z c y a v b))))          (y (copy-list '(z c y a v b))))
51        (let ((result (union-with-check x y :test #'eql)))      (let ((result (union-with-check x y :test #'eql)))
52          (check-union x y result)))        (check-union x y result)))
53    t)    t)
54    
55  (deftest union-8  (deftest union.8
56      (let ((x (copy-list '(a b c d e f)))    (let ((x (copy-list '(a b c d e f)))
57            (y (copy-list '(z c y a v b))))          (y (copy-list '(z c y a v b))))
58        (let ((result (union-with-check x y :test #'equal)))      (let ((result (union-with-check x y :test #'equal)))
59          (check-union x y result)))        (check-union x y result)))
60    t)    t)
61    
62  (deftest union-9  (deftest union.9
63      (let ((x (copy-list '(a b c d e f)))    (let ((x (copy-list '(a b c d e f)))
64            (y (copy-list '(z c y a v b))))          (y (copy-list '(z c y a v b))))
65        (let ((result (union-with-check x y :test-not (complement #'eql))))      (let ((result (union-with-check x y :test-not (complement #'eql))))
66          (check-union x y result)))        (check-union x y result)))
67    t)    t)
68    
69  (deftest union-10  (deftest union.10
70      (let ((x (copy-list '(a b c d e f)))    (let ((x (copy-list '(a b c d e f)))
71            (y (copy-list '(z c y a v b))))          (y (copy-list '(z c y a v b))))
72        (let ((result (union-with-check x y :test-not (complement #'equal))))      (let ((result (union-with-check x y :test-not (complement #'equal))))
73          (check-union x y result)))        (check-union x y result)))
74    t)    t)
75    
76  (deftest union-11  (deftest union.11
77      (let ((x (copy-list '(a b c d e f)))    (let ((x (copy-list '(a b c d e f)))
78            (y (copy-list '(z c y a v b))))          (y (copy-list '(z c y a v b))))
79        (let ((result (union-with-check x y :test-not (complement #'eq))))      (let ((result (union-with-check x y :test-not (complement #'eq))))
80          (check-union x y result)))        (check-union x y result)))
81    t)    t)
82    
83  (deftest union-12  (deftest union.12
84      (let ((x (copy-list '(1 2 3 4 5 6 7)))    (let ((x (copy-list '(1 2 3 4 5 6 7)))
85            (y (copy-list '(10 19 5 3 17 1001 2))))          (y (copy-list '(10 19 5 3 17 1001 2))))
86        (let ((result (union-with-check x y)))      (let ((result (union-with-check x y)))
87          (check-union x y result)))        (check-union x y result)))
88    t)    t)
89    
90  (deftest union-13  (deftest union.13
91      (let ((x (copy-list '(1 2 3 4 5 6 7)))    (let ((x (copy-list '(1 2 3 4 5 6 7)))
92            (y (copy-list '(10 19 5 3 17 1001 2))))          (y (copy-list '(10 19 5 3 17 1001 2))))
93        (let ((result (union-with-check x y :test #'equal)))      (let ((result (union-with-check x y :test #'equal)))
94          (check-union x y result)))        (check-union x y result)))
95    t)    t)
96    
97  (deftest union-14  (deftest union.14
98      (let ((x (copy-list '(1 2 3 4 5 6 7)))    (let ((x (copy-list '(1 2 3 4 5 6 7)))
99            (y (copy-list '(10 19 5 3 17 1001 2))))          (y (copy-list '(10 19 5 3 17 1001 2))))
100        (let ((result (union-with-check x y :test #'eql)))      (let ((result (union-with-check x y :test #'eql)))
101          (check-union x y result)))        (check-union x y result)))
102    t)    t)
103    
104  (deftest union-15  (deftest union.15
105      (let ((x (copy-list '(1 2 3 4 5 6 7)))    (let ((x (copy-list '(1 2 3 4 5 6 7)))
106            (y (copy-list '(10 19 5 3 17 1001 2))))          (y (copy-list '(10 19 5 3 17 1001 2))))
107        (let ((result (union-with-check x y :test-not (complement #'equal))))      (let ((result (union-with-check x y :test-not (complement #'equal))))
108          (check-union x y result)))        (check-union x y result)))
109    t)    t)
110    
111  (deftest union-16  (deftest union.16
112      (let ((x (copy-list '(1 2 3 4 5 6 7)))    (let ((x (copy-list '(1 2 3 4 5 6 7)))
113            (y (copy-list '(10 19 5 3 17 1001 2))))          (y (copy-list '(10 19 5 3 17 1001 2))))
114        (let ((result (union-with-check x y :test-not (complement  #'eql))))      (let ((result (union-with-check x y :test-not (complement  #'eql))))
115          (check-union x y result)))        (check-union x y result)))
116    t)    t)
117    
118  (deftest union-17  (deftest union.17
119      (let ((x (copy-list '(1 2 3 4 5 6 7)))    (let ((x (copy-list '(1 2 3 4 5 6 7)))
120            (y (copy-list '(10 19 5 3 17 1001 2))))          (y (copy-list '(10 19 5 3 17 1001 2))))
121        (let ((result (union-with-check-and-key x y #'1+)))      (let ((result (union-with-check-and-key x y #'1+)))
122          (check-union x y result)))        (check-union x y result)))
123    t)    t)
124    
125  (deftest union-18  (deftest union.18
126      (let ((x (copy-list '(1 2 3 4 5 6 7)))    (let ((x (copy-list '(1 2 3 4 5 6 7)))
127            (y (copy-list '(10 19 5 3 17 1001 2))))          (y (copy-list '(10 19 5 3 17 1001 2))))
128        (let ((result (union-with-check-and-key x y #'1+ :test #'equal)))      (let ((result (union-with-check-and-key x y #'1+ :test #'equal)))
129          (check-union x y result)))        (check-union x y result)))
130    t)    t)
131    
132  (deftest union-19  (deftest union.19
133      (let ((x (copy-list '(1 2 3 4 5 6 7)))    (let ((x (copy-list '(1 2 3 4 5 6 7)))
134            (y (copy-list '(10 19 5 3 17 1001 2))))          (y (copy-list '(10 19 5 3 17 1001 2))))
135        (let ((result (union-with-check-and-key x y #'1+ :test #'eql)))      (let ((result (union-with-check-and-key x y #'1+ :test #'eql)))
136          (check-union x y result)))        (check-union x y result)))
137    t)    t)
138    
139  (deftest union-20  (deftest union.20
140      (let ((x (copy-list '(1 2 3 4 5 6 7)))    (let ((x (copy-list '(1 2 3 4 5 6 7)))
141            (y (copy-list '(10 19 5 3 17 1001 2))))          (y (copy-list '(10 19 5 3 17 1001 2))))
142        (let ((result (union-with-check-and-key x y #'1+      (let ((result (union-with-check-and-key x y #'1+
143                                                :test-not (complement #'equal))))                                              :test-not (complement #'equal))))
144          (check-union x y result)))        (check-union x y result)))
145    t)    t)
146    
147  (deftest union-21  (deftest union.21
148      (let ((x (copy-list '(1 2 3 4 5 6 7)))    (let ((x (copy-list '(1 2 3 4 5 6 7)))
149            (y (copy-list '(10 19 5 3 17 1001 2))))          (y (copy-list '(10 19 5 3 17 1001 2))))
150        (let ((result (union-with-check-and-key x y #'1+      (let ((result (union-with-check-and-key x y #'1+
151                                                :test-not (complement #'equal))))                                              :test-not (complement #'equal))))
152          (check-union x y result)))        (check-union x y result)))
153    t)    t)
154    
155  (deftest union-22  (deftest union.22
156    (let ((x (copy-list '(1 2 3 4 5 6 7)))    (let ((x (copy-list '(1 2 3 4 5 6 7)))
157          (y (copy-list '(10 19 5 3 17 1001 2))))          (y (copy-list '(10 19 5 3 17 1001 2))))
158      (let ((result (union-with-check-and-key x y nil)))      (let ((result (union-with-check-and-key x y nil)))
159        (check-union x y result)))        (check-union x y result)))
160    t)    t)
161    
162  (deftest union-23  (deftest union.23
163    (let ((x (copy-list '(1 2 3 4 5 6 7)))    (let ((x (copy-list '(1 2 3 4 5 6 7)))
164          (y (copy-list '(10 19 5 3 17 1001 2))))          (y (copy-list '(10 19 5 3 17 1001 2))))
165      (let ((result (union-with-check-and-key x y '1+)))      (let ((result (union-with-check-and-key x y '1+)))
# Line 168  Line 168 
168    
169  ;; Do large numbers of random units  ;; Do large numbers of random units
170    
171  (deftest union-24  (deftest union.24
172    (do-random-unions 100 100 200)    (do-random-unions 100 100 200)
173    nil)    nil)
174    
175  (deftest union-25  (deftest union.25
176    (let ((x (shuffle '(1 4 6 10 45 101)))    (let ((x (shuffle '(1 4 6 10 45 101)))
177          (y (copy-list '(102 5 2 11 44 6))))          (y (copy-list '(102 5 2 11 44 6))))
178      (let ((result (union-with-check x y      (let ((result (union-with-check x y
# Line 189  Line 189 
189    
190  ;;; Check that union uses eql, not equal or eq  ;;; Check that union uses eql, not equal or eq
191    
192  (deftest union-26  (deftest union.26
193    (let ((x 1000)    (let ((x 1000)
194          (y 1000))          (y 1000))
195      (loop      (loop
# Line 206  Line 206 
206             1))))             1))))
207    t)    t)
208    
209  (deftest union-27  (deftest union.27
210    (union-with-check (list (copy-seq "aa"))    (union-with-check (list (copy-seq "aa"))
211                      (list (copy-seq "aa")))                      (list (copy-seq "aa")))
212    ("aa" "aa"))    ("aa" "aa"))
213    
214  ;; Check that union does not reverse the arguments to :test, :test-not  ;; Check that union does not reverse the arguments to :test, :test-not
215    
216  (deftest union-28  (deftest union.28
217      (block fail    (block fail
218        (sort      (sort
219         (union-with-check       (union-with-check
220          (list 1 2 3)        (list 1 2 3)
221          (list 4 5 6)        (list 4 5 6)
222          :test #'(lambda (x y)        :test #'(lambda (x y)
223                    (when (< y x) (return-from fail 'fail))                  (when (< y x) (return-from fail 'fail))
224                    (eql x y)))                  (eql x y)))
225         #'<))       #'<))
226    (1 2 3 4 5 6))    (1 2 3 4 5 6))
227    
228  (deftest union-29  (deftest union.29
229      (block fail    (block fail
230        (sort      (sort
231         (union-with-check-and-key       (union-with-check-and-key
232          (list 1 2 3)        (list 1 2 3)
233          (list 4 5 6)        (list 4 5 6)
234          #'identity        #'identity
235          :test #'(lambda (x y)        :test #'(lambda (x y)
236                    (when (< y x) (return-from fail 'fail))                  (when (< y x) (return-from fail 'fail))
237                    (eql x y)))                  (eql x y)))
238         #'<))       #'<))
239    (1 2 3 4 5 6))    (1 2 3 4 5 6))
240    
241  (deftest union-30  (deftest union.30
242      (block fail    (block fail
243        (sort      (sort
244         (union-with-check       (union-with-check
245          (list 1 2 3)        (list 1 2 3)
246          (list 4 5 6)        (list 4 5 6)
247          :test-not        :test-not
248          #'(lambda (x y)        #'(lambda (x y)
249              (when (< y x) (return-from fail 'fail))            (when (< y x) (return-from fail 'fail))
250              (not (eql x y))))            (not (eql x y))))
251         #'<))       #'<))
252    (1 2 3 4 5 6))    (1 2 3 4 5 6))
253    
254  (deftest union-31  (deftest union.31
255      (block fail    (block fail
256        (sort      (sort
257         (union-with-check-and-key       (union-with-check-and-key
258          (list 1 2 3)        (list 1 2 3)
259          (list 4 5 6)        (list 4 5 6)
260          #'identity        #'identity
261          :test-not #'(lambda (x y)        :test-not #'(lambda (x y)
262                        (when (< y x) (return-from fail 'fail))                      (when (< y x) (return-from fail 'fail))
263                        (not (eql x y))))                      (not (eql x y))))
264         #'<))       #'<))
265    (1 2 3 4 5 6))    (1 2 3 4 5 6))
266    
267    ;;; Order of evaluation tests
268    
269    (deftest union.32
270      (let ((i 0) x y)
271        (values
272         (sort
273          (union (progn (setf x (incf i)) (copy-list '(1 3 5)))
274                 (progn (setf y (incf i)) (copy-list '(2 5 8))))
275          #'<)
276         i x y))
277      (1 2 3 5 8)
278      2 1 2)
279    
280    (deftest union.33
281      (let ((i 0) x y z w)
282        (values
283         (sort
284          (union (progn (setf x (incf i)) (copy-list '(1 3 5)))
285                 (progn (setf y (incf i)) (copy-list '(2 5 8)))
286                 :test (progn (setf z (incf i)) #'eql)
287                 :key (progn (setf w (incf i)) #'identity))
288          #'<)
289         i x y z w))
290      (1 2 3 5 8)
291      4 1 2 3 4)
292    
293    
294    (deftest union.34
295      (let ((i 0) x y z w)
296        (values
297         (sort
298          (union (progn (setf x (incf i)) (copy-list '(1 3 5)))
299                 (progn (setf y (incf i)) (copy-list '(2 5 8)))
300                 :key (progn (setf z (incf i)) #'identity)
301                 :test (progn (setf w (incf i)) #'eql))
302          #'<)
303         i x y z w))
304      (1 2 3 5 8)
305      4 1 2 3 4)
306    
307  ;;; Keyword tests  ;;; Keyword tests
308    
309  (deftest union.allow-other-keys.1  (deftest union.allow-other-keys.1

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26