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

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

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

revision 1.8 by pfdietz, Sat Jan 18 12:49:35 2003 UTC revision 1.9 by pfdietz, Mon Feb 10 00:05:26 2003 UTC
# Line 10  Line 10 
10  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11  ;;; intersection  ;;; intersection
12    
13  (deftest intersection-1  (deftest intersection.1
14      (intersection nil nil)    (intersection nil nil)
15    nil)    nil)
16    
17  (deftest intersection-2  (deftest intersection.2
18      (intersection (loop for i from 1 to 100 collect i) nil)    (intersection (loop for i from 1 to 100 collect i) nil)
19    nil)    nil)
20    
21  (deftest intersection-3  (deftest intersection.3
22      (intersection nil (loop for i from 1 to 100 collect i))    (intersection nil (loop for i from 1 to 100 collect i))
23    nil)    nil)
24    
25  (deftest intersection-4  (deftest intersection.4
26      (let* ((x (copy-list '(a 1 c 7 b 4 3 z)))    (let* ((x (copy-list '(a 1 c 7 b 4 3 z)))
27             (xcopy (make-scaffold-copy x))           (xcopy (make-scaffold-copy x))
28             (y (copy-list '(3 y c q z a 18)))           (y (copy-list '(3 y c q z a 18)))
29             (ycopy (make-scaffold-copy y))           (ycopy (make-scaffold-copy y))
30             (result (intersection x y)))           (result (intersection x y)))
31        (and      (and
32         (check-scaffold-copy x xcopy)       (check-scaffold-copy x xcopy)
33         (check-scaffold-copy y ycopy)       (check-scaffold-copy y ycopy)
34         (+       (+
35          (loop        (loop
36              for e in x count         for e in x count
37                (and (member e y)         (and (member e y)
38                     (not (member e result))))              (not (member e result))))
39          (loop        (loop
40              for e in result count         for e in result count
41                (or (not (member e x))         (or (not (member e x))
42                    (not (member e y))))             (not (member e y))))
43          (loop        (loop
44              for hd on result count         for hd on result count
45                (and (consp hd)         (and (consp hd)
46                     (member (car hd) (cdr hd)))))))              (member (car hd) (cdr hd)))))))
47    0)    0)
48    
49  (deftest intersection-5  (deftest intersection.5
50      (let* ((x (copy-list '(a a a)))    (let* ((x (copy-list '(a a a)))
51             (xcopy (make-scaffold-copy x))           (xcopy (make-scaffold-copy x))
52             (y (copy-list '(a a a b b b)))           (y (copy-list '(a a a b b b)))
53             (ycopy (make-scaffold-copy y))           (ycopy (make-scaffold-copy y))
54             (result (intersection x y)))           (result (intersection x y)))
55        (and      (and
56         (check-scaffold-copy x xcopy)       (check-scaffold-copy x xcopy)
57         (check-scaffold-copy y ycopy)       (check-scaffold-copy y ycopy)
58         (member 'a result)       (member 'a result)
59         (not (member 'b result))))       (not (member 'b result))))
60    t)    t)
61    
62  (deftest intersection-6  (deftest intersection.6
63      (intersection (list 1000000000000 'a 'b 'c)    (intersection (list 1000000000000 'a 'b 'c)
64                    (list (1+ 999999999999) 'd 'e 'f))                  (list (1+ 999999999999) 'd 'e 'f))
65    (1000000000000))    (1000000000000))
66    
67  (deftest intersection-7  (deftest intersection.7
68      (intersection (list 'a 10 'b 17)    (intersection (list 'a 10 'b 17)
69                    (list 'c 'd 4 'e 'f 10 1 13 'z))                  (list 'c 'd 4 'e 'f 10 1 13 'z))
70    (10))    (10))
71    
72  (deftest intersection-8  (deftest intersection.8
73      (intersection (list 'a (copy-seq "aaa") 'b)    (intersection (list 'a (copy-seq "aaa") 'b)
74                    (list 'd (copy-seq "aaa") 'e))                  (list 'd (copy-seq "aaa") 'e))
75    nil)    nil)
76    
77  (deftest intersection-9  (deftest intersection.9
78      (intersection (list 'a (copy-seq "aaa") 'b)    (intersection (list 'a (copy-seq "aaa") 'b)
79                    (list 'd (copy-seq "aaa") 'e)                  (list 'd (copy-seq "aaa") 'e)
80                    :test #'equal)                  :test #'equal)
81    ("aaa"))    ("aaa"))
82    
83  ;; Same as 9, but with a symbol function designator for :test  ;; Same as 9, but with a symbol function designator for :test
84  (deftest intersection-9-a  (deftest intersection.9-a
85      (intersection (list 'a (copy-seq "aaa") 'b)    (intersection (list 'a (copy-seq "aaa") 'b)
86                    (list 'd (copy-seq "aaa") 'e)                  (list 'd (copy-seq "aaa") 'e)
87                    :test 'equal)                  :test 'equal)
88    ("aaa"))    ("aaa"))
89    
90  (deftest intersection-9-b  (deftest intersection.9-b
91      (intersection (list 'a (copy-seq "aaa") 'b)    (intersection (list 'a (copy-seq "aaa") 'b)
92                    (list 'd (copy-seq "aaa") 'e)                  (list 'd (copy-seq "aaa") 'e)
93                    :test-not #'(lambda (p q) (not (equal p q))))                  :test-not #'(lambda (p q) (not (equal p q))))
94    ("aaa"))    ("aaa"))
95    
96  (deftest intersection-10  (deftest intersection.10
97    (equalt    (equalt
98     (sort     (sort
99      (intersection (loop      (intersection (loop
# Line 106  Line 106 
106     (loop for i from 0 to 1000 by 21 collect i))     (loop for i from 0 to 1000 by 21 collect i))
107    t)    t)
108    
109  (deftest intersection-11  (deftest intersection.11
110    (equalt    (equalt
111     (sort     (sort
112      (intersection (loop      (intersection (loop
# Line 122  Line 122 
122     (loop for i from 0 to 999 by (* 3 5 7) collect i))     (loop for i from 0 to 999 by (* 3 5 7) collect i))
123    t)    t)
124    
125  (deftest intersection-11-a  (deftest intersection.11-a
126    (equalt    (equalt
127     (sort     (sort
128      (intersection (loop      (intersection (loop
# Line 143  Line 143 
143  ;; Do large numbers of random intersection tests  ;; Do large numbers of random intersection tests
144  ;;  ;;
145    
146  (deftest intersection-12  (deftest intersection.12
147      (intersection-12-body 100 100)    (intersection-12-body 100 100)
148    nil)    nil)
149    
150    
# Line 152  Line 152 
152  ;; :key argument  ;; :key argument
153  ;;  ;;
154    
155  (deftest intersection-13  (deftest intersection.13
156    (let ((x (copy-list '(0 5 8 13 31 42)))    (let ((x (copy-list '(0 5 8 13 31 42)))
157          (y (copy-list '(3 5 42 0 7 100 312 33))))          (y (copy-list '(3 5 42 0 7 100 312 33))))
158      (equalt      (equalt
# Line 161  Line 161 
161    t)    t)
162    
163  ;; Same as 13, but with a symbol function designator for :key  ;; Same as 13, but with a symbol function designator for :key
164  (deftest intersection-13-a  (deftest intersection.13-a
165    (let ((x (copy-list '(0 5 8 13 31 42)))    (let ((x (copy-list '(0 5 8 13 31 42)))
166          (y (copy-list '(3 5 42 0 7 100 312 33))))          (y (copy-list '(3 5 42 0 7 100 312 33))))
167      (equalt      (equalt
# Line 171  Line 171 
171    
172  ;; Test that a nil key argument is ignored  ;; Test that a nil key argument is ignored
173    
174  (deftest intersection-14  (deftest intersection.14
175    (let    (let
176        ((result (intersection (copy-list '(a b c d))        ((result (intersection (copy-list '(a b c d))
177                               (copy-list '(e c f b g))                               (copy-list '(e c f b g))
# Line 185  Line 185 
185    
186  ;; Test that intersection preserves the order of arguments to :test, :test-not  ;; Test that intersection preserves the order of arguments to :test, :test-not
187    
188  (deftest intersection-15  (deftest intersection.15
189    (let ((list1 (list 1 2 3 4))    (let ((list1 (list 1 2 3 4))
190          (list2 (list 4 5 6 7)))          (list2 (list 4 5 6 7)))
191      (block fail      (block fail
# Line 197  Line 197 
197             (eql x y)))))             (eql x y)))))
198    (4))    (4))
199    
200  (deftest intersection-16  (deftest intersection.16
201    (let ((list1 (list 1 2 3 4))    (let ((list1 (list 1 2 3 4))
202          (list2 (list 4 5 6 7)))          (list2 (list 4 5 6 7)))
203      (block fail      (block fail
# Line 210  Line 210 
210             (eql x y)))))             (eql x y)))))
211    (4))    (4))
212    
213  (deftest intersection-17  (deftest intersection.17
214    (let ((list1 (list 1 2 3 4))    (let ((list1 (list 1 2 3 4))
215          (list2 (list 4 5 6 7)))          (list2 (list 4 5 6 7)))
216      (block fail      (block fail
# Line 222  Line 222 
222             (not (eql x y))))))             (not (eql x y))))))
223    (4))    (4))
224    
225  (deftest intersection-18  (deftest intersection.18
226    (let ((list1 (list 1 2 3 4))    (let ((list1 (list 1 2 3 4))
227          (list2 (list 4 5 6 7)))          (list2 (list 4 5 6 7)))
228      (block fail      (block fail
# Line 235  Line 235 
235             (not (eql x y))))))             (not (eql x y))))))
236    (4))    (4))
237    
238    ;;; Order of argument evaluation tests
239    
240    (deftest intersection.19
241      (let ((i 0) x y)
242        (values
243         (intersection (progn (setf x (incf i)) (list 'a 'b))
244                       (progn (setf y (incf i)) (list 'c 'd)))
245         i x y))
246      nil 2 1 2)
247    
248    (deftest intersection.20
249      (let ((i 0) x y)
250        (values
251         (intersection (progn (setf x (incf i)) (list 'a 'b))
252                       (progn (setf y (incf i)) (list 'c 'd))
253                       :test #'eq)
254         i x y))
255      nil 2 1 2)
256    
257    (deftest intersection.21
258      (let ((i 0) x y z w)
259        (values
260         (intersection (progn (setf x (incf i)) (list 'a 'b))
261                       (progn (setf y (incf i)) (list 'c 'd))
262                       :test (progn (setf z (incf i)) #'eq)
263                       :test (progn (setf w (incf i))
264                                    (complement #'eq)))
265         i x y z w))
266      nil 4 1 2 3 4)
267    
268    (deftest intersection.22
269      (let ((i 0) x y z w)
270        (values
271         (intersection (progn (setf x (incf i)) (list 'a 'b))
272                       (progn (setf y (incf i)) (list 'c 'd))
273                       :test (progn (setf z (incf i)) #'eq)
274                       :key (progn (setf w (incf i)) #'identity))
275         i x y z w))
276      nil 4 1 2 3 4)
277    
278    (deftest intersection.23
279      (let ((i 0) x y z w)
280        (values
281         (intersection (progn (setf x (incf i)) (list 'a 'b))
282                       (progn (setf y (incf i)) (list 'c 'd))
283                       :key (progn (setf z (incf i)) #'identity)
284                       :test (progn (setf w (incf i)) #'eq))
285         i x y z w))
286      nil 4 1 2 3 4)
287    
288    
289  ;;; Keyword tests  ;;; Keyword tests
290    
291  (deftest intersection.allow-other-keys.1  (deftest intersection.allow-other-keys.1
# Line 324  Line 375 
375  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376  ;;; nintersection  ;;; nintersection
377    
378  (deftest nintersection-1  (deftest nintersection.1
379    (nintersection nil nil)    (nintersection nil nil)
380    nil)    nil)
381    
382  (deftest nintersection-2  (deftest nintersection.2
383    (nintersection (loop for i from 1 to 100 collect i) nil)    (nintersection (loop for i from 1 to 100 collect i) nil)
384    nil)    nil)
385    
386  (deftest nintersection-3  (deftest nintersection.3
387    (nintersection-with-check nil (loop for i from 1 to 100 collect i))    (nintersection-with-check nil (loop for i from 1 to 100 collect i))
388    nil)    nil)
389    
390  (deftest nintersection-4  (deftest nintersection.4
391    (let* ((x (copy-list '(a 1 c 7 b 4 3 z)))    (let* ((x (copy-list '(a 1 c 7 b 4 3 z)))
392           (xc (copy-list x))           (xc (copy-list x))
393           (y (copy-list '(3 y c q z a 18)))           (y (copy-list '(3 y c q z a 18)))
# Line 354  Line 405 
405                   (member (car hd) (cdr hd)))))))                   (member (car hd) (cdr hd)))))))
406    0)    0)
407    
408  (deftest nintersection-5  (deftest nintersection.5
409    (let* ((x (copy-list '(a a a)))    (let* ((x (copy-list '(a a a)))
410           (y (copy-list '(a a a b b b)))           (y (copy-list '(a a a b b b)))
411           (result (nintersection-with-check x y)))           (result (nintersection-with-check x y)))
# Line 364  Line 415 
415       (not (member 'b result))))       (not (member 'b result))))
416    t)    t)
417    
418  (deftest nintersection-6  (deftest nintersection.6
419    (nintersection-with-check    (nintersection-with-check
420     (list 1000000000000 'a 'b 'c)     (list 1000000000000 'a 'b 'c)
421     (list (1+ 999999999999) 'd 'e 'f))     (list (1+ 999999999999) 'd 'e 'f))
422    (1000000000000))    (1000000000000))
423    
424  (deftest nintersection-7  (deftest nintersection.7
425    (nintersection-with-check (list 'a 10 'b 17)    (nintersection-with-check (list 'a 10 'b 17)
426                              (list 'c 'd 4 'e 'f 10 1 13 'z))                              (list 'c 'd 4 'e 'f 10 1 13 'z))
427    (10))    (10))
428    
429  (deftest nintersection-8  (deftest nintersection.8
430    (nintersection-with-check    (nintersection-with-check
431     (list 'a (copy-seq "aaa") 'b)     (list 'a (copy-seq "aaa") 'b)
432     (list 'd (copy-seq "aaa") 'e))     (list 'd (copy-seq "aaa") 'e))
433    nil)    nil)
434    
435  (deftest nintersection-9  (deftest nintersection.9
436    (nintersection-with-check    (nintersection-with-check
437     (list 'a (copy-seq "aaa") 'b)     (list 'a (copy-seq "aaa") 'b)
438     (list 'd (copy-seq "aaa") 'e)     (list 'd (copy-seq "aaa") 'e)
439     :test #'equal)     :test #'equal)
440    ("aaa"))    ("aaa"))
441    
442  (deftest nintersection-9-a  (deftest nintersection.9-a
443    (nintersection-with-check    (nintersection-with-check
444     (list 'a (copy-seq "aaa") 'b)     (list 'a (copy-seq "aaa") 'b)
445     (list 'd (copy-seq "aaa") 'e)     (list 'd (copy-seq "aaa") 'e)
446     :test 'equal)     :test 'equal)
447    ("aaa"))    ("aaa"))
448    
449  (deftest nintersection-9-b  (deftest nintersection.9-b
450    (nintersection    (nintersection
451     (list 'a (copy-seq "aaa") 'b)     (list 'a (copy-seq "aaa") 'b)
452     (list 'd (copy-seq "aaa") 'e)     (list 'd (copy-seq "aaa") 'e)
453     :test-not #'(lambda (p q) (not (equal p q))))     :test-not #'(lambda (p q) (not (equal p q))))
454    ("aaa"))    ("aaa"))
455    
456  (deftest nintersection-10  (deftest nintersection.10
457    (equalt    (equalt
458     (sort     (sort
459      (let ((result      (let ((result
# Line 414  Line 465 
465     (loop for i from 0 to 1000 by 21 collect i))     (loop for i from 0 to 1000 by 21 collect i))
466    t)    t)
467    
468  (deftest nintersection-11  (deftest nintersection.11
469    (equalt    (equalt
470     (sort     (sort
471      (let ((result      (let ((result
# Line 430  Line 481 
481      for i from 0 to 999 by (* 3 5 7) collect i))      for i from 0 to 999 by (* 3 5 7) collect i))
482    t)    t)
483    
484  (deftest nintersection-12  (deftest nintersection.12
485    (nintersection-12-body 100 100)    (nintersection-12-body 100 100)
486    nil)    nil)
487    
488  ;; Key argument  ;; Key argument
489    
490  (deftest nintersection-13  (deftest nintersection.13
491    (let ((x '(0 5 8 13 31 42))    (let ((x '(0 5 8 13 31 42))
492          (y (copy-list '(3 5 42 0 7 100 312 33))))          (y (copy-list '(3 5 42 0 7 100 312 33))))
493      (equalt      (equalt
# Line 448  Line 499 
499    
500  ;; Check that a nil key argument is ignored  ;; Check that a nil key argument is ignored
501    
502  (deftest nintersection-14  (deftest nintersection.14
503    (let    (let
504        ((result (nintersection        ((result (nintersection
505                  (copy-list '(a b c d))                  (copy-list '(a b c d))
# Line 463  Line 514 
514    
515  ;; Test that nintersection preserves the order of arguments to :test, :test-not  ;; Test that nintersection preserves the order of arguments to :test, :test-not
516    
517  (deftest nintersection-15  (deftest nintersection.15
518    (let ((list1 (list 1 2 3 4))    (let ((list1 (list 1 2 3 4))
519          (list2 (list 4 5 6 7)))          (list2 (list 4 5 6 7)))
520      (block fail      (block fail
# Line 475  Line 526 
526             (eql x y)))))             (eql x y)))))
527    (4))    (4))
528    
529  (deftest nintersection-16  (deftest nintersection.16
530    (let ((list1 (list 1 2 3 4))    (let ((list1 (list 1 2 3 4))
531          (list2 (list 4 5 6 7)))          (list2 (list 4 5 6 7)))
532      (block fail      (block fail
# Line 488  Line 539 
539             (eql x y)))))             (eql x y)))))
540    (4))    (4))
541    
542  (deftest nintersection-17  (deftest nintersection.17
543    (let ((list1 (list 1 2 3 4))    (let ((list1 (list 1 2 3 4))
544          (list2 (list 4 5 6 7)))          (list2 (list 4 5 6 7)))
545      (block fail      (block fail
# Line 500  Line 551 
551             (not (eql x y))))))             (not (eql x y))))))
552    (4))    (4))
553    
554  (deftest nintersection-18  (deftest nintersection.18
555    (let ((list1 (list 1 2 3 4))    (let ((list1 (list 1 2 3 4))
556          (list2 (list 4 5 6 7)))          (list2 (list 4 5 6 7)))
557      (block fail      (block fail
# Line 513  Line 564 
564             (not (eql x y))))))             (not (eql x y))))))
565    (4))    (4))
566    
567    ;;; Order of argument evaluation tests
568    
569    (deftest nintersection.19
570      (let ((i 0) x y)
571        (values
572         (nintersection (progn (setf x (incf i)) (list 'a 'b))
573                       (progn (setf y (incf i)) (list 'c 'd)))
574         i x y))
575      nil 2 1 2)
576    
577    (deftest nintersection.20
578      (let ((i 0) x y)
579        (values
580         (nintersection (progn (setf x (incf i)) (list 'a 'b))
581                       (progn (setf y (incf i)) (list 'c 'd))
582                       :test #'eq)
583         i x y))
584      nil 2 1 2)
585    
586    (deftest nintersection.21
587      (let ((i 0) x y z w)
588        (values
589         (nintersection (progn (setf x (incf i)) (list 'a 'b))
590                       (progn (setf y (incf i)) (list 'c 'd))
591                       :test (progn (setf z (incf i)) #'eq)
592                       :test (progn (setf w (incf i))
593                                    (complement #'eq)))
594         i x y z w))
595      nil 4 1 2 3 4)
596    
597    (deftest nintersection.22
598      (let ((i 0) x y z w)
599        (values
600         (nintersection (progn (setf x (incf i)) (list 'a 'b))
601                       (progn (setf y (incf i)) (list 'c 'd))
602                       :test (progn (setf z (incf i)) #'eq)
603                       :key (progn (setf w (incf i)) #'identity))
604         i x y z w))
605      nil 4 1 2 3 4)
606    
607    (deftest nintersection.23
608      (let ((i 0) x y z w)
609        (values
610         (nintersection (progn (setf x (incf i)) (list 'a 'b))
611                       (progn (setf y (incf i)) (list 'c 'd))
612                       :key (progn (setf z (incf i)) #'identity)
613                       :test (progn (setf w (incf i)) #'eq))
614         i x y z w))
615      nil 4 1 2 3 4)
616    
617  ;;; Keyword tests  ;;; Keyword tests
618    
619  (deftest nintersection.allow-other-keys.1  (deftest nintersection.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