Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Karsten Poeck
ansi-test
Commits
978d0344
Commit
978d0344
authored
Feb 05, 2003
by
pfdietz
Browse files
Added more subtypep/disjointness tests, for structures, float types, and fixnums.
parent
897dce2e
Changes
3
Hide whitespace changes
Inline
Side-by-side
ansi-tests/ansi-aux.lsp
View file @
978d0344
...
...
@@ -143,25 +143,40 @@ Results: ~A~%" expected-number form n results))))
;;; Assumes the types are nonempty.
(defun check-disjointness (type1 type2)
(remove 'nil
(list
(check-subtypep type1 type2 nil)
(check-subtypep type2 type1 nil)
(check-subtypep type1 `(not ,type2) t)
(check-subtypep type2 `(not ,type1) t)
(check-subtypep `(and ,type1 ,type2) nil t)
(check-subtypep `(and ,type2 ,type1) nil t)
(check-subtypep `(and ,type1 (not ,type2)) type1 t)
(check-subtypep `(and (not ,type2) ,type1) type1 t)
(check-subtypep `(and ,type2 (not ,type1)) type2 t)
(check-subtypep `(and (not ,type1) ,type2) type2 t)
(check-subtypep type1 `(or ,type1 (not ,type2)) t)
(check-subtypep type1 `(or (not ,type2) ,type1) t)
(check-subtypep type2 `(or ,type2 (not ,type1)) t)
(check-subtypep type2 `(or (not ,type1) ,type2) t)
(check-subtypep t `(or (not ,type1) (not ,type2)) t)
(check-subtypep t `(or (not ,type2) (not ,type1)) t)
)))
(append
(check-subtypep type1 type2 nil)
(check-subtypep type2 type1 nil)
(check-subtypep type1 `(not ,type2) t)
(check-subtypep type2 `(not ,type1) t)
(check-subtypep `(and ,type1 ,type2) nil t)
(check-subtypep `(and ,type2 ,type1) nil t)
(check-subtypep `(and ,type1 (not ,type2)) type1 t)
(check-subtypep `(and (not ,type2) ,type1) type1 t)
(check-subtypep `(and ,type2 (not ,type1)) type2 t)
(check-subtypep `(and (not ,type1) ,type2) type2 t)
;;; (check-subtypep type1 `(or ,type1 (not ,type2)) t)
;;; (check-subtypep type1 `(or (not ,type2) ,type1) t)
;;; (check-subtypep type2 `(or ,type2 (not ,type1)) t)
;;; (check-subtypep type2 `(or (not ,type1) ,type2) t)
(check-subtypep t `(or (not ,type1) (not ,type2)) t)
(check-subtypep t `(or (not ,type2) (not ,type1)) t)
))
(defun check-equivalence (type1 type2)
(append
(check-subtypep type1 type2 t)
(check-subtypep type2 type1 t)
(check-subtypep `(not ,type1) `(not ,type2) t)
(check-subtypep `(not ,type2) `(not ,type1) t)
(check-subtypep `(and ,type1 (not ,type2)) nil t)
(check-subtypep `(and ,type2 (not ,type1)) nil t)
(check-subtypep `(and (not ,type2) ,type1) nil t)
(check-subtypep `(and (not ,type1) ,type2) nil t)
(check-subtypep t `(or ,type1 (not ,type2)) t)
(check-subtypep t `(or ,type2 (not ,type1)) t)
(check-subtypep t `(or (not ,type2) ,type1) t)
(check-subtypep t `(or (not ,type1) ,type2) t)))
(defun check-subtypep (type1 type2 is-sub &optional should-be-valid)
(multiple-value-bind
...
...
@@ -172,7 +187,7 @@ Results: ~A~%" expected-number form n results))))
(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)
`((
(
SUBTYPEP ,type1 ,type2) cl-user::==> ,sub ,valid)
)
nil)))
(defun check-type-predicate (P TYPE)
...
...
ansi-tests/subtypep.lsp
View file @
978d0344
...
...
@@ -114,6 +114,113 @@
(values t t))
t t)
(deftest subtypep.fixnum-or-bignum
(check-equivalence '(or fixnum bignum) 'integer)
nil)
(deftest subtypep.integer.1
(subtypep* '(integer 0 10) '(integer 0 20))
t t)
(deftest subtypep.integer.2
(subtypep* '(integer 0 10) '(integer 0 (10)))
nil t)
(deftest subtypep.float.1
(loop for tp in +float-types+
append (check-subtypep tp 'float t t))
nil)
(deftest subtypep.float.2
(if (subtypep 'short-float 'long-float)
(loop for tp in +float-types+
append
(loop for tp2 in +float-types+
append (check-subtypep tp tp2 t t)))
nil)
nil)
(deftest subtypep.float.3
(if (and (not (subtypep 'short-float 'single-float))
(subtypep 'single-float 'long-float))
(append
(check-equivalence 'single-float 'double-float)
(check-equivalence 'single-float 'long-float)
(check-equivalence 'double-float 'long-float)
(check-disjointness 'short-float 'single-float)
(check-disjointness 'short-float 'double-float)
(check-disjointness 'short-float 'long-float))
nil)
nil)
(deftest subtypep.float.4
(if (and (subtypep 'single-float 'short-float)
(subtypep 'double-float 'long-float)
(not (subtypep 'short-float 'double-float)))
(append
(check-equivalence 'short-float 'single-float)
(check-equivalence 'double-float 'long-float)
(loop for tp in '(short-float single-float)
append
(loop for tp2 in '(double-float long-float)
append (check-disjointness tp tp2))))
nil)
nil)
(deftest subtypep.float.5
(if (and (not (subtypep 'single-float 'short-float))
(not (subtypep 'single-float 'double-float))
(subtypep 'double-float 'long-float))
(append
(check-disjointness 'short-float 'single-float)
(check-disjointness 'short-float 'double-float)
(check-disjointness 'short-float 'long-float)
(check-disjointness 'single-float 'double-float)
(check-disjointness 'single-float 'long-float)
(check-equivalence 'double-float 'long-float))
nil)
nil)
(deftest subtypep.float.6
(if (and (subtypep 'single-float 'short-float)
(not (subtypep 'single-float 'double-float))
(not (subtypep 'double-float 'long-float)))
(append
(check-equivalence 'short-float 'single-float)
(check-disjointness 'single-float 'double-float)
(check-disjointness 'single-float 'long-float)
(check-disjointness 'double-float 'long-float))
nil)
nil)
(deftest subtypep.float.7
(if (and (not (subtypep 'single-float 'short-float))
(not (subtypep 'single-float 'double-float))
(not (subtypep 'double-float 'long-float)))
(loop for tp in +float-types+
append
(loop for tp2 in +float-types+
unless (eq tp tp2)
append (check-disjointness tp tp2)))
nil)
nil)
(deftest subtypep.float.8
(subtypep* '(short-float 0.0s0 10.0s0) '(short-float 0.0s0 11.0s0))
t t)
(deftest subtypep.float.9
(subtypep* '(single-float 0.0f0 10.0f0) '(single-float 0.0f0 11.0f0))
t t)
(deftest subtypep.float.10
(subtypep* '(double-float 0.0d0 10.0d0) '(double-float 0.0d0 11.0d0))
t t)
(deftest subtypep.float.11
(subtypep* '(long-float 0.0l0 10.0l0) '(long-float 0.0l0 11.0l0))
t t)
;;; SUBTYPEP on CONS types
(defvar *cons-types*
...
...
ansi-tests/types-and-class.lsp
View file @
978d0344
...
...
@@ -198,7 +198,23 @@
(deftest user-class-disjointness-2
(check-disjointness 'tac-1a-class 'tac-1b-class)
nil)
nil)
(defstruct tac-2-struct a b c)
(defstruct (tac-2a-struct (:include tac-2-struct)) d e)
(defstruct (tac-2b-struct (:include tac-2-struct)) f g)
(deftest user-struct-disjointness
(loop for l in *disjoint-types-list2*
append
(loop
for type in l
append (check-disjointness type 'tac-2-struct)))
nil)
(deftest user-struct-disjointness-2
(check-disjointness 'tac-2a-struct 'tac-2b-struct)
nil)
(deftest integer-and-ratio-are-disjoint
(classes-are-disjoint 'integer 'ratio)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment