diff --git a/ansi-tests/acos.lsp b/ansi-tests/acos.lsp index 6821bdc0d4b181d15fafa1b52dd23b8c2470a7b9..b8f2bc2d069b566d967749b116553867400fa353 100644 --- a/ansi-tests/acos.lsp +++ b/ansi-tests/acos.lsp @@ -92,8 +92,5 @@ t) (deftest acos.error.3 - (loop for x in *mini-universe* - unless (or (numberp x) - (eval `(signals-type-error x ',x (acos x)))) - collect x) + (check-type-error #'acos #'numberp) nil) diff --git a/ansi-tests/acosh.lsp b/ansi-tests/acosh.lsp index f36b38de1b9f63ebd9f00367e26facac36be0207..2af7791c5cdb47e4150d1614b239cb239f8a31b6 100644 --- a/ansi-tests/acosh.lsp +++ b/ansi-tests/acosh.lsp @@ -82,10 +82,7 @@ t) (deftest acosh.error.3 - (loop for x in *mini-universe* - unless (or (numberp x) - (eval `(signals-type-error x ',x (acosh x)))) - collect x) + (check-type-error #'acosh #'numberp) nil) diff --git a/ansi-tests/adjustable-array-p.lsp b/ansi-tests/adjustable-array-p.lsp index 0279e8de36602801287b06f41c1fb68057d8775a..6832be79f863cef073a13b156cac702b0debeb6a 100644 --- a/ansi-tests/adjustable-array-p.lsp +++ b/ansi-tests/adjustable-array-p.lsp @@ -48,10 +48,7 @@ t) (deftest adjustable-array-p.error.4 - (loop for e in *mini-universe* - unless (or (typep e 'array) - (eval `(signals-type-error x ',e (adjustable-array-p x)))) - collect e) + (check-type-error #'adjustable-array-p #'arrayp) nil) (deftest adjustable-array-p.error.5 diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index 6009c9c051e348d6c32a68d717a1b87c464c3d88..232a2d7a76907f1dad4a65a791fb58a432221a69 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -272,7 +272,7 @@ the condition to go uncaught if it cannot be classified." ;;; The above is badly designed, since it fails when some signals ;;; may be in more than one class/ -(defmacro signals-error (form error-name &key (safety 3) (name nil name-p)) +(defmacro signals-error (form error-name &key (safety 3) (name nil name-p) (inline nil)) `(handler-bind ((warning #'(lambda (c) (declare (ignore c)) (muffle-warning)))) @@ -281,11 +281,13 @@ the condition to go uncaught if it cannot be classified." (apply #'values nil (multiple-value-list - (if regression-test::*compile-tests* - (funcall (compile nil '(lambda () + ,(cond + (inline form) + (regression-test::*compile-tests* + `(funcall (compile nil '(lambda () (declare (optimize (safety ,safety))) - ,form))) - (eval ',form)))) + ,form)))) + (t `(eval ',form))))) (,error-name (c) (cond ,@(case error-name @@ -326,12 +328,13 @@ the condition to go uncaught if it cannot be classified." (signals-error ,form ,error-name) (signals-error ,form ,error-name :safety 0))) -(defmacro signals-type-error (var datum-form form &key (safety 3)) +(defmacro signals-type-error (var datum-form form &key (safety 3) (inline nil)) (let ((lambda-form `(lambda (,var) (declare (optimize (safety ,safety))) ,form))) `(let ((,var ,datum-form)) + (declare (optimize safety)) (handler-bind ((warning #'(lambda (c) (declare (ignore c)) (muffle-warning)))) @@ -341,9 +344,11 @@ the condition to go uncaught if it cannot be classified." nil (multiple-value-list (funcall - (if regression-test::*compile-tests* - (compile nil ',lambda-form) - (eval ',lambda-form)) + ,(cond + (inline `(function ,lambda-form)) + (regression-test::*compile-tests* + `(compile nil ',lambda-form)) + (t `(eval ',lambda-form))) ,var))) (type-error (c) @@ -356,6 +361,23 @@ the condition to go uncaught if it cannot be classified." (list :is-typep datum expected-type)) (t (printable-p c)))))))))) +(declaim (special *mini-universe*)) + +(defun check-type-error* (pred-fn guard-fn &optional (universe *mini-universe*)) + "Check that for all elements in some set, either guard-fn is true or + pred-fn signals a type error." + (let (val) + (loop for e in universe + unless (or (funcall guard-fn e) + (equal + (setf val (multiple-value-list + (signals-type-error x e (funcall pred-fn x) :inline t))) + '(t))) + collect (list e val)))) + +(defmacro check-type-error (&body args) + `(locally (declare (optimize safety)) (check-type-error* ,@args))) + (defun printable-p (obj) "Returns T iff obj can be printed to a string." (with-standard-io-syntax @@ -1120,3 +1142,5 @@ the condition to go uncaught if it cannot be classified." (double-float double-float-negative-epsilon) (long-float long-float-negative-epsilon) (rational 0))) + +(defun sequencep (x) (typep x 'sequence)) diff --git a/ansi-tests/array-dimensions.lsp b/ansi-tests/array-dimensions.lsp index f96cb8451d7ec19fd209ec54b8f2a0a0793c1e38..98d94cff522348785c2aa5da991c7d57fdf3f06f 100644 --- a/ansi-tests/array-dimensions.lsp +++ b/ansi-tests/array-dimensions.lsp @@ -51,10 +51,7 @@ t) (deftest array-dimensions.error.3 - (loop for e in *mini-universe* - unless (or (typep e 'array) - (eval `(signals-type-error x ',e (array-dimensions x)))) - collect e) + (check-type-error #'array-dimensions #'arrayp) nil) (deftest array-dimensions.error.4 diff --git a/ansi-tests/array-displacement.lsp b/ansi-tests/array-displacement.lsp index 321cb41515fb1c18de136476694102e1f2e55734..ad668be567a4a35c732ae23113b866d4a61a972f 100644 --- a/ansi-tests/array-displacement.lsp +++ b/ansi-tests/array-displacement.lsp @@ -116,10 +116,7 @@ t) (deftest array-displacement.error.3 - (loop for e in *mini-universe* - unless (or (typep e 'array) - (eval `(signals-type-error x ',e (array-displacement ',e)))) - collect e) + (check-type-error #'array-displacement #'arrayp) nil) (deftest array-displacement.error.4 diff --git a/ansi-tests/array-rank.lsp b/ansi-tests/array-rank.lsp index c86c9a7ae766e812b3f188e361293a469f42221f..6126d5e3618259a388597bf04ce9e7f5db40d929 100644 --- a/ansi-tests/array-rank.lsp +++ b/ansi-tests/array-rank.lsp @@ -36,10 +36,7 @@ t) (deftest array-rank.error.3 - (loop for e in *mini-universe* - unless (or (typep e 'array) - (eval `(signals-type-error x ',e (array-rank x)))) - collect e) + (check-type-error #'array-rank #'arrayp) nil) (deftest array-rank.error.4 diff --git a/ansi-tests/array-total-size.lsp b/ansi-tests/array-total-size.lsp index 3abb0822e41e8ac8fe09a5b13b8a33a411e24874..50ab953f24251f46765304a3d9394adc28acd9f4 100644 --- a/ansi-tests/array-total-size.lsp +++ b/ansi-tests/array-total-size.lsp @@ -45,10 +45,7 @@ t) (deftest array-total-size.error.3 - (loop for e in *mini-universe* - unless (or (typep e 'array) - (eval `(signals-type-error x ',e (array-total-size ',e)))) - collect e) + (check-type-error #'array-total-size #'arrayp) nil) (deftest array-total-size.error.4 diff --git a/ansi-tests/ash.lsp b/ansi-tests/ash.lsp index 2f57ace2847482b760a8eb688ad6449148a67e71..3f26369f004b011295c1e9f6fbaa5f53176209a2 100644 --- a/ansi-tests/ash.lsp +++ b/ansi-tests/ash.lsp @@ -20,17 +20,11 @@ t) (deftest ash.error.4 - (loop for x in *mini-universe* - unless (or (integerp x) - (eval `(signals-type-error x ',x (ash x 0)))) - collect x) + (check-type-error #'(lambda (x) (ash x 0)) #'integerp) nil) (deftest ash.error.5 - (loop for x in *mini-universe* - unless (or (integerp x) - (eval `(signals-type-error x ',x (ash 0 x)))) - collect x) + (check-type-error #'(lambda (x) (ash 0 x)) #'integerp) nil) ;;; Non-error tests @@ -59,7 +53,7 @@ t) (deftest ash.4 - (loop for i from -1 to -1000 + (loop for i from -1 downto -1000 always (eql (ash i i) -1)) t) diff --git a/ansi-tests/asin.lsp b/ansi-tests/asin.lsp index b3212bc8872b7056f312fbcc7ef3ad9c50e60f3a..7db773c581883afd01e014eff8a77bda4fc426ce 100644 --- a/ansi-tests/asin.lsp +++ b/ansi-tests/asin.lsp @@ -92,10 +92,7 @@ t) (deftest asin.error.3 - (loop for x in *mini-universe* - unless (or (numberp x) - (eval `(signals-type-error x ',x (asin x)))) - collect x) + (check-type-error #'asin #'numberp) nil) diff --git a/ansi-tests/asinh.lsp b/ansi-tests/asinh.lsp index ac76d2592b3d6904a8db0f714eb1c57c8a0a8969..9501c01c6041b08bc4ad0a08c5e0793309e98d79 100644 --- a/ansi-tests/asinh.lsp +++ b/ansi-tests/asinh.lsp @@ -80,10 +80,7 @@ t) (deftest asinh.error.3 - (loop for x in *mini-universe* - unless (or (numberp x) - (eval `(signals-type-error x ',x (asinh x)))) - collect x) + (check-type-error #'asinh #'numberp) nil) diff --git a/ansi-tests/atan.lsp b/ansi-tests/atan.lsp index bdef875d7aa5c823f2f09770a777950c91e0cb79..54c77b0aaa740ad915cde5e8fd08dafddd22a6fc 100644 --- a/ansi-tests/atan.lsp +++ b/ansi-tests/atan.lsp @@ -133,24 +133,15 @@ t) (deftest atan.error.3 - (loop for x in *mini-universe* - unless (or (numberp x) - (eval `(signals-type-error x ',x (atan x)))) - collect x) + (check-type-error #'atan #'numberp) nil) (deftest atan.error.4 - (loop for x in *mini-universe* - unless (or (realp x) - (eval `(signals-type-error x ',x (atan x 1)))) - collect x) + (check-type-error #'(lambda (x) (atan x 1)) #'realp) nil) (deftest atan.error.5 - (loop for x in *mini-universe* - unless (or (realp x) - (eval `(signals-type-error x ',x (atan 1 x)))) - collect x) + (check-type-error #'(lambda (x) (atan 1 x)) #'realp) nil) diff --git a/ansi-tests/atanh.lsp b/ansi-tests/atanh.lsp index ec1f2b695c70b48742736601c51ad39b57d2d6ad..1d4adffeff7dc36f2ec3e056357b7460598de0d2 100644 --- a/ansi-tests/atanh.lsp +++ b/ansi-tests/atanh.lsp @@ -109,18 +109,5 @@ t) (deftest atanh.error.3 - (loop for x in *mini-universe* - unless (or (numberp x) - (eval `(signals-type-error x ',x (atanh x)))) - collect x) + (check-type-error #'atanh #'numberp) nil) - - - - - - - - - - diff --git a/ansi-tests/boundp.lsp b/ansi-tests/boundp.lsp index 122e0d7129e9c88af7ab47f312e3338522c9bac7..84a2a270d91684711c5255f0dc014069f88a19c8 100644 --- a/ansi-tests/boundp.lsp +++ b/ansi-tests/boundp.lsp @@ -14,8 +14,8 @@ t) (deftest boundp.error.3 - (signals-type-error x 1 (boundp 1)) - t) + (check-type-error #'boundp #'symbolp) + nil) (deftest boundp.error.4 (signals-type-error x '(setf car) (boundp x)) diff --git a/ansi-tests/cl-symbols.lsp b/ansi-tests/cl-symbols.lsp index 52b13d10bc2633413cc3b7e807bd9758707b1131..95034a5cc97c8c650cc4c29667cbb8b2044811d2 100644 --- a/ansi-tests/cl-symbols.lsp +++ b/ansi-tests/cl-symbols.lsp @@ -1146,10 +1146,7 @@ t) (deftest symbol-package.error.3 - (loop for x in *mini-universe* - for form = `(signals-type-error x ',x (symbol-package x)) - unless (or (symbolp x) (eval form)) - collect x) + (check-type-error #'symbol-package #'symbolp) nil) @@ -1162,18 +1159,12 @@ t) (deftest symbol-plist.error.3 - (loop for x in *mini-universe* - for form = `(signals-type-error x ',x (symbol-plist x)) - unless (or (symbolp x) (eval form)) - collect x) + (check-type-error #'symbol-plist #'symbolp) nil) (deftest symbol-plist.error.4 - (loop for x in *mini-universe* - for form = `(signals-type-error x ',x (setf (symbol-plist x) - (find-package "CL-USER"))) - unless (or (symbolp x) (eval form)) - collect x) + (check-type-error #'(lambda (x) (setf (symbol-plist x) nil)) + #'symbolp) nil) @@ -1187,17 +1178,11 @@ t) (deftest symbol-value.error.3 - (loop for x in *mini-universe* - for form = `(signals-type-error x ',x (symbol-value x)) - unless (or (symbolp x) (eval form)) - collect x) + (check-type-error #'symbol-value #'symbolp) nil) (deftest symbol-value.error.4 - (loop for x in *mini-universe* - for form = `(signals-type-error x ',x (setf (symbol-value x) nil)) - unless (or (symbolp x) (eval form)) - collect x) + (check-type-error #'(lambda (x) (setf (symbol-value x) nil)) #'symbolp) nil) (deftest symbol-value.error.5 diff --git a/ansi-tests/clear-input.lsp b/ansi-tests/clear-input.lsp index 334a659d3343f860b647463f031e7328513e3088..73c12f8103603ec97cadfd0aac22488ebcc77434 100644 --- a/ansi-tests/clear-input.lsp +++ b/ansi-tests/clear-input.lsp @@ -60,12 +60,5 @@ t) (deftest clear-input.error.5 - (loop for x in *mini-universe* - unless (or (member x '(nil t)) - (typep x 'stream) - (equalt - (eval `(multiple-value-list - (signals-type-error x ',x (clear-input x)))) - '(t))) - collect x) + (check-type-error #'clear-input #'(lambda (x) (typep x '(or stream (member nil t))))) nil) diff --git a/ansi-tests/clear-output.lsp b/ansi-tests/clear-output.lsp index b03f6b87de7b8a98afe9f98ec48f28e32a1d4ea5..03f0ae807e1c44f6703b2dbb3f1f6b56a2dbf307 100644 --- a/ansi-tests/clear-output.lsp +++ b/ansi-tests/clear-output.lsp @@ -49,14 +49,5 @@ t) (deftest clear-output.error.3 - (loop for x in *mini-universe* - unless (or (member x '(nil t)) - (typep x 'stream) - (equalt - (eval `(multiple-value-list - (signals-type-error x ',x (clear-output x)))) - '(t))) - collect x) + (check-type-error #'clear-output #'(lambda (x) (typep x '(or stream (member nil t))))) nil) - - diff --git a/ansi-tests/copy-pprint-dispatch.lsp b/ansi-tests/copy-pprint-dispatch.lsp index 0f383c632b12331f492d1d7add4cef963b789269..3bb4fbd67d480f5e2b448ce9eb2d89d9b4f4871c 100644 --- a/ansi-tests/copy-pprint-dispatch.lsp +++ b/ansi-tests/copy-pprint-dispatch.lsp @@ -120,11 +120,5 @@ t) (deftest copy-pprint-dispatch.error.2 - (loop for x in *mini-universe* - for results = (multiple-value-list - (eval `(signals-type-error x ',x (copy-pprint-dispatch x)))) - unless (or (null x) - (equal results '(t))) - collect (list x results)) + (check-type-error #'copy-pprint-dispatch #'null) nil) - diff --git a/ansi-tests/copy-seq.lsp b/ansi-tests/copy-seq.lsp index f60bbf7cd144bf16d93fab43f10b08dcc8121056..8d974b12eb5a96fb784f894b1f13fcc3b172bbef 100644 --- a/ansi-tests/copy-seq.lsp +++ b/ansi-tests/copy-seq.lsp @@ -230,16 +230,8 @@ ;;; Error tests (deftest copy-seq.error.1 - (signals-type-error x 10 (copy-seq x)) - t) - -(deftest copy-seq.error.2 - (signals-type-error x 'a (copy-seq x)) - t) - -(deftest copy-seq.error.3 - (signals-type-error x 13.21 (copy-seq x)) - t) + (check-type-error #'copy-seq #'sequencep) + nil) (deftest copy-seq.error.4 (signals-error (copy-seq) program-error) diff --git a/ansi-tests/cos.lsp b/ansi-tests/cos.lsp index c38b1b2fa19de3130c228acd085b7c8ad1aaa147..3cd38f6db058c32b2e59993fa0714cf0b8e25321 100644 --- a/ansi-tests/cos.lsp +++ b/ansi-tests/cos.lsp @@ -167,9 +167,6 @@ t) (deftest cos.error.3 - (loop for x in *mini-universe* - unless (or (numberp x) - (eval `(signals-type-error x ',x (cos x)))) - collect x) + (check-type-error #'cos #'numberp) nil) diff --git a/ansi-tests/cosh.lsp b/ansi-tests/cosh.lsp index 602d09421b04d56457252239ffa836e4674f09fc..60b0758120a237ae599007850dc14aab303af7ef 100644 --- a/ansi-tests/cosh.lsp +++ b/ansi-tests/cosh.lsp @@ -82,10 +82,7 @@ t) (deftest cosh.error.3 - (loop for x in *mini-universe* - unless (or (numberp x) - (eval `(signals-type-error x ',x (cosh x)))) - collect x) + (check-type-error #'cosh #'numberp) nil) diff --git a/ansi-tests/count-if-not.lsp b/ansi-tests/count-if-not.lsp index 70331c5c2f5cea583817b3668df1f85b6f929f66..ecab1f7ed5c65110a87c99ff7ef806b531c2cdc9 100644 --- a/ansi-tests/count-if-not.lsp +++ b/ansi-tests/count-if-not.lsp @@ -525,16 +525,8 @@ ;;; Error tests (deftest count-if-not.error.1 - (signals-type-error x 1 (count-if-not #'identity x)) - t) - -(deftest count-if-not.error.2 - (signals-type-error x 'a (count-if-not #'identity x)) - t) - -(deftest count-if-not.error.3 - (signals-type-error x #\a (count-if-not #'identity x)) - t) + (check-type-error #'(lambda (x) (count-if-not #'identity x)) #'sequencep) + nil) (deftest count-if-not.error.4 (signals-error (count-if-not) program-error) diff --git a/ansi-tests/count-if.lsp b/ansi-tests/count-if.lsp index c16577b6f136ad36fd355095a0af9ae53750fa30..9558dbf6c4d82c92cda1449d3735edb44f7b84fd 100644 --- a/ansi-tests/count-if.lsp +++ b/ansi-tests/count-if.lsp @@ -524,16 +524,9 @@ ;;; Error tests (deftest count-if.error.1 - (signals-type-error x 1 (count-if #'identity x)) - t) - -(deftest count-if.error.2 - (signals-type-error x 'a (count-if #'identity x)) - t) - -(deftest count-if.error.3 - (signals-type-error x #\a (count-if #'identity x)) - t) + (check-type-error #'(lambda (x) (count-if #'identity x)) + #'sequencep) + nil) (deftest count-if.error.4 (signals-error (count-if) program-error) diff --git a/ansi-tests/count.lsp b/ansi-tests/count.lsp index d609430a980416a550b793a7a27d6f0600ca9fd1..c2d8735682f3b84a9b8e8532f97fe0d09ed86e71 100644 --- a/ansi-tests/count.lsp +++ b/ansi-tests/count.lsp @@ -653,16 +653,8 @@ ;;; Error tests (deftest count.error.1 - (signals-type-error x 1 (count 'a x)) - t) - -(deftest count.error.2 - (signals-type-error x 'a (count 'a x)) - t) - -(deftest count.error.3 - (signals-type-error x #\a (count 'a x)) - t) + (check-type-error #'(lambda (x) (count 'a x)) #'sequencep) + nil) (deftest count.error.4 (signals-error (count) program-error) diff --git a/ansi-tests/ctypecase.lsp b/ansi-tests/ctypecase.lsp index 9c07604c8aece3947d971cc19e42f65cb8881116..0916f4d60e3cd2a8deff8f6e398f335f61653017 100644 --- a/ansi-tests/ctypecase.lsp +++ b/ansi-tests/ctypecase.lsp @@ -11,10 +11,8 @@ a) (deftest ctypecase.2 - (signals-type-error - x 1 - (ctypecase x (symbol 'a))) - t) + (check-type-error #'(lambda (x) (ctypecase x (symbol 'a))) #'symbolp) + nil) (deftest ctypecase.3 (let ((x 1)) diff --git a/ansi-tests/cxr.lsp b/ansi-tests/cxr.lsp index 6113f87cc64cb3303e8cb10399800bd4c8a96464..7fe6e9fa70c6e7284c340b75fdebdc49434c00a0 100644 --- a/ansi-tests/cxr.lsp +++ b/ansi-tests/cxr.lsp @@ -148,11 +148,11 @@ (car nil) nil) -(deftest car-symbol-error - (signals-type-error x 'a (car x)) - t) +(deftest car.error.1 + (check-type-error #'car #'listp) + nil) -(deftest car-symbol-error.2 +(deftest car.error.2 (signals-error (locally (car 'a) t) type-error) t) @@ -174,11 +174,11 @@ (values (cdr (progn (incf i) '(a b))) i)) (b) 1) -(deftest cdr-symbol-error - (signals-type-error x 'a (cdr x)) - t) +(deftest cdr.error.1 + (check-type-error #'cdr #'listp) + nil) -(deftest cdr-symbol-error.2 +(deftest cdr.error.2 (signals-error (locally (cdr 'a) t) type-error) t) diff --git a/ansi-tests/ecase.lsp b/ansi-tests/ecase.lsp index 6a42ec1473469faf1a2ee506c06fbb372c0d5acd..3684848476d5f620188bde951e4af9ba7722e517 100644 --- a/ansi-tests/ecase.lsp +++ b/ansi-tests/ecase.lsp @@ -10,22 +10,22 @@ 2) (deftest ecase.2 - (signals-error (ecase 1) type-error) + (signals-type-error x 1 (ecase x)) t) (deftest ecase.3 - (signals-error (ecase 1 (a 1) (b 2) (c 3)) type-error) + (signals-type-error x 1 (ecase x (a 1) (b 2) (c 3))) t) ;;; It is legal to use T or OTHERWISE as key designators ;;; in ECASE forms. They have no special meaning here. (deftest ecase.4 - (signals-error (ecase 1 (t nil)) type-error) + (signals-type-error x 1 (ecase x (t nil))) t) (deftest ecase.5 - (signals-error (ecase 1 (otherwise nil)) type-error) + (signals-type-error x 1 (ecase x (otherwise nil))) t) (deftest ecase.6 @@ -45,7 +45,7 @@ a) (deftest ecase.9 - (signals-error (ecase nil (nil 'a)) type-error) + (signals-type-error x nil (ecase x (nil 'a))) t) (deftest ecase.10 @@ -57,7 +57,7 @@ 1 2 3) (deftest ecase.12 - (signals-error (ecase t (a 10)) type-error) + (signals-type-error x t (ecase x (a 10))) t) (deftest ecase.13 @@ -70,25 +70,23 @@ 1) (deftest ecase.15 - (signals-error (ecase 'otherwise ((t) 10)) type-error) + (signals-type-error x 'otherwise (ecase x ((t) 10))) t) (deftest ecase.16 - (signals-error (ecase t ((otherwise) 10)) type-error) + (signals-type-error x t (ecase x ((otherwise) 10))) t) (deftest ecase.17 - (signals-error (ecase 'a (b 0) (c 1) (otherwise 2)) - type-error) + (signals-type-error x 'a (ecase x (b 0) (c 1) (otherwise 2))) t) (deftest ecase.18 - (signals-error (ecase 'a (b 0) (c 1) ((otherwise) 2)) - type-error) + (signals-type-error x 'a (ecase x (b 0) (c 1) ((otherwise) 2))) t) (deftest ecase.19 - (signals-error (ecase 'a (b 0) (c 1) ((t) 2)) type-error) + (signals-type-error x 'a (ecase x (b 0) (c 1) ((t) 2))) t) (deftest ecase.20 diff --git a/ansi-tests/elt.lsp b/ansi-tests/elt.lsp index c0a1fb220d0531c8901e76832333d731fe5e20cb..ff34d76e4a1e21988c9bdcde27c22d78774c3524 100644 --- a/ansi-tests/elt.lsp +++ b/ansi-tests/elt.lsp @@ -10,7 +10,7 @@ ;; elt on lists (deftest elt.1 - (signals-error (elt nil 0) type-error) + (signals-error (elt x 0) type-error) t) (deftest elt.1a diff --git a/ansi-tests/endp.lsp b/ansi-tests/endp.lsp index 76154f47242ac1664c0787ef7957fa44925349e8..1b5323ced0457308902ace781e121a25881bef83 100644 --- a/ansi-tests/endp.lsp +++ b/ansi-tests/endp.lsp @@ -26,17 +26,9 @@ i)) nil 1) -(deftest endp-symbol-error - (catch-type-error (endp 'a)) - type-error) - -(deftest endp-fixnum-error - (catch-type-error (endp 1)) - type-error) - -(deftest endp-float-error - (catch-type-error (endp 0.9212d4)) - type-error) +(deftest endp.error.1 + (check-type-error #'endp #'listp) + nil) (deftest endp.error.4 (signals-error (endp) program-error) @@ -49,4 +41,3 @@ (deftest endp.error.6 (signals-error (locally (endp 1)) type-error) t) - diff --git a/ansi-tests/etypecase.lsp b/ansi-tests/etypecase.lsp index 1c2121691ab1ca1b5a8f1cfc1def36ef1a9e9f5c..9a6337e4944e108a775a7261a8a661e90779ed3d 100644 --- a/ansi-tests/etypecase.lsp +++ b/ansi-tests/etypecase.lsp @@ -12,7 +12,7 @@ a) (deftest etypecase.2 - (signals-error (etypecase 1 (symbol 'a)) type-error) + (signals-type-error x 1 (etypecase x (symbol 'a))) t) (deftest etypecase.3 diff --git a/ansi-tests/evenp.lsp b/ansi-tests/evenp.lsp index 37a3f6c0ccec91e703426d7ef7be554e6832e38a..4d4d1158f738cad3ed17c88443a0347525c5bef1 100644 --- a/ansi-tests/evenp.lsp +++ b/ansi-tests/evenp.lsp @@ -15,19 +15,16 @@ (signals-error (evenp 0 nil) program-error) t) +(deftest evenp.error.3 + (check-type-error #'evenp #'integerp) + nil) + (deftest evenp.1 (loop for x in *numbers* when (integerp x) do (evenp x)) nil) -(deftest evenp.2 - (loop for x in *mini-universe* - unless (or (integerp x) - (eval `(signals-error (evenp ',x) type-error))) - collect x) - nil) - (deftest evenp.3 (loop for x = (random-fixnum) repeat 10000 diff --git a/ansi-tests/every.lsp b/ansi-tests/every.lsp index cf8b933a9b6c182407c36452388566d7be8eaa6e..9fed1415a101a1ca7c47be7bd897b94b0557694c 100644 --- a/ansi-tests/every.lsp +++ b/ansi-tests/every.lsp @@ -279,32 +279,19 @@ ;;; Error cases (deftest every.error.1 - (signals-error (every 1 '(a b c)) type-error) - t) + (check-type-error #'(lambda (x) (every x '(a b c))) + #'(lambda (x) (typep x '(or function symbol)))) + nil) (deftest every.error.2 - (signals-error (every #\a '(a b c)) type-error) - t) + (check-type-error #'(lambda (x) (every #'null x)) + #'(lambda (x) (typep x 'sequence))) + nil) (deftest every.error.3 - (signals-error (every #() '(a b c)) type-error) - t) - -(deftest every.error.4 - (signals-error (every #'null 'a) type-error) - t) - -(deftest every.error.5 - (signals-error (every #'null 100) type-error) - t) - -(deftest every.error.6 - (signals-error (every #'null 'a) type-error) - t) - -(deftest every.error.7 - (signals-error (every #'eq () 'a) type-error) - t) + (check-type-error #'(lambda (x) (every #'eq () x)) + #'(lambda (x) (typep x 'sequence))) + nil) (deftest every.error.8 (signals-error (every) program-error) diff --git a/ansi-tests/fboundp.lsp b/ansi-tests/fboundp.lsp index 0d8eb6a1b72a4b7d1d032310b5a21f5f45622119..1ec57151c82abe69e315205d593b0b15900ce908 100644 --- a/ansi-tests/fboundp.lsp +++ b/ansi-tests/fboundp.lsp @@ -51,25 +51,42 @@ t 1) (deftest fboundp.error.1 - (signals-error (fboundp 1) type-error) - t) + (check-type-error #'fboundp #'(lambda (x) (typep x '(or symbol (cons (eql setf) (cons symbol null)))))) + nil) (deftest fboundp.error.2 - (signals-error (fboundp #\a) type-error) + (signals-type-error x '(x) (fboundp x)) t) (deftest fboundp.error.3 - (signals-error (fboundp '(foo)) type-error) + (signals-type-error x '(setf) (fboundp x)) t) (deftest fboundp.error.4 - (signals-error (fboundp) program-error) + (signals-type-error x '(setf foo . bar) (fboundp x)) t) (deftest fboundp.error.5 - (signals-error (fboundp 'cons nil) program-error) + (signals-type-error x '(setf foo bar) (fboundp x)) t) (deftest fboundp.error.6 + (signals-error (fboundp) program-error) + t) + +(deftest fboundp.error.7 + (signals-error (fboundp 'cons nil) program-error) + t) + +(deftest fboundp.error.8 (signals-error (locally (fboundp 1) t) type-error) t) + +(deftest fboundp.error.9 + (signals-type-error x '(setf . foo) (fboundp x)) + t) + +(deftest fboundp.error.10 + (check-type-error #'(lambda (x) (fboundp `(setf ,x))) + #'symbolp) + nil) diff --git a/ansi-tests/fdefinition.lsp b/ansi-tests/fdefinition.lsp index 274dd6375abfbd6f2c1f7fc9f5cdc7d9df4c6b6d..97781a491bc4a6ad596b8ddb007439577e358d59 100644 --- a/ansi-tests/fdefinition.lsp +++ b/ansi-tests/fdefinition.lsp @@ -22,8 +22,8 @@ t) (deftest fdefinition.error.4 - (signals-error (fdefinition 10) type-error :name 10) - t) + (check-type-error #'fdefinition #'(lambda (x) (typep x '(or symbol (cons (eql setf) (cons symbol null)))))) + nil) (deftest fdefinition.error.5 (let ((fn `(setf ,(gensym)))) @@ -35,6 +35,14 @@ (signals-error (locally (fdefinition 10) t) type-error) t) +(deftest fdefinition.error.7 + (check-type-error #'fdefinition (constantly nil) '((setf) (setf . foo) (setf foo . bar) (setf foo bar))) + nil) + +(deftest fdefinition.error.8 + (check-type-error #'(lambda (x) (fdefinition `(setf ,x))) #'symbolp) + nil) + ;;; Non-error cases (deftest fdefinition.1 diff --git a/ansi-tests/file-length.lsp b/ansi-tests/file-length.lsp index 73c36aa5fa7b8faa648adfcaed1ae19317834680..e087e532e95ee5333678afb27d691b61171d27b7 100644 --- a/ansi-tests/file-length.lsp +++ b/ansi-tests/file-length.lsp @@ -21,7 +21,9 @@ unless (or (typep x 'file-stream) (typep x 'broadcast-stream) (handler-case (progn (file-length x) nil) - (type-error () t) + (type-error (c) + (assert (not (typep x (type-error-expected-type c)))) + t) (condition () nil))) collect x) nil) @@ -62,10 +64,8 @@ t) (deftest file-length.error.9 - (signals-error - (let ((s (make-concatenated-stream))) - (unwind-protect (file-length s) (close s))) - type-error) + (signals-type-error s (make-concatenated-stream) + (unwind-protect (file-length s) (close s))) t) (deftest file-length.error.10 @@ -79,18 +79,14 @@ (deftest file-length.error.11 :notes (:assume-no-simple-streams :assume-no-gray-streams) - (signals-error - (let ((s (make-string-input-stream "abcde"))) - (unwind-protect (file-length s) (close s))) - type-error) + (signals-type-error s (make-string-input-stream "abcde") + (unwind-protect (file-length s) (close s))) t) (deftest file-length.error.12 :notes (:assume-no-simple-streams :assume-no-gray-streams) - (signals-error - (let ((s (make-string-output-stream))) - (unwind-protect (file-length s) (close s))) - type-error) + (signals-type-error s (make-string-output-stream) + (unwind-protect (file-length s) (close s))) t) ;;; Non-error tests diff --git a/ansi-tests/fill-pointer.lsp b/ansi-tests/fill-pointer.lsp index e12005a8ba5ad2265a44676cd4d0b3594c6ef10b..b318724b9f588f8bd9b8174224132fc4b8fdf782 100644 --- a/ansi-tests/fill-pointer.lsp +++ b/ansi-tests/fill-pointer.lsp @@ -69,13 +69,8 @@ t) (deftest fill-pointer.error.6 - (loop for e in *mini-universe* - when (and (or (not (typep e 'vector)) - (not (array-has-fill-pointer-p e))) - (not (eval `(signals-error - (fill-pointer ',e) - type-error)))) - collect (list e)) + (check-type-error #'fill-pointer #'(lambda (x) (and (vectorp x) + (array-has-fill-pointer-p x)))) nil) (deftest fill-pointer.error.7 diff --git a/ansi-tests/find-if-not.lsp b/ansi-tests/find-if-not.lsp index c774e4defb3e2c7022487c1f7a309a75ed885a33..a657e5d8e2c82bd117fb965b05393baf124c60e9 100644 --- a/ansi-tests/find-if-not.lsp +++ b/ansi-tests/find-if-not.lsp @@ -519,16 +519,8 @@ ;;; Error tests (deftest find-if-not.error.1 - (signals-error (find-if-not #'null 'b) type-error) - t) - -(deftest find-if-not.error.2 - (signals-error (find-if-not #'identity 10) type-error) - t) - -(deftest find-if-not.error.3 - (signals-error (find-if-not '1+ 1.4) type-error) - t) + (check-type-error #'(lambda (x) (find-if-not #'null x)) #'(lambda (x) (typep x 'sequence))) + nil) (deftest find-if-not.error.4 (signals-error (find-if-not 'identity '(a b c . d)) @@ -593,7 +585,7 @@ a 2 1 2) (deftest find-if-not.order.2 - (let ((i 0) a b c d e f g) + (let ((i 0) a b c d e f) (values (find-if-not (progn (setf a (incf i)) #'identity) (progn (setf b (incf i)) '(nil nil nil a nil nil)) @@ -607,7 +599,7 @@ (deftest find-if-not.order.3 - (let ((i 0) a b c d e f g) + (let ((i 0) a b c d e f) (values (find-if-not (progn (setf a (incf i)) #'identity) (progn (setf b (incf i)) '(nil nil nil a nil nil)) diff --git a/ansi-tests/find-if.lsp b/ansi-tests/find-if.lsp index 01bf0f86988d738d2d890fdbe78de0a2e1635547..04c87069c4986ea692d9bd29f7d4c0be7aeb2297 100644 --- a/ansi-tests/find-if.lsp +++ b/ansi-tests/find-if.lsp @@ -543,16 +543,8 @@ ;;; Error tests (deftest find-if.error.1 - (signals-error (find-if #'null 'b) type-error) - t) - -(deftest find-if.error.2 - (signals-error (find-if #'identity 10) type-error) - t) - -(deftest find-if.error.3 - (signals-error (find-if '1+ 1.4) type-error) - t) + (check-type-error #'(lambda (x) (find-if #'null x)) #'(lambda (x) (typep x 'sequence))) + nil) (deftest find-if.error.4 (signals-error (find-if 'null '(a b c . d)) type-error) @@ -615,7 +607,7 @@ a 2 1 2) (deftest find-if.order.2 - (let ((i 0) a b c d e f g) + (let ((i 0) a b c d e f) (values (find-if (progn (setf a (incf i)) #'null) (progn (setf b (incf i)) '(nil nil nil a nil nil)) @@ -629,7 +621,7 @@ (deftest find-if.order.3 - (let ((i 0) a b c d e f g) + (let ((i 0) a b c d e f) (values (find-if (progn (setf a (incf i)) #'null) (progn (setf b (incf i)) '(nil nil nil a nil nil)) diff --git a/ansi-tests/find.lsp b/ansi-tests/find.lsp index 803e303e2dadcee14442009e527dd764c74ea63b..9825349a527a5a71d68f470691b2a58e98a18ead 100644 --- a/ansi-tests/find.lsp +++ b/ansi-tests/find.lsp @@ -868,16 +868,8 @@ ;;; Error tests (deftest find.error.1 - (signals-error (find 'a 'b) type-error) - t) - -(deftest find.error.2 - (signals-error (find 'a 10) type-error) - t) - -(deftest find.error.3 - (signals-error (find 'a 1.4) type-error) - t) + (check-type-error #'(lambda (x) (find 'a x)) #'(lambda (x) (typep x 'sequence))) + nil) (deftest find.error.4 (signals-error (find 'e '(a b c . d)) type-error) @@ -940,7 +932,7 @@ a 2 1 2) (deftest find.order.2 - (let ((i 0) a b c d e f g) + (let ((i 0) a b c d e f) (values (find (progn (setf a (incf i)) nil) (progn (setf b (incf i)) '(nil nil nil a nil nil)) @@ -953,7 +945,7 @@ a 6 1 2 3 4 5 6) (deftest find.order.3 - (let ((i 0) a b c d e f g) + (let ((i 0) a b c d e f) (values (find (progn (setf a (incf i)) nil) (progn (setf b (incf i)) '(nil nil nil a nil nil)) diff --git a/ansi-tests/finish-output.lsp b/ansi-tests/finish-output.lsp index 08a2cf77d7ecac3d5c6d53de2f356c8a939b8b9d..f6fab14e32cdc3f78e6f13825585795b41f7fd42 100644 --- a/ansi-tests/finish-output.lsp +++ b/ansi-tests/finish-output.lsp @@ -48,12 +48,7 @@ t) (deftest finish-output.error.3 - (loop for x in *mini-universe* - unless (or (member x '(nil t)) - (typep x 'stream) - (equalt - (eval `(multiple-value-list - (signals-error (finish-output ',x) type-error))) - '(t))) - collect x) + (check-type-error #'finish-output + #'(lambda (x) (typep x '(or stream (member nil t))))) nil) + diff --git a/ansi-tests/fmakunbound.lsp b/ansi-tests/fmakunbound.lsp index 9ca7b92205bcc5fc5c3951236172450fd1574ff8..3f7200cd5c1c9b46afa149d2c3bc4c0ac3c8c8f0 100644 --- a/ansi-tests/fmakunbound.lsp +++ b/ansi-tests/fmakunbound.lsp @@ -43,15 +43,17 @@ t nil) (deftest fmakunbound.error.1 - (signals-error (fmakunbound 1) type-error) + (check-type-error #'fmakunbound + #'(lambda (x) (typep x '(or symbol (cons (eql setf) (cons symbol null)))))) t) (deftest fmakunbound.error.2 - (signals-error (fmakunbound #\a) type-error) - t) + (check-type-error #'fmakunbound (constantly nil) + '((setf) (setf . foo) (setf foo . bar) (setf foo bar))) + nil) (deftest fmakunbound.error.3 - (signals-error (fmakunbound '(x)) type-error) + (signals-type-error x '(x) (fmakunbound x)) t) (deftest fmakunbound.error.4 @@ -66,3 +68,6 @@ (signals-error (locally (fmakunbound 1) t) type-error) t) +(deftest fmakunbound.error.7 + (check-type-error #'(lambda (x) (fmakunbound `(setf ,x))) #'symbolp) + t) diff --git a/ansi-tests/force-output.lsp b/ansi-tests/force-output.lsp index f2ec4c66be9bd22ebb3529406781c8972c174376..af3584bcc18594f21ddbcd933e40d466a110fe89 100644 --- a/ansi-tests/force-output.lsp +++ b/ansi-tests/force-output.lsp @@ -49,13 +49,8 @@ t) (deftest force-output.error.3 - (loop for x in *mini-universe* - unless (or (member x '(nil t)) - (typep x 'stream) - (equalt - (eval `(multiple-value-list - (signals-error (force-output ',x) type-error))) - '(t))) - collect x) + (check-type-error #'force-output + #'(lambda (x) (typep x '(or stream (member nil t))))) nil) + diff --git a/ansi-tests/format-brace.lsp b/ansi-tests/format-brace.lsp index 8c6286c29ddf08468f19617a2bacd6e1e73314a9..6c147bd6d052f7cbfcdc3d94cae19d0ea923314f 100644 --- a/ansi-tests/format-brace.lsp +++ b/ansi-tests/format-brace.lsp @@ -308,19 +308,19 @@ ;;; Error tests (deftest format.{.error.1 - (signals-error (format nil "~{~A~}" 'A) type-error) + (signals-type-error x 'A (format nil "~{~A~}" x)) t) (deftest format.{.error.2 - (signals-error (format nil "~{~A~}" 1) type-error) + (signals-type-error x 1 (format nil "~{~A~}" x)) t) (deftest format.{.error.3 - (signals-error (format nil "~{~A~}" "foo") type-error) + (signals-type-error x "foo" (format nil "~{~A~}" x)) t) (deftest format.{.error.4 - (signals-error (format nil "~{~A~}" #*01101) type-error) + (signals-type-error x #*01101 (format nil "~{~A~}" x)) t) (deftest format.{.error.5 @@ -332,7 +332,7 @@ t) (deftest format.\:{.error.2 - (signals-error (format nil "~:{~A~}" 'x) type-error) + (signals-type-error x 'x (format nil "~:{~A~}" x)) t) (deftest format.\:{.error.3 @@ -348,19 +348,19 @@ t) (deftest format.\:@.error.1 - (signals-error (format nil "~:@{~A~}" 'x) type-error) + (signals-type-error x 'x (format nil "~:@{~A~}" x)) t) (deftest format.\:@.error.2 - (signals-error (format nil "~:@{~A~}" 0) type-error) + (signals-type-error x 0 (format nil "~:@{~A~}" x)) t) (deftest format.\:@.error.3 - (signals-error (format nil "~:@{~A~}" #*01101) type-error) + (signals-type-error x #*01101 (format nil "~:@{~A~}" x)) t) (deftest format.\:@.error.4 - (signals-error (format nil "~:@{~A~}" "abc") type-error) + (signals-type-error x "abc" (format nil "~:@{~A~}" x)) t) (deftest format.\:@.error.5 diff --git a/ansi-tests/funcall.lsp b/ansi-tests/funcall.lsp index 404a412ed3e08ec74e0d41d39627b92c55e0ddd3..5e0a3b8013a799c55e60706dd1a9146acdb734ca 100644 --- a/ansi-tests/funcall.lsp +++ b/ansi-tests/funcall.lsp @@ -101,5 +101,5 @@ t) (deftest funcall.error.7 - (signals-error (funcall #'car 'a) type-error) + (signals-type-error x 'a (funcall #'car x)) t) diff --git a/ansi-tests/gcd.lsp b/ansi-tests/gcd.lsp index 9044d7c493024f431a474feacd420f7640267760..409b07c01b7ceeea2542eec2446da40fc9014441 100644 --- a/ansi-tests/gcd.lsp +++ b/ansi-tests/gcd.lsp @@ -11,10 +11,7 @@ ;;; Error tests (deftest gcd.error.1 - (loop for x in *mini-universe* - unless (or (integerp x) - (eval `(signals-error (gcd ',x) type-error))) - collect x) + (check-type-error #'gcd #'integerp) nil) ;;; Non-error tests diff --git a/ansi-tests/gensym.lsp b/ansi-tests/gensym.lsp index 163349b3999ae9c346d0b1ce427ffa1cd995dde0..9ab82fb85e8b0307613200c10146aeb6860e603f 100644 --- a/ansi-tests/gensym.lsp +++ b/ansi-tests/gensym.lsp @@ -99,28 +99,8 @@ ;;; argument defaults to "G", with NIL causing an error. (deftest gensym.error.1 - (signals-error (gensym 'aaa) type-error) - t) - -(deftest gensym.error.2 - (signals-error (gensym 12.3) type-error) - t) - -(deftest gensym.error.3 - (signals-error (gensym t) type-error) - t) - -(deftest gensym.error.4 - (signals-error (gensym nil) type-error) ;; NIL /= no argument! - t) - -(deftest gensym.error.5 - (signals-error (gensym '(a)) type-error) - t) - -(deftest gensym.error.6 - (signals-error (gensym #\x) type-error) - t) + (check-type-error #'gensym #'(lambda (x) (typep x '(or string unsigned-byte)))) + nil) (deftest gensym.error.7 (signals-error (gensym 10 'foo) program-error) diff --git a/ansi-tests/gentemp.lsp b/ansi-tests/gentemp.lsp index 15a29cc87347879de573cd96706462151e67139d..d288c0a816752b7be7b068048fa049b87c8eb13f 100644 --- a/ansi-tests/gentemp.lsp +++ b/ansi-tests/gentemp.lsp @@ -109,7 +109,7 @@ (deftest gentemp.error.1 (loop for x in *mini-universe* unless (or (stringp x) - (eql (eval `(signals-error (gentemp ',x) type-error)) t)) + (eql (eval `(signals-type-error x ',x (gentemp x))) t)) collect x) nil) @@ -117,15 +117,10 @@ (loop for x in *mini-universe* unless (or (typep x 'package) (string-designator-p x) - (eql (eval `(signals-error (gentemp "T" ',x) type-error)) t)) + (eql (eval `(signals-type-error x ',x (gentemp "T" x))) t)) collect x) nil) (deftest gentemp.error.3 (signals-error (gentemp "" *package* nil) program-error) t) - - - - - \ No newline at end of file diff --git a/ansi-tests/get.lsp b/ansi-tests/get.lsp index 77aff2cd37a2ab9b9d21273011c58ca0e52c1b87..04eb3c767e7e39b12dd61aafd5382149309c2fd9 100644 --- a/ansi-tests/get.lsp +++ b/ansi-tests/get.lsp @@ -105,19 +105,9 @@ t) (deftest get.error.4 - (loop for x in *mini-universe* - for form = `(signals-error (get ',x :foo) type-error) - unless (or (symbolp x) (eval form)) - collect x) + (check-type-error #'(lambda (x) (get x :foo)) #'symbolp) nil) (deftest get.error.5 - (loop for x in *mini-universe* - for form = `(signals-error (setf (get ',x :foo) nil) type-error) - unless (or (symbolp x) (eval form)) - collect x) + (check-type-error #'(lambda (x) (setf (get x :foo) nil)) #'symbolp) nil) - - - - \ No newline at end of file diff --git a/ansi-tests/hash-table-rehash-size.lsp b/ansi-tests/hash-table-rehash-size.lsp index 463ccb39fe7fb4b1eb926b1c0a0a3303cf587ad4..b189b0b0ec3386640e6695876630ed7f309304cc 100644 --- a/ansi-tests/hash-table-rehash-size.lsp +++ b/ansi-tests/hash-table-rehash-size.lsp @@ -35,16 +35,5 @@ t) (deftest hash-table-rehash-size.error.3 - (loop for x in *mini-universe* - unless (hash-table-p x) - unless (eval `(signals-error (hash-table-rehash-size ',x) - type-error)) - collect x) + (check-type-error #'hash-table-rehash-size #'hash-table-p) nil) - - - - - - - diff --git a/ansi-tests/hash-table-rehash-threshold.lsp b/ansi-tests/hash-table-rehash-threshold.lsp index 83d819e5bed5fdc7b0ac5acb8129c0bb00335532..4577e63a6c09a68138462136f5f55ef618cad888 100644 --- a/ansi-tests/hash-table-rehash-threshold.lsp +++ b/ansi-tests/hash-table-rehash-threshold.lsp @@ -35,9 +35,5 @@ t) (deftest hash-table-rehash-threshold.error.3 - (loop for x in *mini-universe* - unless (hash-table-p x) - unless (eval `(signals-error (hash-table-rehash-threshold ',x) - type-error)) - collect x) + (check-type-error #'hash-table-rehash-threshold #'hash-table-p) nil) diff --git a/ansi-tests/hash-table-size.lsp b/ansi-tests/hash-table-size.lsp index e7fe8838810f3a704401d4a20bcaebb572a646bc..e486eced36d775fe401d18f7b8ac7ff1eff228b1 100644 --- a/ansi-tests/hash-table-size.lsp +++ b/ansi-tests/hash-table-size.lsp @@ -15,9 +15,5 @@ t) (deftest hash-table-size.error.3 - (loop for x in *mini-universe* - unless (hash-table-p x) - unless (eval `(signals-error (hash-table-size ',x) - type-error)) - collect x) + (check-type-error #'hash-table-size #'hash-table-p) nil) diff --git a/ansi-tests/hash-table-test.lsp b/ansi-tests/hash-table-test.lsp index 39fd5517326cf6fef77d211e69a4eae0040432e6..fea19a494d0df45e3251018a9b26f45ded93a995 100644 --- a/ansi-tests/hash-table-test.lsp +++ b/ansi-tests/hash-table-test.lsp @@ -42,8 +42,5 @@ t) (deftest hash-table-test.error.3 - (loop for x in *mini-universe* - unless (hash-table-p x) - unless (eval `(signals-error (hash-table-test ',x) type-error)) - collect x) + (check-type-error #'hash-table-test #'hash-table-p) nil) diff --git a/ansi-tests/imagpart.lsp b/ansi-tests/imagpart.lsp index 2c04af320b7c6531891bd29b4ed792f1e03c34fe..b5fdcd1370f437dfdc28b2429af692a4e8b302c2 100644 --- a/ansi-tests/imagpart.lsp +++ b/ansi-tests/imagpart.lsp @@ -14,10 +14,7 @@ t) (deftest imagpart.error.3 - (loop for x in *mini-universe* - unless (or (numberp x) - (eval `(signals-error (imagpart ',x) type-error))) - collect x) + (check-type-error #'imagpart #'numberp) nil) (deftest imagpart.1 diff --git a/ansi-tests/input-stream-p.lsp b/ansi-tests/input-stream-p.lsp index 75dbfae55cb9fd3ec9bce49b2cef3ad9e613785f..ca5f1d0a97f3f2f8251b7c174fc45555aab5d6ab 100644 --- a/ansi-tests/input-stream-p.lsp +++ b/ansi-tests/input-stream-p.lsp @@ -36,9 +36,5 @@ t) (deftest input-stream-p.error.3 - (loop for x in *mini-universe* - unless (or (typep x 'stream) - (eval `(signals-error (input-stream-p ',x) - type-error))) - collect x) + (check-type-error #'input-stream-p #'streamp) nil) diff --git a/ansi-tests/integer-length.lsp b/ansi-tests/integer-length.lsp index 7d7d786b56f2064ff13c1c631b0ea062eb3621ee..27b8a2aa00176903f57af806170fceebaeb3c90d 100644 --- a/ansi-tests/integer-length.lsp +++ b/ansi-tests/integer-length.lsp @@ -18,11 +18,7 @@ t) (deftest integer-length.error.4 - (loop for x in *mini-universe* - unless (or (integerp x) - (eval `(signals-error (integer-length ',x) - type-error))) - collect x) + (check-type-error #'integer-length #'integerp) nil) (deftest integer-length.1 diff --git a/ansi-tests/interactive-stream-p.lsp b/ansi-tests/interactive-stream-p.lsp index f8b5f642d0738fe1a446c0d214302ef9d9ad442b..e29cb0f1279f0d9027ebe1d2f571fa937a0b3986 100644 --- a/ansi-tests/interactive-stream-p.lsp +++ b/ansi-tests/interactive-stream-p.lsp @@ -15,11 +15,7 @@ nil) (deftest interactive-stream-p.error.1 - (loop for x in *mini-universe* - unless (or (typep x 'stream) - (eval `(signals-error (interactive-stream-p ',x) - type-error))) - collect x) + (check-type-error #'interactive-stream-p #'streamp) nil) (deftest interactive-stream-p.error.2 diff --git a/ansi-tests/isqrt.lsp b/ansi-tests/isqrt.lsp index 1339e120606968fbc54469febea66b27f7ea7742..e1b7dcfb94f4abd97c5abad234b1b65a8af73df0 100644 --- a/ansi-tests/isqrt.lsp +++ b/ansi-tests/isqrt.lsp @@ -28,7 +28,7 @@ (deftest isqrt.error.5 (loop for x in *mini-universe* unless (or (and (integerp x) (>= x 0)) - (eval `(signals-error (isqrt ',x) type-error))) + (eval `(signals-type-error x ',x (isqrt x)))) collect x) nil) diff --git a/ansi-tests/lcm.lsp b/ansi-tests/lcm.lsp index 3d4862dacb0bac6d0abd06f486c1b128cc43bfca..b5a85b247c16cd9cc45ad1b0bff8411269b3f348 100644 --- a/ansi-tests/lcm.lsp +++ b/ansi-tests/lcm.lsp @@ -9,10 +9,7 @@ (compile-and-load "gcd-aux.lsp") (deftest lcm.error.1 - (loop for x in *mini-universe* - unless (or (integerp x) - (eval `(signals-error (lcm ',x) type-error))) - collect x) + (check-type-error #'lcm #'integerp) nil) (deftest lcm.1 diff --git a/ansi-tests/ldiff.lsp b/ansi-tests/ldiff.lsp index 6714f63ec43385cfbac5f81ce04f17d2f467266f..d682b0f0ff97e9e5a7de9ca05199d5c548a58879 100644 --- a/ansi-tests/ldiff.lsp +++ b/ansi-tests/ldiff.lsp @@ -110,26 +110,25 @@ ;; Error checking (deftest ldiff.error.1 - (signals-error (ldiff 10 'a) type-error) + (signals-type-error x 10 (ldiff x 'a)) t) ;; Single atoms are not dotted lists, so the next ;; case should be a type-error (deftest ldiff.error.2 - (signals-error (ldiff 'a 'a) type-error) + (signals-type-error x 'a (ldiff x 'a)) t) (deftest ldiff.error.3 - (signals-error (ldiff (make-array '(10) :initial-element 'a) '(a)) - type-error) + (signals-type-error x (make-array '(10) :initial-element 'a) (ldiff x '(a))) t) (deftest ldiff.error.4 - (signals-error (ldiff 1.23 t) type-error) + (signals-type-error x 1.23 (ldiff x t)) t) (deftest ldiff.error.5 - (signals-error (ldiff #\w 'a) type-error) + (signals-type-error x #\w (ldiff x 'a)) t) (deftest ldiff.error.6 diff --git a/ansi-tests/length.lsp b/ansi-tests/length.lsp index 6b2045378b3b003d06baf8f1b03c6c0d2fe7086a..f9dcd7b57e46b817d86e5d0c57f4cf105a24eb2d 100644 Binary files a/ansi-tests/length.lsp and b/ansi-tests/length.lsp differ diff --git a/ansi-tests/list-length.lsp b/ansi-tests/list-length.lsp index aba9f3488e9d8ee3da804f9b63c4fab2a2d77d62..36031ea1e19fc7f4a345be7b813b76b6bbda3df7 100644 --- a/ansi-tests/list-length.lsp +++ b/ansi-tests/list-length.lsp @@ -43,8 +43,7 @@ (loop for x in (list 'a 1 1.0 #\w (make-array '(10)) '(a b . c) (symbol-package 'cons)) - count (not (eqt (catch-type-error (list-length x)) - 'type-error))) + count (not (eval `(signals-type-error x ',x (list-length x))))) 0) (deftest list-length.error.2 diff --git a/ansi-tests/logandc1.lsp b/ansi-tests/logandc1.lsp index f53f7a88e8509639dc82a5f5f7c6560fbaa00408..8f124ec9919567f56128c982848b613d294ac65e 100644 --- a/ansi-tests/logandc1.lsp +++ b/ansi-tests/logandc1.lsp @@ -10,17 +10,11 @@ ;;; Error tests (deftest logandc1.error.1 - (loop for x in *mini-universe* - unless (or (integerp x) - (eval `(signals-error (logandc1 ',x 0) type-error))) - collect x) + (check-type-error #'(lambda (x) (logandc1 x 0)) #'integerp) nil) (deftest logandc1.error.2 - (loop for x in *mini-universe* - unless (or (integerp x) - (eval `(signals-error (logandc1 0 ',x) type-error))) - collect x) + (check-type-error #'(lambda (x) (logandc1 0 x)) #'integerp) nil) (deftest logandc1.error.3