~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/merge.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Fri Sep  6 07:24:17 2002
 
4
;;;; Contains: Tests for MERGE
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(deftest merge-list.1
 
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))
 
13
 
 
14
(deftest merge-list.2
 
15
  (let ((x nil)
 
16
        (y (list 2 4 5 8 11)))
 
17
    (merge 'list x y #'<))
 
18
  (2 4 5 8 11))
 
19
 
 
20
(deftest merge-list.3
 
21
  (let ((x nil)
 
22
        (y (list 2 4 5 8 11)))
 
23
    (merge 'list y x #'<))
 
24
  (2 4 5 8 11))
 
25
 
 
26
(deftest merge-list.4
 
27
  (merge 'list nil nil #'<)
 
28
  nil)
 
29
 
 
30
(deftest merge-list.5
 
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))
 
35
 
 
36
(deftest merge-list.6
 
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))
 
41
 
 
42
(deftest merge-list.7
 
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))
 
47
 
 
48
(deftest merge-list.8
 
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))
 
53
 
 
54
(deftest merge-list.9
 
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))
 
59
 
 
60
(deftest merge-list.10
 
61
  (let ((x (list 1 3 7 8 10))
 
62
        (y (list 2 4 5 8 11)))
 
63
    (merge 'list x y '<))
 
64
  (1 2 3 4 5 7 8 8 10 11))
 
65
 
 
66
(deftest merge-list.11
 
67
  (let ((x (vector)) (y (vector)))
 
68
    (merge 'list x y #'<))
 
69
  nil)
 
70
 
 
71
(deftest merge-list.12
 
72
  (let ((x nil) (y (vector 1 2 3)))
 
73
    (merge 'list x y #'<))
 
74
  (1 2 3))
 
75
 
 
76
(deftest merge-list.13
 
77
  (let ((x (vector)) (y (list 1 2 3)))
 
78
    (merge 'list x y #'<))
 
79
  (1 2 3))
 
80
 
 
81
(deftest merge-list.14
 
82
  (let ((x nil) (y (vector 1 2 3)))
 
83
    (merge 'list y x #'<))
 
84
  (1 2 3))
 
85
 
 
86
(deftest merge-list.15
 
87
  (let ((x (vector)) (y (list 1 2 3)))
 
88
    (merge 'list y x #'<))
 
89
  (1 2 3))
 
90
 
 
91
;;; Tests yielding vectors
 
92
 
 
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))
 
98
 
 
99
(deftest merge-vector.2
 
100
  (let ((x nil)
 
101
        (y (list 2 4 5 8 11)))
 
102
    (merge 'vector x y #'<))
 
103
  #(2 4 5 8 11))
 
104
 
 
105
(deftest merge-vector.3
 
106
  (let ((x nil)
 
107
        (y (list 2 4 5 8 11)))
 
108
    (merge 'vector y x #'<))
 
109
  #(2 4 5 8 11))
 
110
 
 
111
(deftest merge-vector.4
 
112
  (merge 'vector nil nil #'<)
 
113
  #())
 
114
 
 
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))
 
120
 
 
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))
 
126
 
 
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))
 
132
 
 
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))
 
138
 
 
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))
 
144
 
 
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))
 
