Skip to content
Snippets Groups Projects
Commit 6571fe75 authored by pfdietz's avatar pfdietz
Browse files

Added more disjointness tests; tweaked check-disjointness.

parent bee3f982
No related branches found
No related tags found
No related merge requests found
...@@ -153,20 +153,14 @@ Results: ~A~%" expected-number form n results)))) ...@@ -153,20 +153,14 @@ Results: ~A~%" expected-number form n results))))
(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
(sub valid) (sub valid)
(subtypep* type1 type2) (subtypep type1 type2)
(cond (unless (constantp type1) (setq type1 (list 'quote type1)))
(valid (unless (constantp type2) (setq type2 (list 'quote type2)))
(cond (if (or (and valid sub (not is-sub))
((and sub (not is-sub)) (and valid (not sub) is-sub)
`((SUBTYPEP ',type1 ',type2) (and (not valid) should-be-valid))
"==> <true>, <true>, expected NIL.")) `((SUBTYPEP ,type1 ,type2) cl-user::==> ,sub ,valid)
((and (not sub) is-sub) nil)))
`((SUBTYPEP ',type1 ',type2)
"==> <false>, <true>, expected <true>."))
(t nil)))
(should-be-valid
`((SUBTYPEP ',type1 ',type2) "did not succeed but should have."))
(t nil))))
(defun check-type-predicate (P TYPE) (defun check-type-predicate (P TYPE)
"Check that a predicate P is the same as #'(lambda (x) (typep x TYPE)) "Check that a predicate P is the same as #'(lambda (x) (typep x TYPE))
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
(:use :cl :rt) (:use :cl :rt)
#+gcl (:use defpackage) #+gcl (:use defpackage)
(:nicknames) (:nicknames)
(:import-from "COMMON-LISP-USER" "COMPILE-AND-LOAD") (:import-from "COMMON-LISP-USER" "COMPILE-AND-LOAD" "==>")
(:export)) (:export))
#+cmu (import 'cl::quit :cl-test) #+cmu (import 'cl::quit :cl-test)
......
(in-package "COMMON-LISP-USER") (in-package "COMMON-LISP-USER")
(eval-when (load eval compile) (eval-when (load eval compile)
(intern "==>" "CL-USER")
(unless (fboundp 'compile-file-pathname) (unless (fboundp 'compile-file-pathname)
(defun compile-file-pathname (pathname) (defun compile-file-pathname (pathname)
(make-pathname :defaults pathname :type "o")))) (make-pathname :defaults pathname :type "o"))))
......
...@@ -185,6 +185,18 @@ ...@@ -185,6 +185,18 @@
(check-disjointness 'integer 'ratio) (check-disjointness 'integer 'ratio)
nil) 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 (deftest integer-and-float-are-disjoint
(check-disjointness 'integer 'float) (check-disjointness 'integer 'float)
nil) nil)
...@@ -197,6 +209,11 @@ ...@@ -197,6 +209,11 @@
(check-disjointness 'complex 'float) (check-disjointness 'complex 'float)
nil) nil)
(deftest integer-subranges-are-disjoint
(check-disjointness '(integer 0 (10)) '(integer 10 (20)))
nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; deftype ;;; deftype
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment