2
;;;; Author: Paul Dietz
3
;;;; Created: Fri Sep 6 07:24:17 2002
4
;;;; Contains: Tests for MERGE
9
(let ((x (list 1 3 7 8 10))
10
(y (list 2 4 5 8 11)))
11
(merge 'list x y #'<))
12
(1 2 3 4 5 7 8 8 10 11))
16
(y (list 2 4 5 8 11)))
17
(merge 'list x y #'<))
22
(y (list 2 4 5 8 11)))
23
(merge 'list y x #'<))
27
(merge 'list nil nil #'<)
31
(let ((x (vector 1 3 7 8 10))
32
(y (list 2 4 5 8 11)))
33
(merge 'list x y #'<))
34
(1 2 3 4 5 7 8 8 10 11))
37
(let ((x (list 1 3 7 8 10))
38
(y (vector 2 4 5 8 11)))
39
(merge 'list x y #'<))
40
(1 2 3 4 5 7 8 8 10 11))
43
(let ((x (vector 1 3 7 8 10))
44
(y (vector 2 4 5 8 11)))
45
(merge 'list x y #'<))
46
(1 2 3 4 5 7 8 8 10 11))
49
(let ((x (sort (list 1 3 7 8 10) #'>))
50
(y (sort (list 2 4 5 8 11) #'>)))
51
(merge 'list x y #'< :key #'-))
52
(11 10 8 8 7 5 4 3 2 1))
55
(let ((x (list 1 3 7 8 10))
56
(y (list 2 4 5 8 11)))
57
(merge 'list x y #'< :key nil))
58
(1 2 3 4 5 7 8 8 10 11))
60
(deftest merge-list.10
61
(let ((x (list 1 3 7 8 10))
62
(y (list 2 4 5 8 11)))
64
(1 2 3 4 5 7 8 8 10 11))
66
(deftest merge-list.11
67
(let ((x (vector)) (y (vector)))
68
(merge 'list x y #'<))
71
(deftest merge-list.12
72
(let ((x nil) (y (vector 1 2 3)))
73
(merge 'list x y #'<))
76
(deftest merge-list.13
77
(let ((x (vector)) (y (list 1 2 3)))
78
(merge 'list x y #'<))
81
(deftest merge-list.14
82
(let ((x nil) (y (vector 1 2 3)))
83
(merge 'list y x #'<))
86
(deftest merge-list.15
87
(let ((x (vector)) (y (list 1 2 3)))
88
(merge 'list y x #'<))
91
;;; Tests yielding vectors
93
(deftest merge-vector.1
94
(let ((x (list 1 3 7 8 10))
95
(y (list 2 4 5 8 11)))
96
(merge 'vector x y #'<))
97
#(1 2 3 4 5 7 8 8 10 11))
99
(deftest merge-vector.2
101
(y (list 2 4 5 8 11)))
102
(merge 'vector x y #'<))
105
(deftest merge-vector.3
107
(y (list 2 4 5 8 11)))
108
(merge 'vector y x #'<))
111
(deftest merge-vector.4
112
(merge 'vector nil nil #'<)
115
(deftest merge-vector.5
116
(let ((x (vector 1 3 7 8 10))
117
(y (list 2 4 5 8 11)))
118
(merge 'vector x y #'<))
119
#(1 2 3 4 5 7 8 8 10 11))
121
(deftest merge-vector.6
122
(let ((x (list 1 3 7 8 10))
123
(y (vector 2 4 5 8 11)))
124
(merge 'vector x y #'<))
125
#(1 2 3 4 5 7 8 8 10 11))
127
(deftest merge-vector.7
128
(let ((x (vector 1 3 7 8 10))
129
(y (vector 2 4 5 8 11)))
130
(merge 'vector x y #'<))
131
#(1 2 3 4 5 7 8 8 10 11))
133
(deftest merge-vector.8
134
(let ((x (sort (list 1 3 7 8 10) #'>))
135
(y (sort (list 2 4 5 8 11) #'>)))
136
(merge 'vector x y #'< :key #'-))
137
#(11 10 8 8 7 5 4 3 2 1))
139
(deftest merge-vector.9
140
(let ((x (list 1 3 7 8 10))
141
(y (list 2 4 5 8 11)))
142
(merge 'vector x y #'< :key nil))
143
#(1 2 3 4 5 7 8 8 10 11))
145
(deftest merge-vector.10
146
(let ((x (list 1 3 7 8 10))
147
(y (list 2 4 5 8 11)))
148
(merge 'vector x y '<))
149
#(1 2 3 4 5 7 8 8 10 11))
151
(deftest merge-vector.11
152
(let ((x (vector)) (y (vector)))
153
(merge 'vector x y #'<))
156
(deftest merge-vector.12
157
(let ((x nil) (y (vector 1 2 3)))
158
(merge 'vector x y #'<))
161
(deftest merge-vector.13
162
(let ((x (vector)) (y (list 1 2 3)))
163
(merge 'vector x y #'<))
166
(deftest merge-vector.14
167
(let ((x nil) (y (vector 1 2 3)))
168
(merge 'vector y x #'<))
171
(deftest merge-vector.15
172
(let ((x (vector)) (y (list 1 2 3)))
173
(merge 'vector y x #'<))
176
(deftest merge-vector.16
177
(let ((x (make-array '(10) :initial-contents '(2 5 8 9 11 12 14 15 18 30)
180
(merge 'vector x y #'<))
181
#(1 2 5 6 8 9 10 11))
183
(deftest merge-vector.16a
184
(let ((x (make-array '(10) :initial-contents '(2 5 8 9 11 12 14 15 18 30)
187
(merge 'vector y x #'<))
188
#(1 2 5 6 8 9 10 11))
190
(deftest merge-vector.17
191
(let* ((x (make-array '(10) :initial-contents '(2 5 8 9 11 12 14 15 18 30)
193
(result (merge 'vector x () #'<)))
195
(array-element-type result)
202
(deftest merge-string.1
203
(let ((x (list #\1 #\3 #\7 #\8))
204
(y (list #\2 #\4 #\5 #\9)))
205
(merge 'string x y #'char<))
208
(deftest merge-string.1a
210
(y (list #\2 #\4 #\5 #\9)))
211
(merge 'string x y #'char<))
214
(deftest merge-string.1b
215
(let ((x (list #\1 #\3 #\7 #\8))
217
(merge 'string x y #'char<))
220
(deftest merge-string.1c
223
(merge 'string x y #'char<))
226
(deftest merge-string.1d
229
(merge 'string y x #'char<))
232
(deftest merge-string.2
234
(y (list #\2 #\4 #\5 #\9)))
235
(merge 'string x y #'char<))
238
(deftest merge-string.3
240
(y (list #\2 #\4 #\5 #\9)))
241
(merge 'string y x #'char<))
244
(deftest merge-string.4
245
(merge 'string nil nil #'char<)
248
(deftest merge-string.8
249
(let ((x (list #\1 #\3 #\7 #\8))
250
(y (list #\2 #\4 #\5)))
251
(merge 'string x y #'char< :key #'nextdigit))
254
(deftest merge-string.9
255
(let ((x (list #\1 #\3 #\7 #\8))
256
(y (list #\2 #\4 #\5 #\9)))
257
(merge 'string x y #'char< :key nil))
260
(deftest merge-string.10
261
(let ((x (list #\1 #\3 #\7 #\8))
262
(y (list #\2 #\4 #\5 #\9)))
263
(merge 'string x y 'char<))
266
(deftest merge-string.11
267
(let ((x (vector)) (y (vector)))
268
(merge 'string x y #'char<))
271
(deftest merge-string.12
272
(let ((x nil) (y (vector #\1 #\2 #\3)))
273
(merge 'string x y #'char<))
276
(deftest merge-string.13
277
(let ((x (vector)) (y (list #\1 #\2 #\3)))
278
(merge 'string x y #'char<))
281
(deftest merge-string.13a
282
(let ((x (copy-seq "")) (y (list #\1 #\2 #\3)))
283
(merge 'string x y #'char<))
286
(deftest merge-string.14
287
(let ((x nil) (y (vector #\1 #\2 #\3)))
288
(merge 'string y x #'char<))
291
(deftest merge-string.14a
292
(let ((x (copy-seq "")) (y (vector #\1 #\2 #\3)))
293
(merge 'string y x #'char<))
296
(deftest merge-string.15
297
(let* ((x (make-array '(10) :initial-contents "adgkmpruwv"
298
:fill-pointer 5 :element-type 'character))
299
(y (copy-seq "bci")))
300
(merge 'string x y #'char<))
303
(deftest merge-string.16
304
(let* ((x (make-array '(10) :initial-contents "adgkmpruwv"
305
:fill-pointer 5 :element-type 'character))
306
(y (copy-seq "bci")))
307
(merge 'string y x #'char<))
310
(deftest merge-string.17
311
(let* ((x (make-array '(10) :initial-contents "adgkmpruwv"
312
:fill-pointer 5 :element-type 'character)))
313
(merge 'string nil x #'char<))
316
(deftest merge-string.18
317
(let* ((x (make-array '(10) :initial-contents "adgkmpruwv"
318
:fill-pointer 5 :element-type 'character)))
319
(merge 'string x nil #'char<))
322
;;; Tests for bit vectors
324
(deftest merge-bit-vector.1
325
(let ((x (list 0 0 1 1 1))
326
(y (list 0 0 0 1 1)))
327
(merge 'bit-vector x y #'<))
330
(deftest merge-bit-vector.2
332
(y (list 0 0 0 1 1)))
333
(merge 'bit-vector x y #'<))
336
(deftest merge-bit-vector.3
338
(y (list 0 0 0 1 1)))
339
(merge 'bit-vector y x #'<))
342
(deftest merge-bit-vector.4
343
(merge 'bit-vector nil nil #'<)
346
(deftest merge-bit-vector.5
347
(let ((x (vector 0 0 1 1 1))
348
(y (list 0 0 0 1 1)))
349
(merge 'bit-vector x y #'<))
352
(deftest merge-bit-vector.5a
353
(let ((x (copy-seq #*00111))
354
(y (list 0 0 0 1 1)))
355
(merge 'bit-vector x y #'<))
358
(deftest merge-bit-vector.5b
359
(let ((x (list 0 0 1 1 1))
360
(y (copy-seq #*00011)))
361
(merge 'bit-vector x y #'<))
364
(deftest merge-bit-vector.5c
365
(let ((x (copy-seq #*00111))
366
(y (copy-seq #*00011)))
367
(merge 'bit-vector x y #'<))
370
(deftest merge-bit-vector.5d
371
(let ((x (copy-seq #*11111))
372
(y (copy-seq #*00000)))
373
(merge 'bit-vector x y #'<))
376
(deftest merge-bit-vector.5e
377
(let ((x (copy-seq #*11111))
378
(y (copy-seq #*00000)))
379
(merge 'bit-vector y x #'<))
382
(deftest merge-bit-vector.6
383
(let ((x (list 0 0 1 1 1))
384
(y (vector 0 0 0 1 1)))
385
(merge 'bit-vector x y #'<))
388
(deftest merge-bit-vector.7
389
(let ((x (vector 0 0 1 1 1))
390
(y (vector 0 0 0 1 1)))
391
(merge 'bit-vector x y #'<))
394
(deftest merge-bit-vector.8
395
(let ((x (list 1 1 1 0 0))
396
(y (list 1 1 0 0 0)))
397
(merge 'bit-vector x y #'< :key #'-))
400
(deftest merge-bit-vector.9
401
(let ((x (list 0 0 1 1 1))
402
(y (list 0 0 0 1 1)))
403
(merge 'bit-vector x y #'< :key nil))
406
(deftest merge-bit-vector.10
407
(let ((x (list 0 0 1 1 1))
408
(y (list 0 0 0 1 1)))
409
(merge 'bit-vector x y '<))
412
(deftest merge-bit-vector.11
413
(let ((x (copy-seq #*)) (y (copy-seq #*)))
414
(merge 'bit-vector x y #'<))
417
(deftest merge-bit-vector.12
418
(let ((x (copy-seq #*)) (y (copy-seq #*011)))
419
(merge 'bit-vector x y #'<))
422
(deftest merge-bit-vector.13
423
(let ((x (copy-seq #*)) (y (list 0 1 1)))
424
(merge 'bit-vector x y #'<))
427
(deftest merge-bit-vector.14
428
(let ((x nil) (y (vector 0 1 1)))
429
(merge 'bit-vector y x #'<))
432
(deftest merge-bit-vector.15
433
(let ((x (copy-seq #*)) (y (list 0 1 1)))
434
(merge 'bit-vector y x #'<))
437
(deftest merge-bit-vector.16
438
(let* ((x (make-array '(10) :initial-contents #*0001101010
439
:fill-pointer 5 :element-type 'bit))
440
(y (copy-seq #*001)))
441
(merge 'bit-vector x y #'<))
444
(deftest merge-bit-vector.17
445
(let* ((x (make-array '(10) :initial-contents #*0001101010
446
:fill-pointer 5 :element-type 'bit))
447
(y (copy-seq #*001)))
448
(merge 'bit-vector y x #'<))
451
(deftest merge-bit-vector.18
452
(let* ((x (make-array '(10) :initial-contents #*0001101010
453
:fill-pointer 5 :element-type 'bit)))
454
(merge 'bit-vector nil x #'<))
457
(deftest merge-bit-vector.19
458
(let* ((x (make-array '(10) :initial-contents #*0001101010
459
:fill-pointer 5 :element-type 'bit)))
460
(merge 'bit-vector x nil #'<))
464
;;; Cons (which is a recognizable subtype of list)
466
(deftest merge-cons.1
467
(merge 'cons (list 1 2 3) (list 4 5 6) #'<)
470
;;; Null, which is a recognizable subtype of list
472
(deftest merge-null.1
473
(merge 'null nil nil #'<)
476
;;; Vectors with length
478
(deftest merge-vector-length.1
479
(merge '(vector * 6) (list 1 2 3) (list 4 5 6) #'<)
482
(deftest merge-bit-vector-length.1
483
(merge '(bit-vector 6) (list 0 1 1) (list 0 0 1) #'<)
486
;;; Order of evaluation
488
(deftest merge.order.1
491
(merge (progn (setf a (incf i)) 'list)
492
(progn (setf b (incf i)) (list 2 5 6))
493
(progn (setf c (incf i)) (list 1 3 4))
494
(progn (setf d (incf i)) #'<))
496
(1 2 3 4 5 6) 4 1 2 3 4)
498
;;; Tests of error situations
500
(deftest merge.error.1
502
'(locally (declare (optimize safety))
503
(merge 'symbol (list 1 2 3) (list 4 5 6) #'<)))
507
(deftest merge.error.2
508
(signals-error (merge '(vector * 3) (list 1 2 3) (list 4 5 6) #'<)
512
(deftest merge.error.3
513
(signals-error (merge '(bit-vector 3) (list 0 0 0) (list 1 1 1) #'<)
517
(deftest merge.error.4
518
(signals-error (merge '(vector * 7) (list 1 2 3) (list 4 5 6) #'<)
522
(deftest merge.error.5
523
(signals-error (merge '(bit-vector 7) (list 0 0 0) (list 1 1 1) #'<)
527
(deftest merge.error.6
528
(signals-error (merge 'null (list 1 2 3) (list 4 5 6) #'<)
532
(deftest merge.error.7
533
(signals-error (merge) program-error)
536
(deftest merge.error.8
537
(signals-error (merge 'list) program-error)
540
(deftest merge.error.9
541
(signals-error (merge 'list (list 2 4 6)) program-error)
544
(deftest merge.error.10
545
(signals-error (merge 'list (list 2 4 6) (list 1 3 5))
549
(deftest merge.error.11
550
(signals-error (merge 'list (list 2 4 6) (list 1 3 5) #'< :bad t)
554
(deftest merge.error.12
555
(signals-error (merge 'list (list 2 4 6) (list 1 3 5) #'< :key)
559
(deftest merge.error.13
560
(signals-error (merge 'list (list 2 4 6) (list 1 3 5) #'< :bad t
561
:allow-other-keys nil)
565
(deftest merge.error.14
566
(signals-error (merge 'list (list 2 4 6) (list 1 3 5) #'< 1 2)
570
(deftest merge.error.15
571
(signals-error (locally (merge '(vector * 3) (list 1 2 3)
577
(deftest merge.error.16
578
(signals-error (merge 'list (list 1 2) (list 3 4) #'car)
582
(deftest merge.error.17
583
(signals-error (merge 'list (list 'a 'b) (list 3 4) #'max)