150
 
 
151
(deftest merge-vector.11
 
152
  (let ((x (vector)) (y (vector)))
 
153
    (merge 'vector x y #'<))
 
154
  #())
 
155
 
 
156
(deftest merge-vector.12
 
157
  (let ((x nil) (y (vector 1 2 3)))
 
158
    (merge 'vector x y #'<))
 
159
  #(1 2 3))
 
160
 
 
161
(deftest merge-vector.13
 
162
  (let ((x (vector)) (y (list 1 2 3)))
 
163
    (merge 'vector x y #'<))
 
164
  #(1 2 3))
 
165
 
 
166
(deftest merge-vector.14
 
167
  (let ((x nil) (y (vector 1 2 3)))
 
168
    (merge 'vector y x #'<))
 
169
  #(1 2 3))
 
170
 
 
171
(deftest merge-vector.15
 
172
  (let ((x (vector)) (y (list 1 2 3)))
 
173
    (merge 'vector y x #'<))
 
174
  #(1 2 3))
 
175
 
 
176
(deftest merge-vector.16
 
177
  (let ((x (make-array '(10) :initial-contents '(2 5 8 9 11 12 14 15 18 30)
 
178
                       :fill-pointer 5))
 
179
        (y (list 1 6 10)))
 
180
    (merge 'vector x y #'<))
 
181
  #(1 2 5 6 8 9 10 11))
 
182
 
 
183
(deftest merge-vector.16a
 
184
  (let ((x (make-array '(10) :initial-contents '(2 5 8 9 11 12 14 15 18 30)
 
185
                       :fill-pointer 5))
 
186
        (y (list 1 6 10)))
 
187
    (merge 'vector y x #'<))
 
188
  #(1 2 5 6 8 9 10 11))
 
189
 
 
190
(deftest merge-vector.17
 
191
  (let* ((x (make-array '(10) :initial-contents '(2 5 8 9 11 12 14 15 18 30)
 
192
                        :fill-pointer 5))
 
193
         (result (merge 'vector x () #'<)))
 
194
    (values
 
195
     (array-element-type result)
 
196
     result))
 
197
  t
 
198
  #(2 5 8 9 11))
 
199
 
 
200
;;; Tests on strings
 
201
 
 
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<))
 
206
  "12345789")
 
207
 
 
208
(deftest merge-string.1a
 
209
  (let ((x "1378")
 
210
        (y (list #\2 #\4 #\5 #\9)))
 
211
    (merge 'string x y #'char<))
 
212
  "12345789")
 
213
 
 
214
(deftest merge-string.1b
 
215
  (let ((x (list #\1 #\3 #\7 #\8))
 
216
        (y "2459"))
 
217
    (merge 'string x y #'char<))
 
218
  "12345789")
 
219
 
 
220
(deftest merge-string.1c
 
221
  (let ((x "1378")
 
222
        (y "2459"))
 
223
    (merge 'string x y #'char<))
 
224
  "12345789")
 
225
 
 
226
(deftest merge-string.1d
 
227
  (let ((x "1378")
 
228
        (y "2459"))
 
229
    (merge 'string y x #'char<))
 
230
  "12345789")
 
231
 
 
232
(deftest merge-string.2
 
233
  (let ((x nil)
 
234
        (y (list #\2 #\4 #\5 #\9)))
 
235
    (merge 'string x y #'char<))
 
236
  "2459")
 
237
 
 
238
(deftest merge-string.3
 
239
  (let ((x nil)
 
240
        (y (list #\2 #\4 #\5 #\9)))
 
241
    (merge 'string y x #'char<))
 
242
  "2459")
 
243
 
 
244
(deftest merge-string.4
 
245
  (merge 'string nil nil #'char<)
 
246
  "")
 
247
 
 
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))
 
252
  "1234578")
 
253
           
 
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))
 
258
  "12345789")
 
259
 
 
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<))
 
264
  "12345789")
 
265
 
 
266
(deftest merge-string.11
 
267
  (let ((x (vector)) (y (vector)))
 
268
    (merge 'string x y #'char<))
 
269
  "")
 
270
 
 
271
(deftest merge-string.12
 
272
  (let ((x nil) (y (vector #\1 #\2 #\3)))
 
273
    (merge 'string x y #'char<))
 
274
  "123")
 
275
 
 
276
(deftest merge-string.13
 
277
  (let ((x (vector)) (y (list #\1 #\2 #\3)))
 
278
    (merge 'string x y #'char<))
 
279
  "123")
 
280
 
 
281
(deftest merge-string.13a
 
282
  (let ((x (copy-seq "")) (y (list #\1 #\2 #\3)))
 
283
    (merge 'string x y #'char<))
 
284
  "123")
 
285
 
 
286
(deftest merge-string.14
 
287
  (let ((x nil) (y (vector #\1 #\2 #\3)))
 
288
    (merge 'string y x #'char<))
 
289
  "123")
 
290
 
 
291
(deftest merge-string.14a
 
292
  (let ((x (copy-seq "")) (y (vector #\1 #\2 #\3)))
 
293
    (merge 'string y x #'char<))
 
294
  "123")
 
295
 
 
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<))
 
301
  "abcdgikm")
 
302
 
 
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<))
 
308
  "abcdgikm")
 
309
 
 
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<))
 
314
  "adgkm")
 
315
 
 
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<))
 
320
  "adgkm")
 
321
 
 
322
;;; Tests for bit vectors
 
323
 
 
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 #'<))
 
328
  #*0000011111)
 
329
 
 
330
(deftest merge-bit-vector.2
 
331
  (let ((x nil)
 
332
        (y (list 0 0 0 1 1)))
 
333
    (merge 'bit-vector x y #'<))
 
334
  #*00011)
 
335
 
 
336
(deftest merge-bit-vector.3
 
337
  (let ((x nil)
 
338
        (y (list 0 0 0 1 1)))
 
339
    (merge 'bit-vector y x #'<))
 
340
  #*00011)
 
341
 
 
342
(deftest merge-bit-vector.4
 
343
  (merge 'bit-vector nil nil #'<)
 
344
  #*)
 
345
 
 
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 #'<))
 
350
  #*0000011111)
 
351
 
 
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 #'<))
 
356
  #*0000011111)
 
357
 
 
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 #'<))
 
362
  #*0000011111)
 
363
 
 
364
(deftest merge-bit-vector.5c
 
365
  (let ((x (copy-seq #*00111))
 
366
        (y (copy-seq #*00011)))
 
367
    (merge 'bit-vector x y #'<))
 
368
  #*0000011111)
 
369
 
 
370
(deftest merge-bit-vector.5d
 
371
  (let ((x (copy-seq #*11111))
 
372
        (y (copy-seq #*00000)))
 
373
    (merge 'bit-vector x y #'<))
 
374
  #*0000011111)
 
375
 
 
376
(deftest merge-bit-vector.5e
 
377
  (let ((x (copy-seq #*11111))
 
378
        (y (copy-seq #*00000)))
 
379
    (merge 'bit-vector y x #'<))
 
380
  #*0000011111)
 
381
 
 
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 #'<))
 
386
  #*0000011111)
 
387
 
 
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 #'<))
 
392
  #*0000011111)
 
393
 
 
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 #'-))
 
398
  #*1111100000)
 
399
 
 
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))
 
404
  #*0000011111)
 
405
 
 
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 '<))
 
410
  #*0000011111)
 
411
 
 
412
(deftest merge-bit-vector.11
 
413
  (let ((x (copy-seq #*)) (y (copy-seq #*)))
 
414
    (merge 'bit-vector x y #'<))
 
415
  #*)
 
416
 
 
417
(deftest merge-bit-vector.12
 
418
  (let ((x (copy-seq #*)) (y (copy-seq #*011)))
 
419
    (merge 'bit-vector x y #'<))
 
420
  #*011)
 
421
  
 
422
(deftest merge-bit-vector.13
 
423
  (let ((x (copy-seq #*)) (y (list 0 1 1)))
 
424
    (merge 'bit-vector x y #'<))
 
425
  #*011)
 
426
 
 
427
(deftest merge-bit-vector.14
 
428
  (let ((x nil) (y (vector 0 1 1)))
 
429
    (merge 'bit-vector y x #'<))
 
430
  #*011)
 
431
 
 
432
(deftest merge-bit-vector.15
 
433
  (let ((x (copy-seq #*)) (y (list 0 1 1)))
 
434
    (merge 'bit-vector y x #'<))
 
435
  #*011)
 
436
 
 
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 #'<))
 
442
  #*00000111)
 
443
 
 
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 #'<))
 
449
  #*00000111)
 
450
 
 
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 #'<))
 
455
  #*00011)
 
456
 
 
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 #'<))
 
461
  #*00011)
 
462
 
 
463
 
 
464
;;; Cons (which is a recognizable subtype of list)
 
465
 
 
466
(deftest merge-cons.1
 
467
  (merge 'cons (list 1 2 3) (list 4 5 6) #'<)
 
468
  (1 2 3 4 5 6))
 
469
 
 
470
;;; Null, which is a recognizable subtype of list
 
471
 
 
472
(deftest merge-null.1
 
473
  (merge 'null nil nil #'<)
 
474
  nil)
 
475
 
 
476
;;; Vectors with length
 
477
 
 
478
(deftest merge-vector-length.1
 
479
  (merge '(vector * 6) (list 1 2 3) (list 4 5 6) #'<)
 
480
  #(1 2 3 4 5 6))
 
481
  
 
482
(deftest merge-bit-vector-length.1
 
483
  (merge '(bit-vector  6) (list 0 1 1) (list 0 0 1) #'<)
 
484
  #*000111)
 
485
 
 
486
;;; Order of evaluation
 
487
 
 
488
(deftest merge.order.1
 
489
  (let ((i 0) a b c d)
 
490
    (values
 
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)) #'<))
 
495
     i a b c d))
 
496
  (1 2 3 4 5 6) 4 1 2 3 4)
 
497
  
 
498
;;; Tests of error situations
 
499
 
 
500
(deftest merge.error.1
 
501
  (handler-case (eval
 
502
                 '(locally (declare (optimize safety))
 
503
                           (merge 'symbol (list 1 2 3) (list 4 5 6) #'<)))
 
504
                (error () :caught))
 
505
  :caught)
 
506
 
 
507
(deftest merge.error.2
 
508
  (signals-error (merge '(vector * 3) (list 1 2 3) (list 4 5 6) #'<)
 
509
                 type-error)
 
510
  t)
 
511
 
 
512
(deftest merge.error.3
 
513
  (signals-error (merge '(bit-vector 3) (list 0 0 0) (list 1 1 1) #'<)
 
514
                 type-error)
 
515
  t)
 
516
 
 
517
(deftest merge.error.4
 
518
  (signals-error (merge '(vector * 7) (list 1 2 3) (list 4 5 6) #'<)
 
519
                 type-error)
 
520
  t)
 
521
 
 
522
(deftest merge.error.5
 
523
  (signals-error (merge '(bit-vector 7) (list 0 0 0) (list 1 1 1) #'<)
 
524
                 type-error)
 
525
  t)
 
526
 
 
527
(deftest merge.error.6
 
528
  (signals-error (merge 'null (list 1 2 3) (list 4 5 6) #'<)
 
529
                 type-error)
 
530
  t)
 
531
 
 
532
(deftest merge.error.7
 
533
  (signals-error (merge) program-error)
 
534
  t)
 
535
 
 
536
(deftest merge.error.8
 
537
  (signals-error (merge 'list) program-error)
 
538
  t)
 
539
 
 
540
(deftest merge.error.9
 
541
  (signals-error (merge 'list (list 2 4 6)) program-error)
 
542
  t)
 
543
 
 
544
(deftest merge.error.10
 
545
  (signals-error (merge 'list (list 2 4 6) (list 1 3 5))
 
546
                 program-error)
 
547
  t)
 
548
 
 
549
(deftest merge.error.11
 
550
  (signals-error (merge 'list (list 2 4 6) (list 1 3 5) #'< :bad t)
 
551
                 program-error)
 
552
  t)
 
553
 
 
554
(deftest merge.error.12
 
555
  (signals-error (merge 'list (list 2 4 6) (list 1 3 5) #'< :key)
 
556
                 program-error)
 
557
  t)
 
558
 
 
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)
 
562
                 program-error)
 
563
  t)
 
564
 
 
565
(deftest merge.error.14
 
566
  (signals-error (merge 'list (list 2 4 6) (list 1 3 5) #'< 1 2)
 
567
                 program-error)
 
568
  t)
 
569
 
 
570
(deftest merge.error.15
 
571
  (signals-error (locally (merge '(vector * 3) (list 1 2 3)
 
572
                                  (list 4 5 6) #'<)
 
573
                           t)
 
574
                 type-error)
 
575
  t)  
 
576
 
 
577
(deftest merge.error.16
 
578
  (signals-error (merge 'list (list 1 2) (list 3 4) #'car)
 
579
                 program-error)
 
580
  t)
 
581
 
 
582
(deftest merge.error.17
 
583
  (signals-error (merge 'list (list 'a 'b) (list 3 4) #'max)
 
584
                 type-error)
 
585
  t)