1 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; While most of SBCL is derived from the CMU CL system, the test
5 ;;;; files (like this one) were written from scratch after the fork
8 ;;;; This software is in the public domain and is provided with
9 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
10 ;;;; more information.
12 (in-package "CL-USER")
15 (declare (notinline mapcar))
16 (mapcar (lambda (args)
17 (destructuring-bind (obj type-spec result) args
18 (flet ((matches-result? (x)
19 (eq (if x t nil) result)))
20 (assert (matches-result? (typep obj type-spec)))
21 (assert (matches-result? (sb-kernel:ctypep
23 (sb-kernel:specifier-type
25 '((nil (or null vector) t)
26 (nil (or number vector) nil)
27 (12 (or null vector) nil)
28 (12 (and (or number vector) real) t))))
31 ;;; This test is motivated by bug #195, which previously had (THE REAL
32 ;;; #(1 2 3)) give an error which prints as "This is not a (OR
33 ;;; SINGLE-FLOAT DOUBLE-FLOAT RATIONAL)". We ideally want all of the
34 ;;; defined-by-ANSI types to unparse as themselves or at least
35 ;;; something similar (e.g. CHARACTER can unparse to BASE-CHAR, since
36 ;;; the types are equivalent in current SBCL, and EXTENDED-CHAR can
37 ;;; unparse to NIL, since there are no EXTENDED-CHARs currently).
38 (let ((standard-types '(;; from table 4-2 in section 4.2.3 in the
69 standard-generic-function
127 floating-point-inexact
130 floating-point-invalid-operation
133 floating-point-overflow
135 floating-point-underflow
137 (dolist (type standard-types)
138 (format t "~&~S~%" type)
139 (assert (not (sb-kernel:unknown-type-p (sb-kernel:specifier-type type))))
140 (assert (atom (sb-kernel:type-specifier (sb-kernel:specifier-type type))))))
142 ;;; a bug underlying the reported bug #221: The SB-KERNEL type code
143 ;;; signalled an error on this expression.
144 (subtypep '(function (fixnum) (values package boolean))
145 '(function (t) (values package boolean)))
147 ;;; bug reported by Valtteri Vuorik
148 (compile nil '(lambda () (member (char "foo" 0) '(#\. #\/) :test #'char=)))
149 (assert (not (equal (multiple-value-list
150 (subtypep '(function ()) '(function (&rest t))))
153 (assert (not (equal (multiple-value-list
154 (subtypep '(function (&rest t)) '(function ())))
157 (assert (subtypep '(function)
158 '(function (&optional * &rest t))))
159 (assert (equal (multiple-value-list
160 (subtypep '(function)
161 '(function (t &rest t))))
163 (assert (and (subtypep 'function '(function))
164 (subtypep '(function) 'function)))
166 ;;; Absent any exciting generalizations of |R, the type RATIONAL is
167 ;;; partitioned by RATIO and INTEGER. Ensure that the type system
168 ;;; knows about this. [ the type system is permitted to return NIL,
169 ;;; NIL for these, so if future maintenance breaks these tests that
170 ;;; way, that's fine. What the SUBTYPEP calls are _not_ allowed to
171 ;;; return is NIL, T, because that's completely wrong. ]
172 (assert (subtypep '(or integer ratio) 'rational))
173 (assert (subtypep 'rational '(or integer ratio)))
174 ;;; Likewise, these are allowed to return NIL, NIL, but shouldn't
176 (assert (subtypep t '(or real (not real))))
177 (assert (subtypep t '(or keyword (not keyword))))
178 (assert (subtypep '(and cons (not (cons symbol integer)))
179 '(or (cons (not symbol) *) (cons * (not integer)))))
180 (assert (subtypep '(or (cons (not symbol) *) (cons * (not integer)))
181 '(and cons (not (cons symbol integer)))))
182 (assert (subtypep '(or (eql 0) (rational (0) 10))
184 (assert (subtypep '(rational 0 10)
185 '(or (eql 0) (rational (0) 10))))
186 ;;; Until sbcl-0.7.13.7, union of CONS types when the CDRs were the
187 ;;; same type gave exceedingly wrong results
188 (assert (null (subtypep '(or (cons fixnum single-float)
189 (cons bignum single-float))
190 '(cons single-float single-float))))
191 (assert (subtypep '(cons integer single-float)
192 '(or (cons fixnum single-float) (cons bignum single-float))))
194 (assert (not (nth-value 1 (subtypep '(and null some-unknown-type)
195 'another-unknown-type))))
198 (dolist (fun '(and if))
199 (assert (raises-error? (coerce fun 'function) type-error)))
202 (let ((x (make-array 0 :element-type `(unsigned-byte ,(1+ i)))))
203 (eval `(typep ,x (class-of ,x)))))