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