source: trunk/tests/ansi-tests/subtypep-cons.lsp @ 9045

Last change on this file since 9045 was 9045, checked in by gz, 12 years ago

Assorted cleanup:

In infrastructure:

  • add *test-verbose* and :verbose argument to do-test and do-tests. Avoid random output if false, only show failures
  • muffle-wawrnings and/or bind *suppress-compiler-warnings* in some tests that unavoidably generate them (mainly with duplicate typecase/case clauses)
  • Add record-source-file for tests so meta-. can find them
  • If *catch-errors* (or the :catch-errors arg) is :break, enter a breakloop when catch an error
  • Make test fns created by *compile-tests* have names, so can find them in backtraces
  • fix misc compiler warnings
  • Fixed cases of duplicate test numbers
  • Disable note :make-condition-with-compound-name for openmcl.

In tests themselves:

I commented out the following tests with #+bogus-test, because they just seemed wrong to me:

lambda.47
lambda.50
upgraded-array-element-type.8
upgraded-array-element-type.nil.1
pathname-match-p.5
load.17
load.18
macrolet.47
ctypecase.15

In addition, I commented out the following tests with #+bogus-test because I was too lazy to make a note
for "doesn't signal underflow":

exp.error.8 exp.error.9 exp.error.10 exp.error.11 expt.error.8 expt.error.9 expt.error.10 expt.error.11

Finally, I entered bug reports in trac, and then commented out the tests
below with #+known-bug-NNN, where nnn is the ticket number in trac:

ticket#268: encode-universal-time.3 encode-universal-time.3.1
ticket#269: macrolet.36
ticket#270: values.20 values.21
ticket#271: defclass.error.13 defclass.error.22
ticket#272: phase.10 phase.12 asin.5 asin.6 asin.8
ticket#273: phase.18 phase.19 acos.8
ticket#274: exp.error.4 exp.error.5 exp.error.6 exp.error.7
ticket#275: car.error.2 cdr.error.2
ticket#276: map.error.11
ticket#277: subtypep.cons.43
ticket#278: subtypep-function.3
ticket#279: subtypep-complex.8
ticket#280: open.output.19 open.io.19 file-position.8 file-length.4 file-length.5 read-byte.4 stream-element-type.2 stream-element-type.3
ticket#281: open.65
ticket#288: set-syntax-from-char.sharp.1

File size: 10.0 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Feb 15 11:57:03 2003
4;;;; Contains: Tests for subtype relationships on cons types
5
6(in-package :cl-test)
7
8(compile-and-load "types-aux.lsp")
9
10;;; SUBTYPEP on CONS types
11
12(defvar *cons-types*
13  '(cons (cons) (cons *) (cons * *) (cons t) (cons t t)
14         (cons t *) (cons * t)))
15
16(deftest subtypep.cons.1
17  (loop for t1 in *cons-types*
18        append (loop for t2 in *cons-types*
19                     unless (equal (mapcar #'notnot
20                                           (multiple-value-list
21                                            (subtypep t1 t2)))
22                                   '(t t))
23                     collect (list t1 t2)))
24  nil)
25
26(deftest subtypep.cons.2
27  (loop for t1 in '((cons nil) (cons nil *) (cons nil t)
28                    (cons * nil) (cons t nil) (cons nil nil))
29        unless (subtypep t1 nil)
30        collect t1)
31  nil)
32
33(deftest subtypep.cons.3
34  (check-equivalence '(and (cons symbol *) (cons * symbol))
35                     '(cons symbol symbol))
36  nil)
37
38(deftest subtypep.cons.4
39  (check-equivalence '(and (cons (integer 0 10) *)
40                           (cons (integer 5 15) (integer 10 20))
41                           (cons * (integer 15 25)))
42                     '(cons (integer 5 10) (integer 15 20)))
43  nil)
44
45(deftest subtypep.cons.5
46  (check-equivalence
47   '(and cons (not (cons symbol symbol)))
48   '(or (cons (not symbol) *)
49        (cons * (not symbol))))
50  nil)
51
52(deftest subtypep.cons.6
53  (check-equivalence
54   '(or (cons integer symbol) (cons integer integer)
55        (cons symbol integer) (cons symbol symbol))
56   '(cons (or integer symbol) (or integer symbol)))
57  nil)
58
59(deftest subtypep.cons.7
60  (check-equivalence
61   '(or (cons (integer 0 8) (integer 5 15))
62        (cons (integer 0 7) (integer 0 6))
63        (cons (integer 6 15) (integer 0 9))
64        (cons (integer 3 15) (integer 4 15)))
65   '(cons (integer 0 15) (integer 0 15)))
66  nil)
67
68(deftest subtypep.cons.8
69  (check-equivalence
70   '(or
71     (cons integer (cons symbol integer))
72     (cons symbol (cons integer symbol))
73     (cons symbol (cons symbol integer))
74     (cons symbol (cons integer integer))
75     (cons integer (cons integer symbol))
76     (cons symbol (cons symbol symbol))
77     (cons integer (cons integer integer))
78     (cons integer (cons symbol symbol)))
79   '(cons (or symbol integer)
80          (cons (or symbol integer) (or symbol integer))))
81  nil)
82
83(deftest subtypep.cons.9
84  (check-equivalence
85   '(or
86     (cons (integer 0 (3)) (integer 0 (6)))
87     (cons (integer 3 (9)) (integer 0 (3)))
88     (cons (integer 0 (6)) (integer 6 (9)))
89     (cons (integer 6 (9)) (integer 3 (9)))
90     (cons (integer 3 (6)) (integer 3 (6))))
91   '(cons (integer 0 (9)) (integer 0 (9))))
92  nil)
93
94(deftest subtypep.cons.10
95  (check-equivalence
96   '(or
97     (cons (rational 0 (3)) (rational 0 (6)))
98     (cons (rational 3 (9)) (rational 0 (3)))
99     (cons (rational 0 (6)) (rational 6 (9)))
100     (cons (rational 6 (9)) (rational 3 (9)))
101     (cons (rational 3 (6)) (rational 3 (6))))
102   '(cons (rational 0 (9)) (rational 0 (9))))
103  nil)
104
105(deftest subtypep.cons.11
106  (check-equivalence
107   '(or
108     (cons (real 0 (3)) (real 0 (6)))
109     (cons (real 3 (9)) (real 0 (3)))
110     (cons (real 0 (6)) (real 6 (9)))
111     (cons (real 6 (9)) (real 3 (9)))
112     (cons (real 3 (6)) (real 3 (6))))
113   '(cons (real 0 (9)) (real 0 (9))))
114  nil)
115
116;;; Test suggested by C.R.
117(deftest subtypep.cons.12
118  (check-all-not-subtypep
119   '(cons (or integer symbol)
120          (or integer symbol))
121   '(or (cons integer symbol)
122        (cons symbol integer)))
123  nil)
124
125(deftest subtypep.cons.13
126  (check-all-not-subtypep '(not list) 'cons)
127  nil)
128
129
130;;; a -> b, a ==> b
131(deftest subtypep.cons.14
132  (check-all-subtypep
133   '(and (or (cons (not symbol)) (cons * integer))
134         (cons symbol))
135   '(cons * integer))
136  nil)
137
138;;; a -> b, not b ==> not a
139(deftest subtypep.cons.15
140  (check-all-subtypep
141   '(and (or (cons (not symbol)) (cons * integer))
142         (cons * (not integer)))
143   '(cons (not symbol)))
144  nil)
145
146;;; (and (or a b) (or (not b) c)) ==> (or a c)
147(deftest subtypep.cons.16
148  (check-all-subtypep
149   '(and (or (cons symbol (cons * *))
150             (cons * (cons integer *)))
151         (or (cons * (cons (not integer) *))
152             (cons * (cons * float))))
153   '(or (cons symbol (cons * *))
154        (cons * (cons * float))))
155  nil)
156
157(deftest subtypep.cons.17
158  (check-all-subtypep
159   '(and (or (cons symbol (cons * *))
160             (cons * (cons integer *)))
161         (or (cons * (cons (not integer)))
162             (cons * (cons * float)))
163         (or (cons * (cons * (not float)))
164             (cons symbol (cons * *))))
165   '(cons symbol))
166  nil)
167
168(deftest subtypep.cons.18
169  (check-all-subtypep
170   '(cons symbol)
171   '(or (cons symbol (not integer))
172        (cons * integer)))
173  nil)
174
175(deftest subtypep.cons.19
176  (check-equivalence
177   '(or
178     (cons (eql a) (eql x))
179     (cons (eql b) (eql y))
180     (cons (eql c) (eql z))
181     (cons (eql a) (eql y))
182     (cons (eql b) (eql z))
183     (cons (eql c) (eql x))
184     (cons (eql a) (eql z))
185     (cons (eql b) (eql x))
186     (cons (eql c) (eql y)))
187   '(cons (member a b c) (member x y z)))
188  nil)
189
190(deftest subtypep.cons.20
191  (check-equivalence
192   '(or
193     (cons (eql a) (eql x))
194     (cons (eql b) (eql y))
195     (cons (eql a) (eql y))
196     (cons (eql b) (eql z))
197     (cons (eql c) (eql x))
198     (cons (eql a) (eql z))
199     (cons (eql b) (eql x))
200     (cons (eql c) (eql y)))
201   '(and (cons (member a b c) (member x y z))
202         (not (cons (eql c) (eql z)))))
203  nil)
204
205;;; Test case that came up in SBCL
206(deftest subtypep.cons.21
207  (check-all-subtypep
208   '(cons integer single-float)
209   '(or (cons fixnum single-float) (cons bignum single-float)))
210  nil)
211
212(deftest subtypep.cons.22
213  (check-all-subtypep
214   '(cons single-float integer)
215   '(or (cons single-float fixnum) (cons single-float bignum)))
216  nil)
217
218;;; More test cases from SBCL, CMUCL, culled from random test failures
219
220(deftest subtype.cons.23
221  (let ((t1 '(cons t (cons (not long-float) symbol)))
222        (t2 '(not (cons symbol (cons integer integer)))))
223    (subtypep-and-contrapositive-are-consistent t1 t2))
224  t)
225
226(deftest subtype.cons.24
227  (let ((t1 '(cons (eql 3671) (cons short-float (eql -663423073525))))
228        (t2 '(not (cons t (cons (not complex) (cons integer t))))))
229    (subtypep-and-contrapositive-are-consistent t1 t2))
230  t)
231
232(deftest subtype.cons.25
233  (let ((t1 '(cons t (cons (not long-float) (integer 44745969 61634129))))
234        (t2 '(not (cons (eql -3) (cons short-float (cons t float))))))
235    (subtypep-and-contrapositive-are-consistent t1 t2))
236  t)
237
238(deftest subtype.cons.26
239  (let ((t1 '(cons integer (cons single-float (cons t t))))
240        (t2 '(cons t (cons (not complex) (not (eql 8))))))
241    (subtypep-and-contrapositive-are-consistent t1 t2))
242  t)
243
244(deftest subtype.cons.27
245  (let ((t1 '(cons (not (integer -27 30))
246                   (cons rational (cons integer integer))))
247        (t2 '(not (cons integer (cons integer (eql 378132631))))))
248    (subtypep-and-contrapositive-are-consistent t1 t2))
249  t)
250
251(deftest subtype.cons.28
252  (let ((t1 '(cons (integer -1696888 -1460338)
253                   (cons single-float symbol)))
254        (t2 '(not (cons (not (integer -14 20))
255                        (cons (not integer) cons)))))
256    (subtypep-and-contrapositive-are-consistent t1 t2))
257  t)
258
259(deftest subtypep.cons.29
260  (let ((t2 '(or (not (cons unsigned-byte cons))
261                 (not (cons (integer -6 22) rational)))))
262    (subtypep-and-contrapositive-are-consistent 'cons t2))
263  t)
264
265(deftest subtypep.cons.30
266  (let ((t1 '(not (cons t (cons t (cons cons t)))))
267        (t2 '(or (or (cons (cons t integer) t)
268                     (not (cons t (cons t cons))))
269                 (not (cons (cons (eql -27111309) t)
270                            (cons t (eql 1140730)))))))
271    (subtypep-and-contrapositive-are-consistent t1 t2))
272  t)
273
274(deftest subtypep.cons.31
275  (let ((t2 '(or
276              (not
277               (cons (or (cons t ratio) (cons short-float t))
278                     (cons (cons (eql -7418623) (integer -9 53))
279                           (cons cons t))))
280              (not
281               (cons (cons t (eql -265039))
282                     (cons (cons t cons) t))))))
283    (subtypep-and-contrapositive-are-consistent 'cons t2))
284  t)
285
286(deftest subtypep.cons.32
287  (let ((t2 '(cons t
288                   (or (not (cons integer (eql 0)))
289                       (not (cons (or float (eql 0)) cons))))))
290    (subtypep-and-contrapositive-are-consistent 'cons t2))
291  t)
292
293(deftest subtypep.cons.33
294  (let ((t2 '(or (not (cons (cons t cons) (cons t (cons unsigned-byte t))))
295                 (not (cons (cons integer t) (cons t (cons cons t)))))))
296    (subtypep-and-contrapositive-are-consistent 'cons t2))
297  t)
298
299(deftest subtypep.cons.34
300  (let ((t2 '(or (not (cons (or (eql 0) ratio) (not cons)))
301                 (not (cons integer cons)))))
302    (subtypep-and-contrapositive-are-consistent 'cons t2))
303  t)
304
305(deftest subtypep.cons.35
306  (notnot-mv (subtypep '(cons nil t) 'float))
307  t t)
308
309(deftest subtypep.cons.36
310  (notnot-mv (subtypep '(cons t nil) 'symbol))
311  t t)
312
313(deftest subtypep.cons.37
314  (notnot-mv (subtypep '(cons nil nil) 'real))
315  t t)
316
317(deftest subtypep.cons.38
318  (let ((t1 '(cons t (complex (real -32 0))))
319        (t2 `(not (cons t (complex (integer * -500))))))
320    (subtypep-and-contrapositive-are-consistent t1 t2))
321  t)
322
323;;; From GCL
324
325(deftest subtypep.cons.39
326  (values (subtypep t '(and (not (cons cons (cons cons t))) (not (cons t cons)))))
327  nil)
328
329(deftest subtypep.cons.40
330  (let ((type1 '(cons (eql 0) cons))
331        (type2 '(cons unsigned-byte symbol)))
332    (values
333     (subtypep* type1 type2)
334     (subtypep* `(not ,type2) `(not ,type1))))
335  nil nil)
336
337;;; From sbcl 0.9.5.31
338
339(deftest subtypep.cons.41
340  (let ((type1 '(cons t (complex (real -10 -4))))
341        (type2 '(not (cons t (complex (integer -200 -100))))))
342    (multiple-value-bind (sub1 success1)
343        (subtypep* type1 type2)
344      (multiple-value-bind (sub2 success2)
345          (subtypep* `(not ,type2) `(not ,type1))
346        (if (and success1 success2 (not (eq sub1 sub2)))
347            (values sub1 sub2)
348            nil))))
349  nil)
350
351(deftest subtypep.cons.42
352    (let ((t1 '(cons (cons (cons (real -744833699 -744833699) cons) (integer -234496 215373))
353                integer))
354          (t2 '(cons (cons (cons integer integer) (integer -234496 215373)) t)))
355      (values (subtypep `(not ,t2) `(not ,t1))))
356  nil)
357
358;;;; From sbcl 0.9.6.57
359
360#+known-bug-277
361(deftest subtypep.cons.43
362  (let* ((n -3.926510009989861d7)
363         (t1 '(not (cons float t)))
364         (t2 `(or (not (cons (eql 0) (real ,n ,n)))
365                  (not (cons t (eql 0))))))
366    (multiple-value-bind
367     (sub1 good1)
368     (subtypep* t1 t2)
369     (multiple-value-bind
370      (sub2 good2)
371      (subtypep* `(not ,t2) `(not ,t1))
372      (or (not good1)
373          (not good2)
374          (and sub1 sub2)
375          (and (not sub1) (not sub2))))))
376  t)
377
Note: See TracBrowser for help on using the repository browser.