diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index f8ac152529f525c3351231abeddee677f40eb8e3..ac2cc4eed28b14806a32985f493db28944f2b483 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -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)) diff --git a/ansi-tests/cl-test-package.lsp b/ansi-tests/cl-test-package.lsp index 7b7369460157e36ba2aa6924cfcb04c0e167b3ea..54aa2eb863fc85b109a6bf66f851a7f781064cd8 100644 --- a/ansi-tests/cl-test-package.lsp +++ b/ansi-tests/cl-test-package.lsp @@ -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) diff --git a/ansi-tests/compile-and-load.lsp b/ansi-tests/compile-and-load.lsp index fc4dfa9ac9349a99597b9e8d9203f7d9bb8f2232..522842c1335b0f1fb60e4b2882244e92686e0bd6 100644 --- a/ansi-tests/compile-and-load.lsp +++ b/ansi-tests/compile-and-load.lsp @@ -1,6 +1,8 @@ (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")))) diff --git a/ansi-tests/types-and-class.lsp b/ansi-tests/types-and-class.lsp index 60e6732c5c17a3031f33ca6ebe3cdd11e59e20dd..fdf67ad07ed9247d62a1f418b8e58bf830e7469b 100644 --- a/ansi-tests/types-and-class.lsp +++ b/ansi-tests/types-and-class.lsp @@ -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