Commit fcdda08a authored by pfdietz's avatar pfdietz

More subtypep and disjointness tests.

parent 548a16dc
......@@ -148,6 +148,14 @@ Results: ~A~%" expected-number form n results))))
(check-subtypep type2 `(not ,type1) t)
(check-subtypep `(and ,type1 ,type2) nil t)
(check-subtypep `(and ,type2 ,type1) nil t)
(check-subtypep `(and ,type1 (not ,type2)) type1 t)
(check-subtypep `(and (not ,type2) ,type1) type1 t)
(check-subtypep `(and ,type2 (not ,type1)) type2 t)
(check-subtypep `(and (not ,type1) ,type2) type2 t)
(check-subtypep type1 `(or ,type1 (not ,type2)) t)
(check-subtypep type1 `(or (not ,type2) ,type1) t)
(check-subtypep type2 `(or ,type2 (not ,type1)) t)
(check-subtypep type2 `(or (not ,type1) ,type2) t)
)))
(defun check-subtypep (type1 type2 is-sub &optional should-be-valid)
......@@ -621,12 +629,12 @@ the condition to go uncaught if it cannot be classified."
(defun types-6-body ()
(loop
for p in *subtype-table* count
(let ((tp (car p)))
(when (and (not (member tp '(sequence cons list t)))
(not (subtypep* tp 'atom)))
(format t "~%Problem! Did not find to be an atomic type: ~S" tp)
t))))
for p in *subtype-table*
for tp = (car p)
append
(and (not (member tp '(sequence cons list t)))
(let ((message (check-subtypep tp 'atom t t)))
(if message (list message))))))
(defparameter *type-list* nil)
(defparameter *supertype-table* nil)
......
......@@ -31,17 +31,19 @@
(deftest types-3
(count-if
#'(lambda (pair)
(let ((t1 (first pair))
(t2 (second pair)))
(cond
((not (subtypep* t1 t2))
(format t "~%Problem! Did not find ~S to be a subtype of ~S" t1 t2)
t)
(t nil))))
*subtype-table*)
0)
(loop
for (t1 t2) in *subtype-table*
for m1 = (check-subtypep t1 t2 t t)
for m2 = (check-subtypep `(and ,t1 ,t2) t1 t)
for m3 = (check-subtypep `(and ,t2 ,t1) t1 t)
for m4 = (check-subtypep `(and ,t1 (not ,t2)) nil t)
for m5 = (check-subtypep `(and (not ,t2) ,t1) nil t)
when m1 collect m1
when m2 collect m2
when m3 collect m3
when m4 collect m4
when m5 collect m5)
nil)
(declaim (special +float-types+ *subtype-table*))
......@@ -89,13 +91,13 @@
))
(deftest types-4
(types-4-body)
(types-4-body)
0)
|#
(deftest types-6
(types-6-body)
0)
(types-6-body)
nil)
(declaim (special *disjoint-types-list*))
......@@ -194,6 +196,14 @@
(check-disjointness 'integer 'ratio)
nil)
(deftest bignum-and-ratio-are-disjoint
(check-disjointness 'bignum 'ratio)
nil)
(deftest bignum-and-fixnum-are-disjoint
(check-disjointness 'bignum 'fixnum)
nil)
(deftest fixnum-and-ratio-are-disjoint
(check-disjointness 'fixnum 'ratio)
nil)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment