Commit 548a16dc authored by pfdietz's avatar pfdietz

Added more type disjointness tests.

parent 6571fe75
......@@ -590,11 +590,30 @@ the condition to go uncaught if it cannot be classified."
table))
(defvar *disjoint-types-list*
(defparameter *disjoint-types-list*
'(cons symbol array
number character hash-table function readtable package
pathname stream random-state condition restart))
(defparameter *disjoint-types-list2*
`((cons (cons t t) (cons t (cons t t)))
(symbol keyword boolean null)
(array vector simple-array simple-vector string simple-string
base-string simple-base-string)
(character base-char standard-char extended-char)
(function compiled-function generic-function standard-generic-function)
(package)
(pathname logical-pathname)
(stream broadcast-stream concatenated-stream echo-stream
file-stream string-stream synonym-stream two-way-stream)
(number real complex float integer rational ratio
bit (integer 0 100) (float 0.0 100.0) (integer 0 *)
(rational 0 *) (mod 10))
(random-state)
,*condition-types*
(restart)
(readtable)))
(defun is-t-or-nil (e)
(or (eqt e t) (eqt e nil)))
......@@ -609,8 +628,8 @@ the condition to go uncaught if it cannot be classified."
(format t "~%Problem! Did not find to be an atomic type: ~S" tp)
t))))
(defvar *type-list* nil)
(defvar *supertype-table* nil)
(defparameter *type-list* nil)
(defparameter *supertype-table* nil)
(declaim (special *subtype-table*))
(defun types-9-body ()
......
......@@ -5,7 +5,7 @@
;;; (load "rt/rt.o")
(load "cl-test-package.lsp")
(in-package :cl-test)
(load "universe.lsp")
(compile-and-load "ansi-aux.lsp")
;;; (unless (probe-file "ansi-aux.o") (compile-file "ansi-aux.lsp"))
;;; (load "ansi-aux.o")
(load "universe.lsp")
......@@ -127,7 +127,16 @@
for result = (check-disjointness tp1 tp2)
append result))
nil)
(deftest types-7c
(loop for e on *disjoint-types-list2*
for list1 = (first e)
append
(loop for tp1 in list1 append
(loop for list2 in (rest e) append
(loop for tp2 in list2 append
(check-disjointness tp1 tp2)))))
nil)
(deftest types-8
(loop
......@@ -213,6 +222,18 @@
(check-disjointness '(integer 0 (10)) '(integer 10 (20)))
nil)
(deftest keyword-and-null-are-disjoint
(check-disjointness 'keyword 'null)
nil)
(deftest keyword-and-boolean-are-disjoint
(check-disjointness 'keyword 'boolean)
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