← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ansi-tests/subsetp.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:
ansi-tests/subsetp.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Wed Apr  1 22:10:54 1998
 
4
;;;; Contains: Tests of SUBSETP
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(compile-and-load "cons-aux.lsp")
 
9
 
 
10
(defvar cons-test-24-var '(78 "z" (8 9)))
 
11
 
 
12
(deftest subsetp.1
 
13
  (subsetp-with-check (copy-tree '(78)) cons-test-24-var)
 
14
  t)
 
15
 
 
16
(deftest subsetp.2
 
17
  (subsetp-with-check (copy-tree '((8 9))) cons-test-24-var)
 
18
  nil)
 
19
 
 
20
(deftest subsetp.3
 
21
  (subsetp-with-check (copy-tree '((8 9)))
 
22
                      cons-test-24-var :test 'equal)
 
23
  t)
 
24
 
 
25
(deftest subsetp.4
 
26
  (subsetp-with-check (list 78 (copy-seq "Z")) cons-test-24-var
 
27
                      :test #'equalp)
 
28
  t)
 
29
 
 
30
(deftest subsetp.5
 
31
  (subsetp-with-check (list 1) (list 0 2 3 4)
 
32
                      :key #'(lambda (i) (floor (/ i 2))))
 
33
  t)
 
34
 
 
35
(deftest subsetp.6
 
36
  (subsetp-with-check (list 1 6) (list 0 2 3 4)
 
37
                      :key #'(lambda (i) (floor (/ i 2))))
 
38
  nil)
 
39
 
 
40
(deftest subsetp.7
 
41
  (subsetp-with-check (list '(a . 10) '(b . 20) '(c . 30))
 
42
                      (list '(z . c) '(a . y) '(b . 100) '(e . f)
 
43
                            '(c . foo))
 
44
                      :key #'car)
 
45
  t)
 
46
 
 
47
(deftest subsetp.8
 
48
  (subsetp-with-check (copy-tree '((a . 10) (b . 20) (c . 30)))
 
49
                      (copy-tree '((z . c) (a . y) (b . 100) (e . f)
 
50
                                   (c . foo)))
 
51
                      :key 'car)
 
52
  t)
 
53
 
 
54
(deftest subsetp.9
 
55
  (subsetp-with-check (list 'a 'b 'c)
 
56
                      (copy-tree
 
57
                       (list '(z . c) '(a . y) '(b . 100) '(e . f)
 
58
                             '(c . foo)))
 
59
                      :test #'(lambda (e1 e2)
 
60
                                (eqt e1 (car e2))))
 
61
  t)
 
62
 
 
63
(deftest subsetp.10
 
64
  (subsetp-with-check (list 'a 'b 'c)
 
65
                      (copy-tree
 
66
                       (list '(z . c) '(a . y) '(b . 100) '(e . f)
 
67
                             '(c . foo)))
 
68
                      :test #'(lambda (e1 e2)
 
69
                                (eqt e1 (car e2)))
 
70
                      :key nil)
 
71
  t)
 
72
 
 
73
(deftest subsetp.11
 
74
  (subsetp-with-check (list 'a 'b 'c)
 
75
                      (copy-tree
 
76
                       (list '(z . c) '(a . y) '(b . 100) '(e . f)
 
77
                             '(c . foo)))
 
78
                      :test-not  #'(lambda (e1 e2)
 
79
                                     (not (eqt e1 (car e2)))))
 
80
  t)
 
81
 
 
82
;; Check that it maintains order of arguments
 
83
 
 
84
(deftest subsetp.12
 
85
  (block fail
 
86
    (subsetp-with-check
 
87
     (list 1 2 3)
 
88
     (list 4 5 6)
 
89
     :test #'(lambda (x y)
 
90
               (when (< y x) (return-from fail 'fail))
 
91
               t)))
 
92
  t)
 
93
 
 
94
(deftest subsetp.13
 
95
  (block fail
 
96
    (subsetp-with-check
 
97
     (list 1 2 3)
 
98
     (list 4 5 6)
 
99
     :key #'identity
 
100
     :test #'(lambda (x y)
 
101
               (when (< y x) (return-from fail 'fail))
 
102
               t)))
 
103
  t)
 
104
 
 
105
(deftest subsetp.14
 
106
  (block fail
 
107
    (subsetp-with-check
 
108
     (list 1 2 3)
 
109
     (list 4 5 6)
 
110
     :test-not #'(lambda (x y)
 
111
                   (when (< y x) (return-from fail 'fail))
 
112
                   nil)))
 
113
  t)
 
114
 
 
115
(deftest subsetp.15
 
116
  (block fail
 
117
    (subsetp-with-check
 
118
     (list 1 2 3)
 
119
     (list 4 5 6)
 
120
     :key #'identity
 
121
     :test-not #'(lambda (x y)
 
122
                   (when (< y x) (return-from fail 'fail))
 
123
                   nil)))
 
124
  t)
 
125
 
 
126
(defharmless subsetp.test-and-test-not.1
 
127
  (subsetp '(a b c) '(a g c e b) :test #'eql :test-not #'eql))
 
128
 
 
129
(defharmless subsetp.test-and-test-not.3
 
130
  (subsetp '(a b c) '(a g c e b) :test-not #'eql :test #'eql))
 
131
 
 
132
;;; Order of argument evaluation tests
 
133
 
 
134
(deftest subsetp.order.1
 
135
  (let ((i 0) x y)
 
136
    (values
 
137
     (notnot (subsetp (progn (setf x (incf i))
 
138
                             '(a b c))
 
139
                      (progn (setf y (incf i))
 
140
                             '(a b c d))))
 
141
     i x y))
 
142
  t 2 1 2)
 
143
 
 
144
(deftest subsetp.order.2
 
145
  (let ((i 0) x y z w)
 
146
    (values
 
147
     (notnot (subsetp (progn (setf x (incf i))
 
148
                             '(a b c))
 
149
                      (progn (setf y (incf i))
 
150
                             '(a b c d))
 
151
                      :test (progn (setf z (incf i)) #'eql)
 
152
                      :key  (progn (setf w (incf i)) nil)))
 
153
     i x y z w))
 
154
  t 4 1 2 3 4)
 
155
 
 
156
(deftest subsetp.order.3
 
157
  (let ((i 0) x y z w)
 
158
    (values
 
159
     (notnot (subsetp (progn (setf x (incf i))
 
160
                             '(a b c))
 
161
                      (progn (setf y (incf i))
 
162
                             '(a b c d))
 
163
                      :key  (progn (setf z (incf i)) nil)
 
164
                      :test (progn (setf w (incf i)) #'eql)))
 
165
     i x y z w))
 
166
  t 4 1 2 3 4)
 
167
 
 
168
;;; Keyword tests
 
169
 
 
170
(deftest subsetp.allow-other-keys.1
 
171
  (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4 5) :bad t :allow-other-keys 67))
 
172
  t)
 
173
 
 
174
(deftest subsetp.allow-other-keys.2
 
175
  (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4 5)
 
176
                   :allow-other-keys #'cons :bad t))
 
177
  t)
 
178
 
 
179
(deftest subsetp.allow-other-keys.3
 
180
  (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4)
 
181
                   :allow-other-keys (make-hash-table)
 
182
                   :bad t
 
183
                   :test #'(lambda (x y) (= (1+ x) y))))
 
184
  nil)
 
185
 
 
186
(deftest subsetp.allow-other-keys.4
 
187
  (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4 5) :allow-other-keys t))
 
188
  t)
 
189
 
 
190
(deftest subsetp.allow-other-keys.5
 
191
  (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4 5) :allow-other-keys nil))
 
192
  t)
 
193
 
 
194
(deftest subsetp.allow-other-keys.6
 
195
  (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4 5)
 
196
                   :allow-other-keys t :bad1 t
 
197
                   :allow-other-keys nil :bad2 t))
 
198
  t)
 
199
 
 
200
(deftest subsetp.keywords.7
 
201
  (notnot-mv (subsetp '(1 2 3 4) '(0 1 2 3 4)
 
202
                   :test #'(lambda (x y) (= (1+ x) y))
 
203
                   :test #'eql))
 
204
  nil)
 
205
 
 
206
(deftest subsetp.keywords.8
 
207
  (notnot-mv (subsetp '(1 2 3 4 10) '(0 1 2 3 4)
 
208
                   :key nil
 
209
                   :key #'(lambda (x) (mod x 2))))
 
210
  nil)
 
211
 
 
212
 
 
213
;;; Error tests
 
214
 
 
215
(deftest subsetp.error.1
 
216
  (signals-error (subsetp) program-error)
 
217
  t)
 
218
 
 
219
(deftest subsetp.error.2
 
220
  (signals-error (subsetp nil) program-error)
 
221
  t)
 
222
 
 
223
(deftest subsetp.error.3
 
224
  (signals-error (subsetp nil nil :bad t) program-error)
 
225
  t)
 
226
 
 
227
(deftest subsetp.error.4
 
228
  (signals-error (subsetp nil nil :key) program-error)
 
229
  t)
 
230
 
 
231
(deftest subsetp.error.5
 
232
  (signals-error (subsetp nil nil 1 2) program-error)
 
233
  t)
 
234
 
 
235
(deftest subsetp.error.6
 
236
  (signals-error (subsetp nil nil :bad t :allow-other-keys nil) program-error)
 
237
  t)
 
238
 
 
239
(deftest subsetp.error.7
 
240
  (signals-error (subsetp (list 1 2) (list 3 4) :test #'identity) program-error)
 
241
  t)
 
242
 
 
243
(deftest subsetp.error.8
 
244
  (signals-error (subsetp (list 1 2) (list 3 4) :test-not #'identity) program-error)
 
245
  t)
 
246
 
 
247
(deftest subsetp.error.9
 
248
  (signals-error (subsetp (list 1 2) (list 3 4) :key #'cons) program-error)
 
249
  t)
 
250
 
 
251
(deftest subsetp.error.10
 
252
  (signals-error (subsetp (list 1 2) (list 3 4) :key #'car) type-error)
 
253
  t)
 
254
 
 
255
(deftest subsetp.error.11
 
256
  (signals-error (subsetp (list 1 2 3) (list* 4 5 6)) type-error)
 
257
  t)
 
258
 
 
259
(deftest subsetp.error.12
 
260
  (signals-error (subsetp (list* 1 2 3) (list 1 2 3 4 5 6)) type-error)
 
261
  t)