Commit fa2e43e9 authored by pfdietz's avatar pfdietz
Browse files

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
...@@ -177,6 +177,17 @@ Results: ~A~%" expected-number form n results)))) ...@@ -177,6 +177,17 @@ Results: ~A~%" expected-number form n results))))
(check-subtypep t `(or (not ,type2) ,type1) t) (check-subtypep t `(or (not ,type2) ,type1) t)
(check-subtypep t `(or (not ,type1) ,type2) 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) (defun check-subtypep (type1 type2 is-sub &optional should-be-valid)
(multiple-value-bind (multiple-value-bind
......
...@@ -318,6 +318,30 @@ ...@@ -318,6 +318,30 @@
collect (list int-type real-type))) collect (list int-type real-type)))
nil) 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 ;;; Between integer and rational types
......
...@@ -8,69 +8,69 @@ ...@@ -8,69 +8,69 @@
;;; SUBTYPEP on MEMBER types ;;; SUBTYPEP on MEMBER types
(deftest subtypep.member.1 (deftest subtypep.member.1
(subtypep*-or-fail '(member a b c) '(member a b c d)) (check-all-subtypep '(member a b c) '(member a b c d))
t) nil)
(deftest subtypep.member.2 (deftest subtypep.member.2
(subtypep*-not-or-fail '(member a b c) '(member a b)) (check-all-not-subtypep '(member a b c) '(member a b))
t) nil)
(deftest subtypep.member.3 (deftest subtypep.member.3
(check-equivalence '(member) nil) (check-equivalence '(member) nil)
nil) nil)
(deftest subtypep.member.4 (deftest subtypep.member.4
(subtypep*-or-fail '(eql b) '(member a b c)) (check-all-subtypep '(eql b) '(member a b c))
t) nil)
(deftest subtypep.member.5 (deftest subtypep.member.5
(subtypep*-or-fail '(member a b c d e) 'symbol) (check-all-subtypep '(member a b c d e) 'symbol)
t) nil)
(deftest subtypep.member.6 (deftest subtypep.member.6
(subtypep*-not-or-fail '(member a b 10 d e) 'symbol) (check-all-not-subtypep '(member a b 10 d e) 'symbol)
t) nil)
(deftest subtypep.member.7 (deftest subtypep.member.7
(subtypep*-or-fail 'null '(member a b nil c d e)) (check-all-subtypep 'null '(member a b nil c d e))
t) nil)
(deftest subtypep.member.8 (deftest subtypep.member.8
(subtypep*-not-or-fail 'null '(member a b c d e)) (check-all-not-subtypep 'null '(member a b c d e))
t) nil)
(deftest subtypep.member.9 (deftest subtypep.member.9
(let ((b1 (1+ most-positive-fixnum)) (let ((b1 (1+ most-positive-fixnum))
(b2 (1+ most-positive-fixnum))) (b2 (1+ most-positive-fixnum)))
(subtypep*-or-fail `(member 10 ,b1 20) `(member 10 20 ,b2))) (check-all-subtypep `(member 10 ,b1 20) `(member 10 20 ,b2)))
t) nil)
(deftest subtypep.member.10 (deftest subtypep.member.10
(subtypep*-or-fail '(member :a :b :c) 'keyword) (check-all-subtypep '(member :a :b :c) 'keyword)
t) nil)
(deftest subtypep.member.11 (deftest subtypep.member.11
(let ((b1 (copy-list '(a))) (let ((b1 (copy-list '(a)))
(b2 (copy-list '(a)))) (b2 (copy-list '(a))))
(subtypep*-not-or-fail `(member 10 ,b1 20) `(member 10 20 ,b2))) (check-all-not-subtypep `(member 10 ,b1 20) `(member 10 20 ,b2)))
t) nil)
(deftest subtypep.member.12 (deftest subtypep.member.12
(let ((b1 '(a))) (let ((b1 '(a)))
(subtypep*-or-fail `(member 10 ,b1 20) `(member 10 20 ,b1))) (check-all-subtypep `(member 10 ,b1 20) `(member 10 20 ,b1)))
t) nil)
(deftest subtypep.member.13 (deftest subtypep.member.13
(subtypep*-or-fail '(member 10 20 30) '(integer 0 100)) (check-all-subtypep '(member 10 20 30) '(integer 0 100))
t) nil)
(deftest subtypep.member.14 (deftest subtypep.member.14
(subtypep*-or-fail '(integer 3 6) '(member 0 1 2 3 4 5 6 7 8 100)) (check-all-subtypep '(integer 3 6) '(member 0 1 2 3 4 5 6 7 8 100))
t) nil)
(deftest subtypep.member.15 (deftest subtypep.member.15
(subtypep*-not-or-fail '(integer 3 6) '(member 0 1 2 3 5 6 7 8)) (check-all-not-subtypep '(integer 3 6) '(member 0 1 2 3 5 6 7 8))
t) nil)
(deftest subtypep.member.16 (deftest subtypep.member.16
(check-equivalence '(integer 2 5) '(member 2 5 4 3)) (check-equivalence '(integer 2 5) '(member 2 5 4 3))
......
...@@ -164,10 +164,10 @@ ...@@ -164,10 +164,10 @@
nil) nil)
(deftest subtypep.rational.17 (deftest subtypep.rational.17
(subtypep*-or-fail '(not (rational -1/2 1/2)) '(not (integer 0 0))) (check-all-subtypep '(not (rational -1/2 1/2)) '(not (integer 0 0)))
t) nil)
(deftest subtypep.rational.18 (deftest subtypep.rational.18
(subtypep*-or-fail '(not (rational -1/2 1/2)) '(not (eql 0))) (check-all-subtypep '(not (rational -1/2 1/2)) '(not (eql 0)))
t) nil)
...@@ -185,13 +185,10 @@ ...@@ -185,13 +185,10 @@
'(rational (1/11) (8/37))) '(rational (1/11) (8/37)))
nil) nil)
(deftest subtypep.rational.23 (deftest subtypep.real.23
(subtypep*-or-fail '(not (real -1/2 1/2)) '(not (integer 0 0))) (check-all-subtypep '(not (real -1/2 1/2)) '(not (integer 0 0)))
t) nil)
(deftest subtypep.rational.24
(subtypep*-or-fail '(not (real -1/2 1/2)) '(not (eql 0)))
t)
(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