Commit 6571fe75 authored by pfdietz's avatar pfdietz

Added more disjointness tests; tweaked check-disjointness.

parent bee3f982
......@@ -153,20 +153,14 @@ Results: ~A~%" expected-number form n results))))
(defun check-subtypep (type1 type2 is-sub &optional should-be-valid)
(multiple-value-bind
(sub valid)
(subtypep* type1 type2)
(cond
(valid
(cond
((and sub (not is-sub))
`((SUBTYPEP ',type1 ',type2)
"==> <true>, <true>, expected NIL."))
((and (not sub) is-sub)
`((SUBTYPEP ',type1 ',type2)
"==> <false>, <true>, expected <true>."))
(t nil)))
(should-be-valid
`((SUBTYPEP ',type1 ',type2) "did not succeed but should have."))
(t nil))))
(subtypep type1 type2)
(unless (constantp type1) (setq type1 (list 'quote type1)))
(unless (constantp type2) (setq type2 (list 'quote type2)))
(if (or (and valid sub (not is-sub))
(and valid (not sub) is-sub)
(and (not valid) should-be-valid))
`((SUBTYPEP ,type1 ,type2) cl-user::==> ,sub ,valid)
nil)))
(defun check-type-predicate (P TYPE)
"Check that a predicate P is the same as #'(lambda (x) (typep x TYPE))
......
......@@ -7,7 +7,7 @@
(:use :cl :rt)
#+gcl (:use defpackage)
(:nicknames)
(:import-from "COMMON-LISP-USER" "COMPILE-AND-LOAD")
(:import-from "COMMON-LISP-USER" "COMPILE-AND-LOAD" "==>")
(:export))
#+cmu (import 'cl::quit :cl-test)
......
(in-package "COMMON-LISP-USER")
(eval-when (load eval compile)
(intern "==>" "CL-USER")
(unless (fboundp 'compile-file-pathname)
(defun compile-file-pathname (pathname)
(make-pathname :defaults pathname :type "o"))))
......
......@@ -185,6 +185,18 @@
(check-disjointness 'integer 'ratio)
nil)
(deftest fixnum-and-ratio-are-disjoint
(check-disjointness 'fixnum 'ratio)
nil)
(deftest byte8-and-ratio-are-disjoint
(check-disjointness '(unsigned-byte 8) 'ratio)
nil)
(deftest bit-and-ratio-are-disjoint
(check-disjointness 'bit 'ratio)
nil)
(deftest integer-and-float-are-disjoint
(check-disjointness 'integer 'float)
nil)
......@@ -197,6 +209,11 @@
(check-disjointness 'complex 'float)
nil)
(deftest integer-subranges-are-disjoint
(check-disjointness '(integer 0 (10)) '(integer 10 (20)))
nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; deftype
......
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