Commit 1632d2b7 authored by pfdietz's avatar pfdietz

Added more tests of subtypep on (and ...), (or ...) types.

parent 646a9e93
......@@ -676,6 +676,15 @@ the condition to go uncaught if it cannot be classified."
(restart)
(readtable)))
(defparameter *types-list3*
(reduce #'append *disjoint-types-list2* :from-end t))
(defun trim-list (list n)
(let ((len (length list)))
(if (<= len n) list
(append (subseq list 0 n)
(format nil "And ~A more omitted." (- len n))))))
(defun is-t-or-nil (e)
(or (eqt e t) (eqt e nil)))
......
......@@ -132,17 +132,13 @@
nil)
(deftest subtypep.and.1
(loop
for typelist in *disjoint-types-list2*
append (loop for type in typelist
append (check-equivalence `(and ,type ,type) type)))
(loop for type in *types-list3*
append (check-equivalence `(and ,type ,type) type))
nil)
(deftest subtypep.or.1
(loop
for typelist in *disjoint-types-list2*
append (loop for type in typelist
append (check-equivalence `(or ,type ,type) type)))
(loop for type in *types-list3*
append (check-equivalence `(or ,type ,type) type))
nil)
(deftest subtypep.and.2
......@@ -152,3 +148,38 @@
(deftest subtypep.or.2
(check-equivalence nil '(or))
nil)
(deftest subtypep.and.3
(loop for type in *types-list3*
append (check-equivalence `(and ,type) type))
nil)
(deftest subtypep.or.3
(loop for type in *types-list3*
append (check-equivalence `(or ,type) type))
nil)
(deftest subtypep.and.4
(let* ((n (length *types-list3*))
(a (make-array n :initial-contents *types-list3*)))
(trim-list
(loop for i below 1000
for tp1 = (aref a (random n))
for tp2 = (aref a (random n))
append (check-equivalence `(and ,tp1 ,tp2)
`(and ,tp2 ,tp1)))
100))
nil)
(deftest subtypep.or.4
(let* ((n (length *types-list3*))
(a (make-array n :initial-contents *types-list3*)))
(trim-list
(loop for i below 1000
for tp1 = (aref a (random n))
for tp2 = (aref a (random n))
append (check-equivalence `(or ,tp1 ,tp2)
`(or ,tp2 ,tp1)))
100))
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