source: trunk/source/tests/ansi-tests/merge.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: 15.6 KB
Line 
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(deftest merge-vector.18
201  (merge '(vector) (list 1 3 10) (list 2 4 6) #'<)
202  #(1 2 3 4 6 10))
203
204(deftest merge-vector.19
205  (merge '(vector *) (list 1 3 10) (list 2 4 6) #'<)
206  #(1 2 3 4 6 10))
207
208(deftest merge-vector.20
209  (merge '(vector t) (list 1 3 10) (list 2 4 6) #'<)
210  #(1 2 3 4 6 10))
211
212(deftest merge-vector.21
213  (merge '(vector * 6) (list 1 3 10) (list 2 4 6) #'<)
214  #(1 2 3 4 6 10))
215
216(deftest merge-vector.22
217  (merge '(simple-vector) (list 2 4 6) (list 1 3 5) #'<)
218  #(1 2 3 4 5 6))
219
220(deftest merge-vector.23
221  (merge '(simple-vector *) (list 2 4 6) (list 1 3 5) #'<)
222  #(1 2 3 4 5 6))
223
224(deftest merge-vector.24
225  (merge '(simple-vector 6) (list 2 4 6) (list 1 3 5) #'<)
226  #(1 2 3 4 5 6))
227
228;;; Tests on strings
229
230(deftest merge-string.1
231  (let ((x (list #\1 #\3 #\7 #\8))
232        (y (list #\2 #\4 #\5 #\9)))
233    (merge 'string x y #'char<))
234  "12345789")
235
236(deftest merge-string.1a
237  (let ((x (copy-seq "1378"))
238        (y (list #\2 #\4 #\5 #\9)))
239    (merge 'string x y #'char<))
240  "12345789")
241
242(deftest merge-string.1b
243  (let ((x (list #\1 #\3 #\7 #\8))
244        (y (copy-seq "2459")))
245    (merge 'string x y #'char<))
246  "12345789")
247
248(deftest merge-string.1c
249  (let ((x (copy-seq "1378"))
250        (y (copy-seq "2459")))
251    (merge 'string x y #'char<))
252  "12345789")
253
254(deftest merge-string.1d
255  (let ((x (copy-seq "1378"))
256        (y (copy-seq "2459")))
257    (merge 'string y x #'char<))
258  "12345789")
259
260(deftest merge-string.2
261  (let ((x nil)
262        (y (list #\2 #\4 #\5 #\9)))
263    (merge 'string x y #'char<))
264  "2459")
265
266(deftest merge-string.3
267  (let ((x nil)
268        (y (list #\2 #\4 #\5 #\9)))
269    (merge 'string y x #'char<))
270  "2459")
271
272(deftest merge-string.4
273  (merge 'string nil nil #'char<)
274  "")
275
276(deftest merge-string.8
277  (let ((x (list #\1 #\3 #\7 #\8))
278        (y (list #\2 #\4 #\5)))
279    (merge 'string x y #'char< :key #'nextdigit))
280  "1234578")
281           
282(deftest merge-string.9
283  (let ((x (list #\1 #\3 #\7 #\8))
284        (y (list  #\2 #\4 #\5 #\9)))
285    (merge 'string x y #'char< :key nil))
286  "12345789")
287
288(deftest merge-string.10
289  (let ((x (list #\1 #\3 #\7 #\8))
290        (y (list  #\2 #\4 #\5 #\9)))
291    (merge 'string x y 'char<))
292  "12345789")
293
294(deftest merge-string.11
295  (let ((x (vector)) (y (vector)))
296    (merge 'string x y #'char<))
297  "")
298
299(deftest merge-string.12
300  (let ((x nil) (y (vector #\1 #\2 #\3)))
301    (merge 'string x y #'char<))
302  "123")
303
304(deftest merge-string.13
305  (let ((x (vector)) (y (list #\1 #\2 #\3)))
306    (merge 'string x y #'char<))
307  "123")
308
309(deftest merge-string.13a
310  (let ((x (copy-seq "")) (y (list #\1 #\2 #\3)))
311    (merge 'string x y #'char<))
312  "123")
313
314(deftest merge-string.14
315  (let ((x nil) (y (vector #\1 #\2 #\3)))
316    (merge 'string y x #'char<))
317  "123")
318
319(deftest merge-string.14a
320  (let ((x (copy-seq "")) (y (vector #\1 #\2 #\3)))
321    (merge 'string y x #'char<))
322  "123")
323
324(deftest merge-string.15
325  (let* ((x (make-array '(10) :initial-contents "adgkmpruwv"
326                        :fill-pointer 5 :element-type 'character))
327         (y (copy-seq "bci")))
328    (merge 'string x y #'char<))
329  "abcdgikm")
330
331(deftest merge-string.16
332  (let* ((x (make-array '(10) :initial-contents "adgkmpruwv"
333                        :fill-pointer 5 :element-type 'character))
334         (y (copy-seq "bci")))
335    (merge 'string y x #'char<))
336  "abcdgikm")
337
338(deftest merge-string.17
339  (let* ((x (make-array '(10) :initial-contents "adgkmpruwv"
340                        :fill-pointer 5 :element-type 'character)))
341    (merge 'string nil x #'char<))
342  "adgkm")
343
344(deftest merge-string.18
345  (let* ((x (make-array '(10) :initial-contents "adgkmpruwv"
346                        :fill-pointer 5 :element-type 'character)))
347    (merge 'string x nil #'char<))
348  "adgkm")
349
350(deftest merge-string.19
351  (do-special-strings
352   (s "ace" nil)
353   (assert (string= (merge 'string s (copy-seq "bdf") #'char<) "abcdef")))
354  nil)
355
356(deftest merge-string.20
357  (do-special-strings
358   (s "ace" nil)
359   (assert (string= (merge 'base-string (copy-seq "bdf") s #'char<) "abcdef")))
360  nil)
361
362(deftest merge-string.21
363  (do-special-strings
364   (s "ace" nil)
365   (assert (string= (merge 'simple-string s (copy-seq "bdf") #'char<) "abcdef")))
366  nil)
367
368(deftest merge-string.22
369  (do-special-strings
370   (s "ace" nil)
371   (assert (string= (merge 'simple-base-string s (copy-seq "bdf") #'char<) "abcdef")))
372  nil)
373
374(deftest merge-string.23
375  (do-special-strings
376   (s "ace" nil)
377   (assert (string= (merge '(vector character) s (copy-seq "bdf") #'char<) "abcdef")))
378  nil)
379
380(deftest merge-string.24
381  (merge '(string) (copy-seq "ace") (copy-seq "bdf") #'char<)
382  "abcdef")
383
384(deftest merge-string.25
385  (merge '(string *) (copy-seq "ace") (copy-seq "bdf") #'char<)
386  "abcdef")
387
388(deftest merge-string.26
389  (merge '(string 6) (copy-seq "ace") (copy-seq "bdf") #'char<)
390  "abcdef")
391
392(deftest merge-string.27
393  (merge '(simple-string) (copy-seq "ace") (copy-seq "bdf") #'char<)
394  "abcdef")
395
396(deftest merge-string.28
397  (merge '(simple-string *) (copy-seq "ace") (copy-seq "bdf") #'char<)
398  "abcdef")
399
400(deftest merge-string.29
401  (merge '(simple-string 6) (copy-seq "ace") (copy-seq "bdf") #'char<)
402  "abcdef")
403
404(deftest merge-string.30
405  (merge '(base-string) (copy-seq "ace") (copy-seq "bdf") #'char<)
406  "abcdef")
407
408(deftest merge-string.31
409  (merge '(base-string *) (copy-seq "ace") (copy-seq "bdf") #'char<)
410  "abcdef")
411
412(deftest merge-string.32
413  (merge '(base-string 6) (copy-seq "ace") (copy-seq "bdf") #'char<)
414  "abcdef")
415
416(deftest merge-string.33
417  (merge '(simple-base-string) (copy-seq "ace") (copy-seq "bdf") #'char<)
418  "abcdef")
419
420(deftest merge-string.34
421  (merge '(simple-base-string *) (copy-seq "ace") (copy-seq "bdf") #'char<)
422  "abcdef")
423
424(deftest merge-string.35
425  (merge '(simple-base-string 6) (copy-seq "ace") (copy-seq "bdf") #'char<)
426  "abcdef")
427
428
429;;; Tests for bit vectors
430
431(deftest merge-bit-vector.1
432  (let ((x (list 0 0 1 1 1))
433        (y (list 0 0 0 1 1)))
434    (merge 'bit-vector x y #'<))
435  #*0000011111)
436
437(deftest merge-bit-vector.2
438  (let ((x nil)
439        (y (list 0 0 0 1 1)))
440    (merge 'bit-vector x y #'<))
441  #*00011)
442
443(deftest merge-bit-vector.3
444  (let ((x nil)
445        (y (list 0 0 0 1 1)))
446    (merge 'bit-vector y x #'<))
447  #*00011)
448
449(deftest merge-bit-vector.4
450  (merge 'bit-vector nil nil #'<)
451  #*)
452
453(deftest merge-bit-vector.5
454  (let ((x (vector 0 0 1 1 1))
455        (y (list 0 0 0 1 1)))
456    (merge 'bit-vector x y #'<))
457  #*0000011111)
458
459(deftest merge-bit-vector.5a
460  (let ((x (copy-seq #*00111))
461        (y (list 0 0 0 1 1)))
462    (merge 'bit-vector x y #'<))
463  #*0000011111)
464
465(deftest merge-bit-vector.5b
466  (let ((x (list 0 0 1 1 1))
467        (y (copy-seq #*00011)))
468    (merge 'bit-vector x y #'<))
469  #*0000011111)
470
471(deftest merge-bit-vector.5c
472  (let ((x (copy-seq #*00111))
473        (y (copy-seq #*00011)))
474    (merge 'bit-vector x y #'<))
475  #*0000011111)
476
477(deftest merge-bit-vector.5d
478  (let ((x (copy-seq #*11111))
479        (y (copy-seq #*00000)))
480    (merge 'bit-vector x y #'<))
481  #*0000011111)
482
483(deftest merge-bit-vector.5e
484  (let ((x (copy-seq #*11111))
485        (y (copy-seq #*00000)))
486    (merge 'bit-vector y x #'<))
487  #*0000011111)
488
489(deftest merge-bit-vector.6
490  (let ((x (list 0 0 1 1 1))
491        (y (vector 0 0 0 1 1)))
492    (merge 'bit-vector x y #'<))
493  #*0000011111)
494
495(deftest merge-bit-vector.7
496  (let ((x (vector 0 0 1 1 1))
497        (y (vector 0 0 0 1 1)))
498    (merge 'bit-vector x y #'<))
499  #*0000011111)
500
501(deftest merge-bit-vector.8
502  (let ((x (list 1 1 1 0 0))
503        (y (list 1 1 0 0 0)))
504    (merge 'bit-vector x y #'< :key #'-))
505  #*1111100000)
506
507(deftest merge-bit-vector.9
508  (let ((x (list 0 0 1 1 1))
509        (y (list 0 0 0 1 1)))
510    (merge 'bit-vector x y #'< :key nil))
511  #*0000011111)
512
513(deftest merge-bit-vector.10
514  (let ((x (list 0 0 1 1 1))
515        (y (list 0 0 0 1 1)))
516    (merge 'bit-vector x y '<))
517  #*0000011111)
518
519(deftest merge-bit-vector.11
520  (let ((x (copy-seq #*)) (y (copy-seq #*)))
521    (merge 'bit-vector x y #'<))
522  #*)
523
524(deftest merge-bit-vector.12
525  (let ((x (copy-seq #*)) (y (copy-seq #*011)))
526    (merge 'bit-vector x y #'<))
527  #*011)
528 
529(deftest merge-bit-vector.13
530  (let ((x (copy-seq #*)) (y (list 0 1 1)))
531    (merge 'bit-vector x y #'<))
532  #*011)
533
534(deftest merge-bit-vector.14
535  (let ((x nil) (y (vector 0 1 1)))
536    (merge 'bit-vector y x #'<))
537  #*011)
538
539(deftest merge-bit-vector.15
540  (let ((x (copy-seq #*)) (y (list 0 1 1)))
541    (merge 'bit-vector y x #'<))
542  #*011)
543
544(deftest merge-bit-vector.16
545  (let* ((x (make-array '(10) :initial-contents #*0001101010
546                        :fill-pointer 5 :element-type 'bit))
547         (y (copy-seq #*001)))
548    (merge 'bit-vector x y #'<))
549  #*00000111)
550
551(deftest merge-bit-vector.17
552  (let* ((x (make-array '(10) :initial-contents #*0001101010
553                        :fill-pointer 5 :element-type 'bit))
554         (y (copy-seq #*001)))
555    (merge 'bit-vector y x #'<))
556  #*00000111)
557
558(deftest merge-bit-vector.18
559  (let* ((x (make-array '(10) :initial-contents #*0001101010
560                        :fill-pointer 5 :element-type 'bit)))
561    (merge 'bit-vector nil x #'<))
562  #*00011)
563
564(deftest merge-bit-vector.19
565  (let* ((x (make-array '(10) :initial-contents #*0001101010
566                        :fill-pointer 5 :element-type 'bit)))
567    (merge 'bit-vector x nil #'<))
568  #*00011)
569
570
571;;; Cons (which is a recognizable subtype of list)
572
573(deftest merge-cons.1
574  (merge 'cons (list 1 2 3) (list 4 5 6) #'<)
575  (1 2 3 4 5 6))
576
577;;; Null, which is a recognizable subtype of list
578
579(deftest merge-null.1
580  (merge 'null nil nil #'<)
581  nil)
582
583;;; Vectors with length
584
585(deftest merge-vector-length.1
586  (merge '(vector * 6) (list 1 2 3) (list 4 5 6) #'<)
587  #(1 2 3 4 5 6))
588 
589(deftest merge-bit-vector-length.1
590  (merge '(bit-vector  6) (list 0 1 1) (list 0 0 1) #'<)
591  #*000111)
592
593;;; Order of evaluation
594
595(deftest merge.order.1
596  (let ((i 0) a b c d)
597    (values
598     (merge (progn (setf a (incf i)) 'list)
599            (progn (setf b (incf i)) (list 2 5 6))
600            (progn (setf c (incf i)) (list 1 3 4))
601            (progn (setf d (incf i)) #'<))
602     i a b c d))
603  (1 2 3 4 5 6) 4 1 2 3 4)
604 
605;;; Tests of error situations
606
607(deftest merge.error.1
608  (handler-case (eval
609                 '(locally (declare (optimize safety))
610                           (merge 'symbol (list 1 2 3) (list 4 5 6) #'<)))
611                (error () :caught))
612  :caught)
613
614(deftest merge.error.2
615  (signals-error (merge '(vector * 3) (list 1 2 3) (list 4 5 6) #'<)
616                 type-error)
617  t)
618
619(deftest merge.error.3
620  (signals-error (merge '(bit-vector 3) (list 0 0 0) (list 1 1 1) #'<)
621                 type-error)
622  t)
623
624(deftest merge.error.4
625  (signals-error (merge '(vector * 7) (list 1 2 3) (list 4 5 6) #'<)
626                 type-error)
627  t)
628
629(deftest merge.error.5
630  (signals-error (merge '(bit-vector 7) (list 0 0 0) (list 1 1 1) #'<)
631                 type-error)
632  t)
633
634(deftest merge.error.6
635  (signals-error (merge 'null (list 1 2 3) (list 4 5 6) #'<)
636                 type-error)
637  t)
638
639(deftest merge.error.7
640  (signals-error (merge) program-error)
641  t)
642
643(deftest merge.error.8
644  (signals-error (merge 'list) program-error)
645  t)
646
647(deftest merge.error.9
648  (signals-error (merge 'list (list 2 4 6)) program-error)
649  t)
650
651(deftest merge.error.10
652  (signals-error (merge 'list (list 2 4 6) (list 1 3 5))
653                 program-error)
654  t)
655
656(deftest merge.error.11
657  (signals-error (merge 'list (list 2 4 6) (list 1 3 5) #'< :bad t)
658                 program-error)
659  t)
660
661(deftest merge.error.12
662  (signals-error (merge 'list (list 2 4 6) (list 1 3 5) #'< :key)
663                 program-error)
664  t)
665
666(deftest merge.error.13
667  (signals-error (merge 'list (list 2 4 6) (list 1 3 5) #'< :bad t
668                         :allow-other-keys nil)
669                 program-error)
670  t)
671
672(deftest merge.error.14
673  (signals-error (merge 'list (list 2 4 6) (list 1 3 5) #'< 1 2)
674                 program-error)
675  t)
676
677(deftest merge.error.15
678  (signals-error (locally (merge '(vector * 3) (list 1 2 3)
679                                  (list 4 5 6) #'<)
680                           t)
681                 type-error)
682  t) 
683
684(deftest merge.error.16
685  (signals-error (merge 'list (list 1 2) (list 3 4) #'car)
686                 program-error)
687  t)
688
689(deftest merge.error.17
690  (signals-error (merge 'list (list 'a 'b) (list 3 4) #'max)
691                 type-error)
692  t)
Note: See TracBrowser for help on using the repository browser.