12 |
|
|
13 |
(defvar cons-test-24-var '(78 "z" (8 9))) |
(defvar cons-test-24-var '(78 "z" (8 9))) |
14 |
|
|
15 |
(deftest subsetp-1 |
(deftest subsetp.1 |
16 |
(subsetp-with-check (copy-tree '(78)) cons-test-24-var) |
(subsetp-with-check (copy-tree '(78)) cons-test-24-var) |
17 |
t) |
t) |
18 |
|
|
19 |
(deftest subsetp-2 |
(deftest subsetp.2 |
20 |
(subsetp-with-check (copy-tree '((8 9))) cons-test-24-var) |
(subsetp-with-check (copy-tree '((8 9))) cons-test-24-var) |
21 |
nil) |
nil) |
22 |
|
|
23 |
(deftest subsetp-3 |
(deftest subsetp.3 |
24 |
(subsetp-with-check (copy-tree '((8 9))) |
(subsetp-with-check (copy-tree '((8 9))) |
25 |
cons-test-24-var :test 'equal) |
cons-test-24-var :test 'equal) |
26 |
t) |
t) |
27 |
|
|
28 |
(deftest subsetp-4 |
(deftest subsetp.4 |
29 |
(subsetp-with-check (list 78 (copy-seq "Z")) cons-test-24-var |
(subsetp-with-check (list 78 (copy-seq "Z")) cons-test-24-var |
30 |
:test #'equalp) |
:test #'equalp) |
31 |
t) |
t) |
32 |
|
|
33 |
(deftest subsetp-5 |
(deftest subsetp.5 |
34 |
(subsetp-with-check (list 1) (list 0 2 3 4) |
(subsetp-with-check (list 1) (list 0 2 3 4) |
35 |
:key #'(lambda (i) (floor (/ i 2)))) |
:key #'(lambda (i) (floor (/ i 2)))) |
36 |
t) |
t) |
37 |
|
|
38 |
(deftest subsetp-6 |
(deftest subsetp.6 |
39 |
(subsetp-with-check (list 1 6) (list 0 2 3 4) |
(subsetp-with-check (list 1 6) (list 0 2 3 4) |
40 |
:key #'(lambda (i) (floor (/ i 2)))) |
:key #'(lambda (i) (floor (/ i 2)))) |
41 |
nil) |
nil) |
42 |
|
|
43 |
(deftest subsetp-7 |
(deftest subsetp.7 |
44 |
(subsetp-with-check (list '(a . 10) '(b . 20) '(c . 30)) |
(subsetp-with-check (list '(a . 10) '(b . 20) '(c . 30)) |
45 |
(list '(z . c) '(a . y) '(b . 100) '(e . f) |
(list '(z . c) '(a . y) '(b . 100) '(e . f) |
46 |
'(c . foo)) |
'(c . foo)) |
47 |
:key #'car) |
:key #'car) |
|
t) |
|
|
|
|
|
(deftest subsetp-8 |
|
|
(subsetp-with-check (copy-tree '((a . 10) (b . 20) (c . 30))) |
|
|
(copy-tree '((z . c) (a . y) (b . 100) (e . f) |
|
|
(c . foo))) |
|
|
:key 'car) |
|
|
t) |
|
|
|
|
|
(deftest subsetp-9 |
|
|
(subsetp-with-check (list 'a 'b 'c) |
|
|
(copy-tree |
|
|
(list '(z . c) '(a . y) '(b . 100) '(e . f) |
|
|
'(c . foo))) |
|
|
:test #'(lambda (e1 e2) |
|
|
(eqt e1 (car e2)))) |
|
48 |
t) |
t) |
49 |
|
|
50 |
(deftest subsetp-10 |
(deftest subsetp.8 |
51 |
|
(subsetp-with-check (copy-tree '((a . 10) (b . 20) (c . 30))) |
52 |
|
(copy-tree '((z . c) (a . y) (b . 100) (e . f) |
53 |
|
(c . foo))) |
54 |
|
:key 'car) |
55 |
|
t) |
56 |
|
|
57 |
|
(deftest subsetp.9 |
58 |
|
(subsetp-with-check (list 'a 'b 'c) |
59 |
|
(copy-tree |
60 |
|
(list '(z . c) '(a . y) '(b . 100) '(e . f) |
61 |
|
'(c . foo))) |
62 |
|
:test #'(lambda (e1 e2) |
63 |
|
(eqt e1 (car e2)))) |
64 |
|
t) |
65 |
|
|
66 |
|
(deftest subsetp.10 |
67 |
(subsetp-with-check (list 'a 'b 'c) |
(subsetp-with-check (list 'a 'b 'c) |
68 |
(copy-tree |
(copy-tree |
69 |
(list '(z . c) '(a . y) '(b . 100) '(e . f) |
(list '(z . c) '(a . y) '(b . 100) '(e . f) |
73 |
:key nil) |
:key nil) |
74 |
t) |
t) |
75 |
|
|
76 |
(deftest subsetp-11 |
(deftest subsetp.11 |
77 |
(subsetp-with-check (list 'a 'b 'c) |
(subsetp-with-check (list 'a 'b 'c) |
78 |
(copy-tree |
(copy-tree |
79 |
(list '(z . c) '(a . y) '(b . 100) '(e . f) |
(list '(z . c) '(a . y) '(b . 100) '(e . f) |
80 |
'(c . foo))) |
'(c . foo))) |
81 |
:test-not #'(lambda (e1 e2) |
:test-not #'(lambda (e1 e2) |
82 |
(not (eqt e1 (car e2))))) |
(not (eqt e1 (car e2))))) |
83 |
t) |
t) |
84 |
|
|
85 |
;; Check that it maintains order of arguments |
;; Check that it maintains order of arguments |
86 |
|
|
87 |
(deftest subsetp-12 |
(deftest subsetp.12 |
88 |
(block fail |
(block fail |
89 |
(subsetp-with-check |
(subsetp-with-check |
90 |
(list 1 2 3) |
(list 1 2 3) |
91 |
(list 4 5 6) |
(list 4 5 6) |
92 |
:test #'(lambda (x y) |
:test #'(lambda (x y) |
93 |
(when (< y x) (return-from fail 'fail)) |
(when (< y x) (return-from fail 'fail)) |
94 |
t))) |
t))) |
95 |
t) |
t) |
96 |
|
|
97 |
(deftest subsetp-13 |
(deftest subsetp.13 |
98 |
(block fail |
(block fail |
99 |
(subsetp-with-check |
(subsetp-with-check |
100 |
(list 1 2 3) |
(list 1 2 3) |
101 |
(list 4 5 6) |
(list 4 5 6) |
102 |
:key #'identity |
:key #'identity |
103 |
:test #'(lambda (x y) |
:test #'(lambda (x y) |
104 |
(when (< y x) (return-from fail 'fail)) |
(when (< y x) (return-from fail 'fail)) |
105 |
t))) |
t))) |
106 |
t) |
t) |
107 |
|
|
108 |
(deftest subsetp-14 |
(deftest subsetp.14 |
109 |
(block fail |
(block fail |
110 |
(subsetp-with-check |
(subsetp-with-check |
111 |
(list 1 2 3) |
(list 1 2 3) |
112 |
(list 4 5 6) |
(list 4 5 6) |
113 |
:test-not #'(lambda (x y) |
:test-not #'(lambda (x y) |
114 |
(when (< y x) (return-from fail 'fail)) |
(when (< y x) (return-from fail 'fail)) |
115 |
nil))) |
nil))) |
116 |
t) |
t) |
117 |
|
|
118 |
(deftest subsetp-15 |
(deftest subsetp.15 |
119 |
(block fail |
(block fail |
120 |
(subsetp-with-check |
(subsetp-with-check |
121 |
(list 1 2 3) |
(list 1 2 3) |
122 |
(list 4 5 6) |
(list 4 5 6) |
123 |
:key #'identity |
:key #'identity |
124 |
:test-not #'(lambda (x y) |
:test-not #'(lambda (x y) |
125 |
(when (< y x) (return-from fail 'fail)) |
(when (< y x) (return-from fail 'fail)) |
126 |
nil))) |
nil))) |
127 |
t) |
t) |
128 |
|
|
129 |
|
;;; Order of argument evaluation tests |
130 |
|
|
131 |
|
(deftest subsetp.16 |
132 |
|
(let ((i 0) x y) |
133 |
|
(values |
134 |
|
(notnot (subsetp (progn (setf x (incf i)) |
135 |
|
'(a b c)) |
136 |
|
(progn (setf y (incf i)) |
137 |
|
'(a b c d)))) |
138 |
|
i x y)) |
139 |
|
t 2 1 2) |
140 |
|
|
141 |
|
(deftest subsetp.17 |
142 |
|
(let ((i 0) x y z w) |
143 |
|
(values |
144 |
|
(notnot (subsetp (progn (setf x (incf i)) |
145 |
|
'(a b c)) |
146 |
|
(progn (setf y (incf i)) |
147 |
|
'(a b c d)) |
148 |
|
:test (progn (setf z (incf i)) #'eql) |
149 |
|
:key (progn (setf w (incf i)) nil))) |
150 |
|
i x y z w)) |
151 |
|
t 4 1 2 3 4) |
152 |
|
|
153 |
|
(deftest subsetp.18 |
154 |
|
(let ((i 0) x y z w) |
155 |
|
(values |
156 |
|
(notnot (subsetp (progn (setf x (incf i)) |
157 |
|
'(a b c)) |
158 |
|
(progn (setf y (incf i)) |
159 |
|
'(a b c d)) |
160 |
|
:key (progn (setf z (incf i)) nil) |
161 |
|
:test (progn (setf w (incf i)) #'eql))) |
162 |
|
i x y z w)) |
163 |
|
t 4 1 2 3 4) |
164 |
|
|
165 |
|
|
166 |
|
|
167 |
;;; Keyword tests |
;;; Keyword tests |
168 |
|
|