Commit fa2e43e9 authored by pfdietz's avatar pfdietz

Replaced subtypep*-or-fail and subtypep*-not-or-fail with the

more powerful tests check-all-subtypep and check-all-not-subtypep,
which test a number of relations that can be derived from the
subtype (or, not-subtype) relation of the two types.
Also, fix a place where test names weren't changed during cut/paste.
parent c5d14dc7
......@@ -176,7 +176,18 @@ Results: ~A~%" expected-number form n results))))
(check-subtypep t `(or ,type2 (not ,type1)) t)
(check-subtypep t `(or (not ,type2) ,type1) t)
(check-subtypep t `(or (not ,type1) ,type2) t)))
(defun check-all-subtypep (type1 type2)
(append
(check-subtypep type1 type2 t)
(check-subtypep `(not ,type2) `(not ,type1) t)
(check-subtypep `(and ,type1 (not ,type2)) nil t)
(check-subtypep t `(or (not ,type1) ,type2) t)))
(defun check-all-not-subtypep (type1 type2)
(append
(check-subtypep type1 type2 nil)
(check-subtypep `(not ,type2) `(not ,type1) nil)))
(defun check-subtypep (type1 type2 is-sub &optional should-be-valid)
(multiple-value-bind
......
......@@ -318,6 +318,30 @@
collect (list int-type real-type)))
nil)
(deftest subtypep.integer.real.8
(check-equivalence
'(and (integer 4) (real * 10))
'(integer 4 10))
nil)
(deftest subtypep.integer.real.9
(check-equivalence
'(and (integer * 10) (real 4))
'(integer 4 10))
nil)
(deftest subtypep.integer.real.10
(check-equivalence
'(and (integer 4) (real * (10)))
'(integer 4 9))
nil)
(deftest subtypep.integer.real.11
(check-equivalence
'(and (integer * 10) (real (4)))
'(integer 5 10))
nil)
;;; Between integer and rational types
......
......@@ -8,69 +8,69 @@
;;; SUBTYPEP on MEMBER types
(deftest subtypep.member.1
(subtypep*-or-fail '(member a b c) '(member a b c d))
t)
(check-all-subtypep '(member a b c) '(member a b c d))
nil)
(deftest subtypep.member.2
(subtypep*-not-or-fail '(member a b c) '(member a b))
t)
(check-all-not-subtypep '(member a b c) '(member a b))
nil)
(deftest subtypep.member.3
(check-equivalence '(member) nil)
nil)
(deftest subtypep.member.4
(subtypep*-or-fail '(eql b) '(member a b c))
t)
(check-all-subtypep '(eql b) '(member a b c))
nil)
(deftest subtypep.member.5
(subtypep*-or-fail '(member a b c d e) 'symbol)
t)
(check-all-subtypep '(member a b c d e) 'symbol)
nil)
(deftest subtypep.member.6
(subtypep*-not-or-fail '(member a b 10 d e) 'symbol)
t)
(check-all-not-subtypep '(member a b 10 d e) 'symbol)
nil)
(deftest subtypep.member.7
(subtypep*-or-fail 'null '(member a b nil c d e))
t)
(check-all-subtypep 'null '(member a b nil c d e))
nil)
(deftest subtypep.member.8
(subtypep*-not-or-fail 'null '(member a b c d e))
t)
(check-all-not-subtypep 'null '(member a b c d e))
nil)
(deftest subtypep.member.9
(let ((b1 (1+ most-positive-fixnum))
(b2 (1+ most-positive-fixnum)))
(subtypep*-or-fail `(member 10 ,b1 20) `(member 10 20 ,b2)))
t)
(check-all-subtypep `(member 10 ,b1 20) `(member 10 20 ,b2)))
nil)
(deftest subtypep.member.10
(subtypep*-or-fail '(member :a :b :c) 'keyword)
t)
(check-all-subtypep '(member :a :b :c) 'keyword)
nil)
(deftest subtypep.member.11
(let ((b1 (copy-list '(a)))
(b2 (copy-list '(a))))
(subtypep*-not-or-fail `(member 10 ,b1 20) `(member 10 20 ,b2)))
t)
(check-all-not-subtypep `(member 10 ,b1 20) `(member 10 20 ,b2)))
nil)
(deftest subtypep.member.12
(let ((b1 '(a)))
(subtypep*-or-fail `(member 10 ,b1 20) `(member 10 20 ,b1)))
t)
(check-all-subtypep `(member 10 ,b1 20) `(member 10 20 ,b1)))
nil)
(deftest subtypep.member.13
(subtypep*-or-fail '(member 10 20 30) '(integer 0 100))
t)
(check-all-subtypep '(member 10 20 30) '(integer 0 100))
nil)
(deftest subtypep.member.14
(subtypep*-or-fail '(integer 3 6) '(member 0 1 2 3 4 5 6 7 8 100))
t)
(check-all-subtypep '(integer 3 6) '(member 0 1 2 3 4 5 6 7 8 100))
nil)
(deftest subtypep.member.15
(subtypep*-not-or-fail '(integer 3 6) '(member 0 1 2 3 5 6 7 8))
t)
(check-all-not-subtypep '(integer 3 6) '(member 0 1 2 3 5 6 7 8))
nil)
(deftest subtypep.member.16
(check-equivalence '(integer 2 5) '(member 2 5 4 3))
......
......@@ -164,10 +164,10 @@
nil)
(deftest subtypep.rational.17
(subtypep*-or-fail '(not (rational -1/2 1/2)) '(not (integer 0 0)))
t)
(check-all-subtypep '(not (rational -1/2 1/2)) '(not (integer 0 0)))
nil)
(deftest subtypep.rational.18
(subtypep*-or-fail '(not (rational -1/2 1/2)) '(not (eql 0)))
t)
(check-all-subtypep '(not (rational -1/2 1/2)) '(not (eql 0)))
nil)
......@@ -185,13 +185,10 @@
'(rational (1/11) (8/37)))
nil)
(deftest subtypep.rational.23
(subtypep*-or-fail '(not (real -1/2 1/2)) '(not (integer 0 0)))
t)
(deftest subtypep.rational.24
(subtypep*-or-fail '(not (real -1/2 1/2)) '(not (eql 0)))
t)
(deftest subtypep.real.23
(check-all-subtypep '(not (real -1/2 1/2)) '(not (integer 0 0)))
nil)
(deftest subtypep.real.24
(check-all-subtypep '(not (real -1/2 1/2)) '(not (eql 0)))
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