From f79956b16e23c2f7227889b7a3de52f716a0abc4 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Thu, 5 May 2005 03:08:57 +0000 Subject: [PATCH] Make some checks for tyoe-errors more exacting, checking that the datum is the expected object --- ansi-tests/acos.lsp | 6 +---- ansi-tests/acosh.lsp | 2 +- ansi-tests/adjustable-array-p.lsp | 5 ++-- ansi-tests/array-dimensions.lsp | 5 ++-- ansi-tests/array-displacement.lsp | 12 ++------- ansi-tests/array-rank.lsp | 5 ++-- ansi-tests/array-total-size.lsp | 7 +++--- ansi-tests/ash.lsp | 4 +-- ansi-tests/asin.lsp | 2 +- ansi-tests/asinh.lsp | 2 +- ansi-tests/assoc-if-not.lsp | 8 +++--- ansi-tests/assoc-if.lsp | 8 +++--- ansi-tests/assoc.lsp | 2 +- ansi-tests/atan.lsp | 6 ++--- ansi-tests/atanh.lsp | 2 +- ansi-tests/boole.lsp | 6 ++--- ansi-tests/boundp.lsp | 8 +++--- ansi-tests/ccase.lsp | 38 ++++++++--------------------- ansi-tests/char-aux.lsp | 2 ++ ansi-tests/check-type.lsp | 30 ++++++++++++++++------- ansi-tests/cl-symbols.lsp | 14 +++++------ ansi-tests/clear-input.lsp | 4 +-- ansi-tests/clear-output.lsp | 2 +- ansi-tests/copy-pprint-dispatch.lsp | 4 +-- ansi-tests/copy-seq.lsp | 8 +++--- ansi-tests/cos.lsp | 2 +- ansi-tests/cosh.lsp | 2 +- ansi-tests/count-if-not.lsp | 6 ++--- ansi-tests/count-if.lsp | 6 ++--- ansi-tests/count.lsp | 6 ++--- ansi-tests/ctypecase.lsp | 12 +++++---- ansi-tests/cxr.lsp | 4 +-- 32 files changed, 101 insertions(+), 129 deletions(-) diff --git a/ansi-tests/acos.lsp b/ansi-tests/acos.lsp index 06751884..6821bdc0 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 4c59d3ed..f36b38de 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 99399536..0279e8de 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 4960927d..f96cb845 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 53bb7634..321cb415 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 303c9da5..c86c9a7a 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 00a13cb2..3abb0822 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 17071640..2f57ace2 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 d81400ce..b3212bc8 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 f5f77c8a..ac76d259 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 4ae14aa9..05daecb5 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 6348f604..249336e2 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 8915ccf7..7fae17b3 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 040c13aa..bdef875d 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 08686c15..ec1f2b69 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 14fa005a..d0ae5920 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 1f25b183..122e0d71 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 da1cae80..24e75d78 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 04d78ff4..c75e9aba 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 a2f2befa..4b448594 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 e1d4f917..52b13d10 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 7d9f1133..334a659d 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 d3650c1c..b03f6b87 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 8c16a668..0f383c63 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 51077144..f60bbf7c 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 cec1cf7c..c38b1b2f 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 10fb6513..602d0942 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 2119f981..70331c5c 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 9cb6a206..c16577b6 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 68de228e..d609430a 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 fb344043..9c07604c 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 a1d936ea..6113f87c 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 -- GitLab