Skip to content
Snippets Groups Projects
Commit 548a16dc authored by pfdietz's avatar pfdietz
Browse files

Added more type disjointness tests.

parent 6571fe75
No related branches found
No related tags found
No related merge requests found
...@@ -590,11 +590,30 @@ the condition to go uncaught if it cannot be classified." ...@@ -590,11 +590,30 @@ the condition to go uncaught if it cannot be classified."
table)) table))
(defvar *disjoint-types-list* (defparameter *disjoint-types-list*
'(cons symbol array '(cons symbol array
number character hash-table function readtable package number character hash-table function readtable package
pathname stream random-state condition restart)) 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) (defun is-t-or-nil (e)
(or (eqt e t) (eqt e nil))) (or (eqt e t) (eqt e nil)))
...@@ -609,8 +628,8 @@ the condition to go uncaught if it cannot be classified." ...@@ -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) (format t "~%Problem! Did not find to be an atomic type: ~S" tp)
t)))) t))))
(defvar *type-list* nil) (defparameter *type-list* nil)
(defvar *supertype-table* nil) (defparameter *supertype-table* nil)
(declaim (special *subtype-table*)) (declaim (special *subtype-table*))
(defun types-9-body () (defun types-9-body ()
......
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; (load "rt/rt.o") ;;; (load "rt/rt.o")
(load "cl-test-package.lsp") (load "cl-test-package.lsp")
(in-package :cl-test) (in-package :cl-test)
(load "universe.lsp")
(compile-and-load "ansi-aux.lsp") (compile-and-load "ansi-aux.lsp")
;;; (unless (probe-file "ansi-aux.o") (compile-file "ansi-aux.lsp")) ;;; (unless (probe-file "ansi-aux.o") (compile-file "ansi-aux.lsp"))
;;; (load "ansi-aux.o") ;;; (load "ansi-aux.o")
(load "universe.lsp")
...@@ -127,7 +127,16 @@ ...@@ -127,7 +127,16 @@
for result = (check-disjointness tp1 tp2) for result = (check-disjointness tp1 tp2)
append result)) append result))
nil) 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 (deftest types-8
(loop (loop
...@@ -213,6 +222,18 @@ ...@@ -213,6 +222,18 @@
(check-disjointness '(integer 0 (10)) '(integer 10 (20))) (check-disjointness '(integer 0 (10)) '(integer 10 (20)))
nil) nil)
(deftest keyword-and-null-are-disjoint
(check-disjointness 'keyword 'null)
nil)
(deftest keyword-and-boolean-are-disjoint
(check-disjointness 'keyword 'boolean)
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