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).
37 (let ((standard-types '(;; from table 4-2 in section 4.2.3 in the
45 ;; so it might seem easy to change the HAIRY
46 ;; :UNPARSE method to recognize that (NOT
47 ;; CONS) should unparse as ATOM. However, we
48 ;; then lose the nice (SUBTYPEP '(NOT ATOM)
49 ;; 'CONS) => T,T behaviour that we get from
50 ;; simplifying (NOT ATOM) -> (NOT (NOT CONS))
51 ;; -> CONS. So, for now, we leave this
77 standard-generic-function
120 ;; This one's hard: (AND BASE-CHAR (NOT BASE-CHAR))
122 ;; This is because it looks like
123 ;; (AND CHARACTER (NOT BASE-CHAR))
124 ;; but CHARACTER is equivalent to
125 ;; BASE-CHAR. So if we fix intersection of
126 ;; obviously disjoint types and then do (the
127 ;; extended-char foo), we'll get back FOO is
128 ;; not a NIL. -- CSR, 2002-09-16.
145 floating-point-inexact
148 floating-point-invalid-operation
151 floating-point-overflow
153 floating-point-underflow
155 (dolist (type standard-types)
156 (format t "~&~S~%" type)
157 (assert (not (sb-kernel:unknown-type-p (sb-kernel:specifier-type type))))
158 (assert (atom (sb-kernel:type-specifier (sb-kernel:specifier-type type))))))
160 ;;; a bug underlying the reported bug #221: The SB-KERNEL type code
161 ;;; signalled an error on this expression.
162 (subtypep '(function (fixnum) (values package boolean))
163 '(function (t) (values package boolean)))
165 ;;; bug reported by Valtteri Vuorik
166 (compile nil '(lambda () (member (char "foo" 0) '(#\. #\/) :test #'char=)))
167 (assert (not (equal (multiple-value-list
168 (subtypep '(function ()) '(function (&rest t))))
171 (assert (not (equal (multiple-value-list
172 (subtypep '(function (&rest t)) '(function ())))
175 (assert (subtypep '(function)
176 '(function (&optional * &rest t))))
177 (assert (equal (multiple-value-list
178 (subtypep '(function)
179 '(function (t &rest t))))
182 (assert (and (subtypep 'function '(function))
183 (subtypep '(function) 'function)))