X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ftype.pure.lisp;h=1bd07f4aaf55384601e1529825830bf82180a9ac;hb=25c9bfeaaf0597e37271dde31eed7037dba391e0;hp=a2c63ffeaba21874c31fdfedb9ef1c7586ad2f57;hpb=f0670f28705c01e79fb23cb2a582074d3e51ec98;p=sbcl.git diff --git a/tests/type.pure.lisp b/tests/type.pure.lisp index a2c63ff..1bd07f4 100644 --- a/tests/type.pure.lisp +++ b/tests/type.pure.lisp @@ -27,4 +27,195 @@ (12 (or null vector) nil) (12 (and (or number vector) real) t)))) - \ No newline at end of file + +;;; This test is motivated by bug #195, which previously had (THE REAL +;;; #(1 2 3)) give an error which prints as "This is not a (OR +;;; SINGLE-FLOAT DOUBLE-FLOAT RATIONAL)". We ideally want all of the +;;; defined-by-ANSI types to unparse as themselves or at least +;;; something similar (e.g. CHARACTER can unparse to BASE-CHAR, since +;;; the types are equivalent in current SBCL, and EXTENDED-CHAR can +;;; unparse to NIL, since there are no EXTENDED-CHARs currently). +(let ((standard-types '(;; from table 4-2 in section 4.2.3 in the + ;; CLHS. + arithmetic-error + function + simple-condition + array + generic-function + simple-error + atom + hash-table + simple-string + base-char + integer + simple-type-error + base-string + keyword + simple-vector + bignum + list + simple-warning + bit + logical-pathname + single-float + bit-vector + long-float + standard-char + broadcast-stream + method + standard-class + built-in-class + method-combination + standard-generic-function + cell-error + nil + standard-method + character + null + standard-object + class + number + storage-condition + compiled-function + package + stream + complex + package-error + stream-error + concatenated-stream + parse-error + string + condition + pathname + string-stream + cons + print-not-readable + structure-class + control-error + program-error + structure-object + division-by-zero + random-state + style-warning + double-float + ratio + symbol + echo-stream + rational + synonym-stream + end-of-file + reader-error + t + error + readtable + two-way-stream + extended-char + real + type-error + file-error + restart + unbound-slot + file-stream + sequence + unbound-variable + fixnum + serious-condition + undefined-function + float + short-float + unsigned-byte + floating-point-inexact + signed-byte + vector + floating-point-invalid-operation + simple-array + warning + floating-point-overflow + simple-base-string + floating-point-underflow + simple-bit-vector))) + (dolist (type standard-types) + (format t "~&~S~%" type) + (assert (not (sb-kernel:unknown-type-p (sb-kernel:specifier-type type)))) + (assert (atom (sb-kernel:type-specifier (sb-kernel:specifier-type type)))))) + +;;; a bug underlying the reported bug #221: The SB-KERNEL type code +;;; signalled an error on this expression. +(subtypep '(function (fixnum) (values package boolean)) + '(function (t) (values package boolean))) + +;;; bug reported by Valtteri Vuorik +(compile nil '(lambda () (member (char "foo" 0) '(#\. #\/) :test #'char=))) +(assert (not (equal (multiple-value-list + (subtypep '(function ()) '(function (&rest t)))) + '(nil t)))) + +(assert (not (equal (multiple-value-list + (subtypep '(function (&rest t)) '(function ()))) + '(t t)))) + +(assert (subtypep '(function) + '(function (&optional * &rest t)))) +(assert (equal (multiple-value-list + (subtypep '(function) + '(function (t &rest t)))) + '(nil t))) +(assert (and (subtypep 'function '(function)) + (subtypep '(function) 'function))) + +;;; Absent any exciting generalizations of |R, the type RATIONAL is +;;; partitioned by RATIO and INTEGER. Ensure that the type system +;;; knows about this. [ the type system is permitted to return NIL, +;;; NIL for these, so if future maintenance breaks these tests that +;;; way, that's fine. What the SUBTYPEP calls are _not_ allowed to +;;; return is NIL, T, because that's completely wrong. ] +(assert (subtypep '(or integer ratio) 'rational)) +(assert (subtypep 'rational '(or integer ratio))) +;;; Likewise, these are allowed to return NIL, NIL, but shouldn't +;;; return NIL, T: +(assert (subtypep t '(or real (not real)))) +(assert (subtypep t '(or keyword (not keyword)))) +(assert (subtypep '(and cons (not (cons symbol integer))) + '(or (cons (not symbol) *) (cons * (not integer))))) +(assert (subtypep '(or (cons (not symbol) *) (cons * (not integer))) + '(and cons (not (cons symbol integer))))) +(assert (subtypep '(or (eql 0) (rational (0) 10)) + '(rational 0 10))) +(assert (subtypep '(rational 0 10) + '(or (eql 0) (rational (0) 10)))) +;;; Until sbcl-0.7.13.7, union of CONS types when the CDRs were the +;;; same type gave exceedingly wrong results +(assert (null (subtypep '(or (cons fixnum single-float) + (cons bignum single-float)) + '(cons single-float single-float)))) +(assert (subtypep '(cons integer single-float) + '(or (cons fixnum single-float) (cons bignum single-float)))) + +(assert (not (nth-value 1 (subtypep '(and null some-unknown-type) + 'another-unknown-type)))) + +;;; bug 46c +(dolist (fun '(and if)) + (assert (raises-error? (coerce fun 'function) type-error))) + +(dotimes (i 100) + (let ((x (make-array 0 :element-type `(unsigned-byte ,(1+ i))))) + (eval `(typep ,x (class-of ,x))))) + +(assert (not (typep #c(1 2) '(member #c(2 1))))) +(assert (typep #c(1 2) '(member #c(1 2)))) +(assert (subtypep 'nil '(complex nil))) +(assert (subtypep '(complex nil) 'nil)) +(assert (subtypep 'nil '(complex (eql 0)))) +(assert (subtypep '(complex (eql 0)) 'nil)) +(assert (subtypep 'nil '(complex (integer 0 0)))) +(assert (subtypep '(complex (integer 0 0)) 'nil)) +(assert (subtypep 'nil '(complex (rational 0 0)))) +(assert (subtypep '(complex (rational 0 0)) 'nil)) +(assert (subtypep 'complex '(complex real))) +(assert (subtypep '(complex real) 'complex)) +(assert (subtypep '(complex (eql 1)) '(complex (member 1 2)))) +(assert (equal (multiple-value-list + (subtypep '(complex (integer 1 2)) + '(member #c(1 1) #c(1 2) #c(2 1) #c(2 2)))) + '(nil t)))