From 50a6179415d527144d15d5a855789b81ff2a0efc Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sat, 4 Jun 2005 17:35:43 +0000 Subject: [PATCH] Move typep tests to their own file --- ansi-tests/type.lsp | 11 ++- ansi-tests/typep.lsp | 113 +++++++++++++++++++++++++++++++ ansi-tests/types-and-class.lsp | 119 --------------------------------- 3 files changed, 122 insertions(+), 121 deletions(-) diff --git a/ansi-tests/type.lsp b/ansi-tests/type.lsp index 84a6c8aa..a8818067 100644 --- a/ansi-tests/type.lsp +++ b/ansi-tests/type.lsp @@ -59,6 +59,13 @@ collect (list x class form val)) nil) +;;; Free TYPE declaration +;;; It should not apply to the occurence of X in the form +;;; whose value is being bound to Y. - - +(deftest type.6 + (let ((x 2)) + (let ((y (+ (decf x) 2))) + (declare (type (integer 0 1) x)) + (values x y))) + 1 3) diff --git a/ansi-tests/typep.lsp b/ansi-tests/typep.lsp index 444e3cc5..c5c7a9c5 100644 --- a/ansi-tests/typep.lsp +++ b/ansi-tests/typep.lsp @@ -33,3 +33,116 @@ (signals-error-always (typep nil '(function () t)) error) t t) +;;; Non-error tests +;;; Many more tests use typep when testing other functions + +(deftest typep-nil-null + (notnot-mv (typep nil 'null)) + t) + +(deftest typep-t-null + (typep t 'null) + nil) + +;;; Tests of env arguments to typep + +(deftest typep.env.1 + (notnot-mv (typep 0 'bit nil)) + t) + +(deftest typep.env.2 + (macrolet ((%foo (&environment env) + (notnot-mv (typep 0 'bit env)))) + (%foo)) + t) + +(deftest typep.env.3 + (macrolet ((%foo (&environment env) + (notnot-mv (typep env (type-of env))))) + (%foo)) + t) + +;;; Other typep tests + +(deftest typep.1 + (notnot-mv (typep 'a '(eql a))) + t) + +(deftest typep.2 + (notnot-mv (typep 'a '(and (eql a)))) + t) + +(deftest typep.3 + (notnot-mv (typep 'a '(or (eql a)))) + t) + +(deftest typep.4 + (typep 'a '(eql b)) + nil) + +(deftest typep.5 + (typep 'a '(and (eql b))) + nil) + +(deftest typep.6 + (typep 'a '(or (eql b))) + nil) + +(deftest typep.7 + (notnot-mv (typep 'a '(satisfies symbolp))) + t) + +(deftest typep.8 + (typep 10 '(satisfies symbolp)) + nil) + +(deftest typep.9 + (let ((class (find-class 'symbol))) + (notnot-mv (typep 'a class))) + t) + +(deftest typep.10 + (let ((class (find-class 'symbol))) + (notnot-mv (typep 'a `(and ,class)))) + t) + +(deftest typep.11 + (let ((class (find-class 'symbol))) + (typep 10 class)) + nil) + +(deftest typep.12 + (let ((class (find-class 'symbol))) + (typep 10 `(and ,class))) + nil) + +(deftest typep.13 + (typep 'a '(and symbol integer)) + nil) + +(deftest typep.14 + (notnot-mv (typep 'a '(or symbol integer))) + t) + +(deftest typep.15 + (notnot-mv (typep 'a '(or integer symbol))) + t) + +(deftest typep.16 + (let ((c1 (find-class 'number)) + (c2 (find-class 'symbol))) + (notnot-mv (typep 'a `(or ,c1 ,c2)))) + t) + +(deftest typep.17 + (let ((c1 (find-class 'number)) + (c2 (find-class 'symbol))) + (notnot-mv (typep 'a `(or ,c2 ,c1)))) + t) + +(deftest typep.18 + (let ((i 0)) + (values + (notnot (typep (incf i) '(and (integer 0 10) (integer -5 6)))) + i)) + t 1) diff --git a/ansi-tests/types-and-class.lsp b/ansi-tests/types-and-class.lsp index d820751a..1af30396 100644 --- a/ansi-tests/types-and-class.lsp +++ b/ansi-tests/types-and-class.lsp @@ -23,14 +23,6 @@ (check-type-predicate 'is-t-or-nil 'boolean) 0) -;; Two type inclusions on booleans -;; have been conditionalized to prevent -;; some tests from doing too badly on CMU CL on x86 -;; These should get removed when I get a more up to date -;; image for that platform -- pfd - - - (deftest types.3 (loop for (t1 t2) in *subtype-table* @@ -241,15 +233,6 @@ (notnot-mv (macro-function 'deftype)) t) -(deftest typep-nil-null - (notnot-mv (typep nil 'null)) - t) - -(deftest typep-t-null - (typep t 'null) - nil) - - ;;; Error checking of type-related functions (deftest type-error-datum.error.1 @@ -277,105 +260,3 @@ program-error) t) -;;; Tests of env arguments to typep - -(deftest typep.env.1 - (notnot-mv (typep 0 'bit nil)) - t) - -(deftest typep.env.2 - (macrolet ((%foo (&environment env) - (notnot-mv (typep 0 'bit env)))) - (%foo)) - t) - -(deftest typep.env.3 - (macrolet ((%foo (&environment env) - (notnot-mv (typep env (type-of env))))) - (%foo)) - t) - -;;; Other typep tests - -(deftest typep.1 - (notnot-mv (typep 'a '(eql a))) - t) - -(deftest typep.2 - (notnot-mv (typep 'a '(and (eql a)))) - t) - -(deftest typep.3 - (notnot-mv (typep 'a '(or (eql a)))) - t) - -(deftest typep.4 - (typep 'a '(eql b)) - nil) - -(deftest typep.5 - (typep 'a '(and (eql b))) - nil) - -(deftest typep.6 - (typep 'a '(or (eql b))) - nil) - -(deftest typep.7 - (notnot-mv (typep 'a '(satisfies symbolp))) - t) - -(deftest typep.8 - (typep 10 '(satisfies symbolp)) - nil) - -(deftest typep.9 - (let ((class (find-class 'symbol))) - (notnot-mv (typep 'a class))) - t) - -(deftest typep.10 - (let ((class (find-class 'symbol))) - (notnot-mv (typep 'a `(and ,class)))) - t) - -(deftest typep.11 - (let ((class (find-class 'symbol))) - (typep 10 class)) - nil) - -(deftest typep.12 - (let ((class (find-class 'symbol))) - (typep 10 `(and ,class))) - nil) - -(deftest typep.13 - (typep 'a '(and symbol integer)) - nil) - -(deftest typep.14 - (notnot-mv (typep 'a '(or symbol integer))) - t) - -(deftest typep.15 - (notnot-mv (typep 'a '(or integer symbol))) - t) - -(deftest typep.16 - (let ((c1 (find-class 'number)) - (c2 (find-class 'symbol))) - (notnot-mv (typep 'a `(or ,c1 ,c2)))) - t) - -(deftest typep.17 - (let ((c1 (find-class 'number)) - (c2 (find-class 'symbol))) - (notnot-mv (typep 'a `(or ,c2 ,c1)))) - t) - -(deftest typep.18 - (let ((i 0)) - (values - (notnot (typep (incf i) '(and (integer 0 10) (integer -5 6)))) - i)) - t 1) -- GitLab