← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ansi-tests/subtypep-cons.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/subtypep-cons.lsp
 
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