diff --git a/ansi-tests/type.lsp b/ansi-tests/type.lsp index 84a6c8aa660e6be1582c42783b71018f845a8d59..a88180677122fb19bd2b7090b26e37eca5514c0c 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 444e3cc5f25678e23774776def927f6179d3fa23..c5c7a9c568fc469371a9d1ee0da01d42855bfb15 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 d820751a1f4d6659dcacfce4ff4c790666212244..1af303963c951381ea8f299f22d9acc20a61dccb 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)