diff --git a/ansi-tests/acos.lsp b/ansi-tests/acos.lsp index 06751884ad9ec79a0fd6fc4f0dccaad9ca6b0d77..6821bdc0d4b181d15fafa1b52dd23b8c2470a7b9 100644 --- a/ansi-tests/acos.lsp +++ b/ansi-tests/acos.lsp @@ -94,10 +94,6 @@ (deftest acos.error.3 (loop for x in *mini-universe* unless (or (numberp x) - (eval `(signals-error (acos ',x) type-error))) + (eval `(signals-type-error x ',x (acos x)))) collect x) nil) - - - - diff --git a/ansi-tests/acosh.lsp b/ansi-tests/acosh.lsp index 4c59d3eda3a9f7ddcd1cf77fa113a062dd20d593..f36b38de1b9f63ebd9f00367e26facac36be0207 100644 --- a/ansi-tests/acosh.lsp +++ b/ansi-tests/acosh.lsp @@ -84,7 +84,7 @@ (deftest acosh.error.3 (loop for x in *mini-universe* unless (or (numberp x) - (eval `(signals-error (acosh ',x) type-error))) + (eval `(signals-type-error x ',x (acosh x)))) collect x) nil) diff --git a/ansi-tests/adjustable-array-p.lsp b/ansi-tests/adjustable-array-p.lsp index 99399536229a57f69a822194b8f537478f1f102d..0279e8de36602801287b06f41c1fb68057d8775a 100644 --- a/ansi-tests/adjustable-array-p.lsp +++ b/ansi-tests/adjustable-array-p.lsp @@ -44,14 +44,13 @@ t) (deftest adjustable-array-p.error.3 - (signals-error (adjustable-array-p 10) type-error) + (signals-type-error x 10 (adjustable-array-p x)) t) (deftest adjustable-array-p.error.4 (loop for e in *mini-universe* unless (or (typep e 'array) - (eval `(signals-error (adjustable-array-p ',e) - type-error))) + (eval `(signals-type-error x ',e (adjustable-array-p x)))) collect e) nil) diff --git a/ansi-tests/array-dimensions.lsp b/ansi-tests/array-dimensions.lsp index 4960927dfffb1ea06ba02f3222063438832d4d98..f96cb8451d7ec19fd209ec54b8f2a0a0793c1e38 100644 --- a/ansi-tests/array-dimensions.lsp +++ b/ansi-tests/array-dimensions.lsp @@ -53,13 +53,12 @@ (deftest array-dimensions.error.3 (loop for e in *mini-universe* unless (or (typep e 'array) - (eval `(signals-error (array-dimensions ',e) - type-error))) + (eval `(signals-type-error x ',e (array-dimensions x)))) collect e) nil) (deftest array-dimensions.error.4 - (signals-error (array-dimensions nil) type-error) + (signals-type-error x nil (array-dimensions x)) t) (deftest array-dimensions.error.5 diff --git a/ansi-tests/array-displacement.lsp b/ansi-tests/array-displacement.lsp index 53bb763468084ec54fa4bf8b613787107018342c..321cb41515fb1c18de136476694102e1f2e55734 100644 --- a/ansi-tests/array-displacement.lsp +++ b/ansi-tests/array-displacement.lsp @@ -118,18 +118,10 @@ (deftest array-displacement.error.3 (loop for e in *mini-universe* unless (or (typep e 'array) - (eval `(signals-error (array-displacement ',e) - type-error))) + (eval `(signals-type-error x ',e (array-displacement ',e)))) collect e) nil) (deftest array-displacement.error.4 - (signals-error (array-displacement nil) type-error) + (signals-type-error x nil (array-displacement x)) t) - -(deftest array-displacement.error.5 - (signals-error (let ((x nil)) (array-displacement x)) - type-error) - t) - - diff --git a/ansi-tests/array-rank.lsp b/ansi-tests/array-rank.lsp index 303c9da564438c2bb7bd6f72bb9ad5403908e2a4..c86c9a7ae766e812b3f188e361293a469f42221f 100644 --- a/ansi-tests/array-rank.lsp +++ b/ansi-tests/array-rank.lsp @@ -38,7 +38,7 @@ (deftest array-rank.error.3 (loop for e in *mini-universe* unless (or (typep e 'array) - (eval `(signals-error (array-rank ',e) type-error))) + (eval `(signals-type-error x ',e (array-rank x)))) collect e) nil) @@ -47,6 +47,5 @@ t) (deftest array-rank.error.5 - (signals-error (locally (array-rank nil) t) - type-error) + (signals-type-error x nil (locally (array-rank x) t)) t) diff --git a/ansi-tests/array-total-size.lsp b/ansi-tests/array-total-size.lsp index 00a13cb2899a8ad66b2f2787b08a227580dc099c..3abb0822e41e8ac8fe09a5b13b8a33a411e24874 100644 --- a/ansi-tests/array-total-size.lsp +++ b/ansi-tests/array-total-size.lsp @@ -47,8 +47,7 @@ (deftest array-total-size.error.3 (loop for e in *mini-universe* unless (or (typep e 'array) - (eval `(signals-error (array-total-size ',e) - type-error))) + (eval `(signals-type-error x ',e (array-total-size ',e)))) collect e) nil) @@ -57,6 +56,6 @@ t) (deftest array-total-size.error.5 - (signals-error (locally (array-total-size 0) t) - type-error) + (signals-type-error x 0 (locally (array-total-size x) t)) t) + diff --git a/ansi-tests/ash.lsp b/ansi-tests/ash.lsp index 170716402c6329380a41458db3de2b1b9787e848..2f57ace2847482b760a8eb688ad6449148a67e71 100644 --- a/ansi-tests/ash.lsp +++ b/ansi-tests/ash.lsp @@ -22,14 +22,14 @@ (deftest ash.error.4 (loop for x in *mini-universe* unless (or (integerp x) - (eval `(signals-error (ash ',x 0) type-error))) + (eval `(signals-type-error x ',x (ash x 0)))) collect x) nil) (deftest ash.error.5 (loop for x in *mini-universe* unless (or (integerp x) - (eval `(signals-error (ash 0 ',x) type-error))) + (eval `(signals-type-error x ',x (ash 0 x)))) collect x) nil) diff --git a/ansi-tests/asin.lsp b/ansi-tests/asin.lsp index d81400ce9ce5086868271ff16125a3213fffc252..b3212bc8872b7056f312fbcc7ef3ad9c50e60f3a 100644 --- a/ansi-tests/asin.lsp +++ b/ansi-tests/asin.lsp @@ -94,7 +94,7 @@ (deftest asin.error.3 (loop for x in *mini-universe* unless (or (numberp x) - (eval `(signals-error (asin ',x) type-error))) + (eval `(signals-type-error x ',x (asin x)))) collect x) nil) diff --git a/ansi-tests/asinh.lsp b/ansi-tests/asinh.lsp index f5f77c8aa70c07a92aac663802cf42d7b3835af0..ac76d2592b3d6904a8db0f714eb1c57c8a0a8969 100644 --- a/ansi-tests/asinh.lsp +++ b/ansi-tests/asinh.lsp @@ -82,7 +82,7 @@ (deftest asinh.error.3 (loop for x in *mini-universe* unless (or (numberp x) - (eval `(signals-error (asinh ',x) type-error))) + (eval `(signals-type-error x ',x (asinh x)))) collect x) nil) diff --git a/ansi-tests/assoc-if-not.lsp b/ansi-tests/assoc-if-not.lsp index 4ae14aa9d5f4e91ff70b1a9adb674c477623b4da..05daecb5f2c988a560efcf35de984a734a4d2024 100644 --- a/ansi-tests/assoc-if-not.lsp +++ b/ansi-tests/assoc-if-not.lsp @@ -137,13 +137,11 @@ t) (deftest assoc-if-not.error.9 - (signals-error (assoc-if-not #'car '((a b)(c d))) - type-error) + (signals-type-error x 'a (assoc-if-not #'car '((a b)(c d)))) t) (deftest assoc-if-not.error.10 - (signals-error (assoc-if-not #'identity '((a b)(c d)) :key #'car) - type-error) + (signals-type-error x 'a (assoc-if-not #'identity '((a b)(c d)) :key #'car)) t) (deftest assoc-if-not.error.11 @@ -157,5 +155,5 @@ t) (deftest assoc-if-not.error.13 - (signals-error (assoc-if-not #'identity 'y) type-error) + (signals-type-error x 'y (assoc-if-not #'identity x)) t) diff --git a/ansi-tests/assoc-if.lsp b/ansi-tests/assoc-if.lsp index 6348f604099147ac553f7b45b4faaa3dc4cc16fc..249336e273897f421cb6f8db857d69c8171be60d 100644 --- a/ansi-tests/assoc-if.lsp +++ b/ansi-tests/assoc-if.lsp @@ -140,13 +140,11 @@ t) (deftest assoc-if.error.9 - (signals-error (assoc-if #'car '((a b)(c d))) - type-error) + (signals-type-error x 'a (assoc-if #'car '((a b)(c d)))) t) (deftest assoc-if.error.10 - (signals-error (assoc-if #'identity '((a b)(c d)) :key #'car) - type-error) + (signals-type-error x 'a (assoc-if #'identity '((a b)(c d)) :key #'car)) t) (deftest assoc-if.error.11 @@ -160,5 +158,5 @@ t) (deftest assoc-if.error.13 - (signals-error (assoc-if #'null 'y) type-error) + (signals-type-error x 'y (assoc-if #'null x)) t) diff --git a/ansi-tests/assoc.lsp b/ansi-tests/assoc.lsp index 8915ccf77c0a149114c239ff8aa7355de2afb313..7fae17b370068c9bda7effc6bcdb1bf3d3694b26 100644 --- a/ansi-tests/assoc.lsp +++ b/ansi-tests/assoc.lsp @@ -292,6 +292,6 @@ t) (deftest assoc.error.12 - (signals-error (assoc 'x 'y) type-error) + (signals-type-error x 'y (assoc 'x x)) t) diff --git a/ansi-tests/atan.lsp b/ansi-tests/atan.lsp index 040c13aadec4d31e4d0d8dd5ea89b9331362a1f1..bdef875d7aa5c823f2f09770a777950c91e0cb79 100644 --- a/ansi-tests/atan.lsp +++ b/ansi-tests/atan.lsp @@ -135,21 +135,21 @@ (deftest atan.error.3 (loop for x in *mini-universe* unless (or (numberp x) - (eval `(signals-error (atan ',x) type-error))) + (eval `(signals-type-error x ',x (atan x)))) collect x) nil) (deftest atan.error.4 (loop for x in *mini-universe* unless (or (realp x) - (eval `(signals-error (atan ',x 1) type-error))) + (eval `(signals-type-error x ',x (atan x 1)))) collect x) nil) (deftest atan.error.5 (loop for x in *mini-universe* unless (or (realp x) - (eval `(signals-error (atan 1 ',x) type-error))) + (eval `(signals-type-error x ',x (atan 1 x)))) collect x) nil) diff --git a/ansi-tests/atanh.lsp b/ansi-tests/atanh.lsp index 08686c158bd65397ae3cf4fddecfe70866cf0c86..ec1f2b695c70b48742736601c51ad39b57d2d6ad 100644 --- a/ansi-tests/atanh.lsp +++ b/ansi-tests/atanh.lsp @@ -111,7 +111,7 @@ (deftest atanh.error.3 (loop for x in *mini-universe* unless (or (numberp x) - (eval `(signals-error (atanh ',x) type-error))) + (eval `(signals-type-error x ',x (atanh x)))) collect x) nil) diff --git a/ansi-tests/boole.lsp b/ansi-tests/boole.lsp index 14fa005a9dcb1c3a52e222fed2efb62956820dd0..d0ae592003a848b11b5f47d8101d65660dd54f81 100644 --- a/ansi-tests/boole.lsp +++ b/ansi-tests/boole.lsp @@ -53,18 +53,18 @@ (deftest boole.error.5 (let ((bad (loop for i from 1 until (not (member i *boole-vals*))))) - (eval `(signals-error (boole ,bad 1 1) type-error))) + (eval `(signals-type-error x ',bad (boole x 1 1)))) t) (deftest boole.error.6 (loop for n in *boole-val-names* - unless (eval `(signals-error (boole ,n nil 1) type-error)) + unless (eval `(signals-type-error x nil (boole ,n nil 1))) collect n) nil) (deftest boole.error.7 (loop for n in *boole-val-names* - unless (eval `(signals-error (boole ,n 1 nil) type-error)) + unless (eval `(signals-type-error x nil (boole ,n 1 nil))) collect n) nil) diff --git a/ansi-tests/boundp.lsp b/ansi-tests/boundp.lsp index 1f25b183a14febeae53cac31280c3c60f28add8f..122e0d7129e9c88af7ab47f312e3338522c9bac7 100644 --- a/ansi-tests/boundp.lsp +++ b/ansi-tests/boundp.lsp @@ -14,19 +14,19 @@ t) (deftest boundp.error.3 - (signals-error (boundp 1) type-error) + (signals-type-error x 1 (boundp 1)) t) (deftest boundp.error.4 - (signals-error (boundp '(setf car)) type-error) + (signals-type-error x '(setf car) (boundp x)) t) (deftest boundp.error.5 - (signals-error (boundp "abc") type-error) + (signals-type-error x "abc" (boundp x)) t) (deftest boundp.error.6 - (signals-error (locally (boundp "abc") t) type-error) + (signals-type-error x "abc" (locally (boundp x) t)) t) ;;; See other tests in cl-symbols.lsp diff --git a/ansi-tests/ccase.lsp b/ansi-tests/ccase.lsp index da1cae80cb431dbf60a9d9fc3720081ab2b0fdf5..24e75d7817aab340ef486cbc9800ec0a83c2a55c 100644 --- a/ansi-tests/ccase.lsp +++ b/ansi-tests/ccase.lsp @@ -11,28 +11,22 @@ 2) (deftest ccase.2 - (signals-error (let ((x 1)) (ccase x)) type-error) + (signals-type-error x 1 (ccase x)) t) (deftest ccase.3 - (signals-error - (let ((x 1))(ccase x (a 1) (b 2) (c 3))) - type-error) + (signals-type-error x 1 (ccase x (a 1) (b 2) (c 3))) t) ;;; It is legal to use T or OTHERWISE as key designators ;;; in CCASE forms. They have no special meaning here. (deftest ccase.4 - (signals-error - (let ((x 1)) (ccase x (t nil))) - type-error) + (signals-type-error x 1 (ccase x (t nil))) t) (deftest ccase.5 - (signals-error - (let ((x 1)) (ccase x (otherwise nil))) - type-error) + (signals-type-error x 1 (ccase x (otherwise nil))) t) (deftest ccase.6 @@ -54,9 +48,7 @@ a) (deftest ccase.9 - (signals-error - (let (x) (ccase x (nil 'a))) - type-error) + (signals-type-error x nil (ccase x (nil 'a))) t) (deftest ccase.10 @@ -70,9 +62,7 @@ 1 2 3) (deftest ccase.12 - (signals-error - (let ((x t)) (ccase x (a 10))) - type-error) + (signals-type-error x t (ccase x (a 10))) t) (deftest ccase.13 @@ -86,27 +76,19 @@ 1) (deftest ccase.15 - (signals-error - (let ((x 'otherwise)) (ccase x ((t) 10))) - type-error) + (signals-type-error x 'otherwise (ccase x ((t) 10))) t) (deftest ccase.16 - (signals-error - (let ((x t)) (ccase x ((otherwise) 10))) - type-error) + (signals-type-error x t (ccase x ((otherwise) 10))) t) (deftest ccase.17 - (signals-error - (let ((x 'a)) (ccase x (b 0) (c 1) (otherwise 2))) - type-error) + (signals-type-error x 'a (ccase x (b 0) (c 1) (otherwise 2))) t) (deftest ccase.19 - (signals-error - (let ((x 'a)) (ccase x (b 0) (c 1) ((t) 2))) - type-error) + (signals-type-error x 'a (ccase x (b 0) (c 1) ((t) 2))) t) (deftest ccase.20 diff --git a/ansi-tests/char-aux.lsp b/ansi-tests/char-aux.lsp index 04d78ff42ead12d1a0331a38034878181ac90dfb..c75e9abac842f05ee4352858bf20a5681fb214c1 100644 --- a/ansi-tests/char-aux.lsp +++ b/ansi-tests/char-aux.lsp @@ -56,6 +56,8 @@ (declare (type function fn)) (loop for x in *universe* always (or (characterp x) + ;; FIXME -- catch the type error and check that datum + ;; is eql to x (and that datum is not in the expected type) (eqt (catch-type-error (funcall fn x)) 'type-error))))) (defun standard-char.5.body () diff --git a/ansi-tests/check-type.lsp b/ansi-tests/check-type.lsp index a2f2befae52b3e23b3320255ffe0ae4cdab74d6a..4b448594c26f8248832fef77ce3ddc6c7a5b0f67 100644 --- a/ansi-tests/check-type.lsp +++ b/ansi-tests/check-type.lsp @@ -11,16 +11,17 @@ nil a) (deftest check-type.2 - (signals-error - (let ((x 'a)) - (check-type x integer)) - type-error) + (signals-type-error x 'a (check-type x integer)) t) (deftest check-type.3 (let ((x 'a)) (handler-bind - ((type-error #'(lambda (c) (store-value 15 c)))) + ((type-error #'(lambda (c) + (assert (eql (type-error-datum c) x)) + (assert (not (typep x (type-error-expected-type c)))) + ;; Can we assume the expected-type is NUMBER? + (store-value 15 c)))) (values (check-type x number) x))) nil 15) @@ -32,21 +33,32 @@ (deftest check-type.5 (let ((x 'a)) (handler-bind - ((type-error #'(lambda (c) (store-value "abc" c)))) + ((type-error #'(lambda (c) + (assert (eql (type-error-datum c) x)) + (assert (not (typep x (type-error-expected-type c)))) + ;; Can we assume the expected-type is STRING? + (store-value "abc" c)))) (values (check-type x string "a string") x))) nil "abc") (deftest check-type.6 (let ((x 'a)) (handler-bind - ((type-error #'(lambda (c) (declare (ignore c)) (store-value 15 nil)))) + ((type-error #'(lambda (c) + (assert (eql (type-error-datum c) x)) + (assert (not (typep x (type-error-expected-type c)))) + ;; Can we assume the expected-type is NUMBER? + (store-value 15 nil)))) (values (check-type x number) x))) nil 15) (deftest check-type.7 (let ((x 'a)) (handler-bind - ((type-error #'(lambda (c) (declare (ignore c)) (store-value 15)))) + ((type-error #'(lambda (c) + (assert (eql (type-error-datum c) x)) + (assert (not (typep x (type-error-expected-type c)))) + ;; Can we assume the expected-type is NUMBER? + (store-value 15)))) (values (check-type x number) x))) nil 15) - diff --git a/ansi-tests/cl-symbols.lsp b/ansi-tests/cl-symbols.lsp index e1d4f91740796059a793232eb6d9c42f88bb017d..52b13d10bc2633413cc3b7e807bd9758707b1131 100644 --- a/ansi-tests/cl-symbols.lsp +++ b/ansi-tests/cl-symbols.lsp @@ -1147,7 +1147,7 @@ (deftest symbol-package.error.3 (loop for x in *mini-universe* - for form = `(signals-error (symbol-package ',x) type-error) + for form = `(signals-type-error x ',x (symbol-package x)) unless (or (symbolp x) (eval form)) collect x) nil) @@ -1163,16 +1163,15 @@ (deftest symbol-plist.error.3 (loop for x in *mini-universe* - for form = `(signals-error (symbol-plist ',x) type-error) + for form = `(signals-type-error x ',x (symbol-plist x)) unless (or (symbolp x) (eval form)) collect x) nil) (deftest symbol-plist.error.4 (loop for x in *mini-universe* - for form = `(signals-error (setf (symbol-plist ',x) - (find-package "CL-USER")) - type-error) + for form = `(signals-type-error x ',x (setf (symbol-plist x) + (find-package "CL-USER"))) unless (or (symbolp x) (eval form)) collect x) nil) @@ -1189,15 +1188,14 @@ (deftest symbol-value.error.3 (loop for x in *mini-universe* - for form = `(signals-error (symbol-value ',x) type-error) + for form = `(signals-type-error x ',x (symbol-value x)) unless (or (symbolp x) (eval form)) collect x) nil) (deftest symbol-value.error.4 (loop for x in *mini-universe* - for form = `(signals-error (setf (symbol-value ',x) nil) - type-error) + for form = `(signals-type-error x ',x (setf (symbol-value x) nil)) unless (or (symbolp x) (eval form)) collect x) nil) diff --git a/ansi-tests/clear-input.lsp b/ansi-tests/clear-input.lsp index 7d9f1133ee5ef83140588c091f094b2372198f9d..334a659d3343f860b647463f031e7328513e3088 100644 --- a/ansi-tests/clear-input.lsp +++ b/ansi-tests/clear-input.lsp @@ -65,9 +65,7 @@ (typep x 'stream) (equalt (eval `(multiple-value-list - (signals-error (clear-input ',x) type-error))) + (signals-type-error x ',x (clear-input x)))) '(t))) collect x) nil) - - diff --git a/ansi-tests/clear-output.lsp b/ansi-tests/clear-output.lsp index d3650c1ccf7ea14d7120a2822a19176251089c14..b03f6b87de7b8a98afe9f98ec48f28e32a1d4ea5 100644 --- a/ansi-tests/clear-output.lsp +++ b/ansi-tests/clear-output.lsp @@ -54,7 +54,7 @@ (typep x 'stream) (equalt (eval `(multiple-value-list - (signals-error (clear-output ',x) type-error))) + (signals-type-error x ',x (clear-output x)))) '(t))) collect x) nil) diff --git a/ansi-tests/copy-pprint-dispatch.lsp b/ansi-tests/copy-pprint-dispatch.lsp index 8c16a668c6e6b8af228c07219313ee29fd3c960a..0f383c632b12331f492d1d7add4cef963b789269 100644 --- a/ansi-tests/copy-pprint-dispatch.lsp +++ b/ansi-tests/copy-pprint-dispatch.lsp @@ -122,9 +122,9 @@ (deftest copy-pprint-dispatch.error.2 (loop for x in *mini-universe* for results = (multiple-value-list - (eval `(signals-error (copy-pprint-dispatch ',x) - type-error))) + (eval `(signals-type-error x ',x (copy-pprint-dispatch x)))) unless (or (null x) (equal results '(t))) collect (list x results)) nil) + diff --git a/ansi-tests/copy-seq.lsp b/ansi-tests/copy-seq.lsp index 510771446d1cc7a28f11d0ffae7110af91bea6df..f60bbf7cd144bf16d93fab43f10b08dcc8121056 100644 --- a/ansi-tests/copy-seq.lsp +++ b/ansi-tests/copy-seq.lsp @@ -230,15 +230,15 @@ ;;; Error tests (deftest copy-seq.error.1 - (signals-error (copy-seq 10) type-error) + (signals-type-error x 10 (copy-seq x)) t) (deftest copy-seq.error.2 - (signals-error (copy-seq 'a) type-error) + (signals-type-error x 'a (copy-seq x)) t) (deftest copy-seq.error.3 - (signals-error (copy-seq 13.21) type-error) + (signals-type-error x 13.21 (copy-seq x)) t) (deftest copy-seq.error.4 @@ -252,5 +252,3 @@ (deftest copy-seq.error.6 (signals-error (locally (copy-seq 10) t) type-error) t) - - diff --git a/ansi-tests/cos.lsp b/ansi-tests/cos.lsp index cec1cf7c9d049e3a7cde00879c77d351b4640cf9..c38b1b2fa19de3130c228acd085b7c8ad1aaa147 100644 --- a/ansi-tests/cos.lsp +++ b/ansi-tests/cos.lsp @@ -169,7 +169,7 @@ (deftest cos.error.3 (loop for x in *mini-universe* unless (or (numberp x) - (eval `(signals-error (cos ',x) type-error))) + (eval `(signals-type-error x ',x (cos x)))) collect x) nil) diff --git a/ansi-tests/cosh.lsp b/ansi-tests/cosh.lsp index 10fb651302ee0a153b69dfbd5c2e5c59aa1890e7..602d09421b04d56457252239ffa836e4674f09fc 100644 --- a/ansi-tests/cosh.lsp +++ b/ansi-tests/cosh.lsp @@ -84,7 +84,7 @@ (deftest cosh.error.3 (loop for x in *mini-universe* unless (or (numberp x) - (eval `(signals-error (cosh ',x) type-error))) + (eval `(signals-type-error x ',x (cosh x)))) collect x) nil) diff --git a/ansi-tests/count-if-not.lsp b/ansi-tests/count-if-not.lsp index 2119f981ae3b068ea36b85f7f39ae5a06e153138..70331c5c2f5cea583817b3668df1f85b6f929f66 100644 --- a/ansi-tests/count-if-not.lsp +++ b/ansi-tests/count-if-not.lsp @@ -525,15 +525,15 @@ ;;; Error tests (deftest count-if-not.error.1 - (signals-error (count-if-not #'identity 1) type-error) + (signals-type-error x 1 (count-if-not #'identity x)) t) (deftest count-if-not.error.2 - (signals-error (count-if-not #'identity 'a) type-error) + (signals-type-error x 'a (count-if-not #'identity x)) t) (deftest count-if-not.error.3 - (signals-error (count-if-not #'identity #\a) type-error) + (signals-type-error x #\a (count-if-not #'identity x)) t) (deftest count-if-not.error.4 diff --git a/ansi-tests/count-if.lsp b/ansi-tests/count-if.lsp index 9cb6a2062387f8d9a98aefdc198e922bba793c36..c16577b6f136ad36fd355095a0af9ae53750fa30 100644 --- a/ansi-tests/count-if.lsp +++ b/ansi-tests/count-if.lsp @@ -524,15 +524,15 @@ ;;; Error tests (deftest count-if.error.1 - (signals-error (count-if #'identity 1) type-error) + (signals-type-error x 1 (count-if #'identity x)) t) (deftest count-if.error.2 - (signals-error (count-if #'identity 'a) type-error) + (signals-type-error x 'a (count-if #'identity x)) t) (deftest count-if.error.3 - (signals-error (count-if #'identity #\a) type-error) + (signals-type-error x #\a (count-if #'identity x)) t) (deftest count-if.error.4 diff --git a/ansi-tests/count.lsp b/ansi-tests/count.lsp index 68de228e3af2f01655e1766cc08c4542a96574a6..d609430a980416a550b793a7a27d6f0600ca9fd1 100644 --- a/ansi-tests/count.lsp +++ b/ansi-tests/count.lsp @@ -653,15 +653,15 @@ ;;; Error tests (deftest count.error.1 - (signals-error (count 'a 1) type-error) + (signals-type-error x 1 (count 'a x)) t) (deftest count.error.2 - (signals-error (count 'a 'a) type-error) + (signals-type-error x 'a (count 'a x)) t) (deftest count.error.3 - (signals-error (count 'a #\a) type-error) + (signals-type-error x #\a (count 'a x)) t) (deftest count.error.4 diff --git a/ansi-tests/ctypecase.lsp b/ansi-tests/ctypecase.lsp index fb344043de4fa6cf84afd1e982b5973b18134320..9c07604c8aece3947d971cc19e42f65cb8881116 100644 --- a/ansi-tests/ctypecase.lsp +++ b/ansi-tests/ctypecase.lsp @@ -11,10 +11,9 @@ a) (deftest ctypecase.2 - (signals-error - (let ((x 1)) - (ctypecase x (symbol 'a))) - type-error) + (signals-type-error + x 1 + (ctypecase x (symbol 'a))) t) (deftest ctypecase.3 @@ -69,7 +68,10 @@ (let ((x 1)) (values (handler-bind - ((type-error #'(lambda (c) (store-value 'a c)))) + ((type-error #'(lambda (c) + (assert (eql (type-error-datum c) 1)) + (assert (not (typep 1 (type-error-expected-type c)))) + (store-value 'a c)))) (ctypecase x (symbol :good) (float :bad))) diff --git a/ansi-tests/cxr.lsp b/ansi-tests/cxr.lsp index a1d936ea1167c27fed2390c49e5cb0ce58415abd..6113f87cc64cb3303e8cb10399800bd4c8a96464 100644 --- a/ansi-tests/cxr.lsp +++ b/ansi-tests/cxr.lsp @@ -149,7 +149,7 @@ nil) (deftest car-symbol-error - (signals-error (car 'a) type-error) + (signals-type-error x 'a (car x)) t) (deftest car-symbol-error.2 @@ -175,7 +175,7 @@ (b) 1) (deftest cdr-symbol-error - (signals-error (cdr 'a) type-error) + (signals-type-error x 'a (cdr x)) t) (deftest cdr-symbol-error.2