From 7413d9bf3aabadaf8b7fdf7c831539888c64b89c Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Fri, 6 May 2005 01:13:41 +0000
Subject: [PATCH] Add check-type-error, which encapsulates a common idiom. 
 Refactor many tests that use this idiom and extend signals-type-error to more
 tests.  Add more extended function name error tests.

---
 ansi-tests/acos.lsp                        |   5 +--
 ansi-tests/acosh.lsp                       |   5 +--
 ansi-tests/adjustable-array-p.lsp          |   5 +--
 ansi-tests/ansi-aux.lsp                    |  42 ++++++++++++++++-----
 ansi-tests/array-dimensions.lsp            |   5 +--
 ansi-tests/array-displacement.lsp          |   5 +--
 ansi-tests/array-rank.lsp                  |   5 +--
 ansi-tests/array-total-size.lsp            |   5 +--
 ansi-tests/ash.lsp                         |  12 ++----
 ansi-tests/asin.lsp                        |   5 +--
 ansi-tests/asinh.lsp                       |   5 +--
 ansi-tests/atan.lsp                        |  15 ++------
 ansi-tests/atanh.lsp                       |  15 +-------
 ansi-tests/boundp.lsp                      |   4 +-
 ansi-tests/cl-symbols.lsp                  |  27 +++----------
 ansi-tests/clear-input.lsp                 |   9 +----
 ansi-tests/clear-output.lsp                |  11 +-----
 ansi-tests/copy-pprint-dispatch.lsp        |   8 +---
 ansi-tests/copy-seq.lsp                    |  12 +-----
 ansi-tests/cos.lsp                         |   5 +--
 ansi-tests/cosh.lsp                        |   5 +--
 ansi-tests/count-if-not.lsp                |  12 +-----
 ansi-tests/count-if.lsp                    |  13 ++-----
 ansi-tests/count.lsp                       |  12 +-----
 ansi-tests/ctypecase.lsp                   |   6 +--
 ansi-tests/cxr.lsp                         |  16 ++++----
 ansi-tests/ecase.lsp                       |  24 ++++++------
 ansi-tests/elt.lsp                         |   2 +-
 ansi-tests/endp.lsp                        |  15 ++------
 ansi-tests/etypecase.lsp                   |   2 +-
 ansi-tests/evenp.lsp                       |  11 ++----
 ansi-tests/every.lsp                       |  31 +++++----------
 ansi-tests/fboundp.lsp                     |  29 +++++++++++---
 ansi-tests/fdefinition.lsp                 |  12 +++++-
 ansi-tests/file-length.lsp                 |  22 +++++------
 ansi-tests/fill-pointer.lsp                |   9 +----
 ansi-tests/find-if-not.lsp                 |  16 ++------
 ansi-tests/find-if.lsp                     |  16 ++------
 ansi-tests/find.lsp                        |  16 ++------
 ansi-tests/finish-output.lsp               |  11 ++----
 ansi-tests/fmakunbound.lsp                 |  13 +++++--
 ansi-tests/force-output.lsp                |  11 ++----
 ansi-tests/format-brace.lsp                |  18 ++++-----
 ansi-tests/funcall.lsp                     |   2 +-
 ansi-tests/gcd.lsp                         |   5 +--
 ansi-tests/gensym.lsp                      |  24 +-----------
 ansi-tests/gentemp.lsp                     |   9 +----
 ansi-tests/get.lsp                         |  14 +------
 ansi-tests/hash-table-rehash-size.lsp      |  13 +------
 ansi-tests/hash-table-rehash-threshold.lsp |   6 +--
 ansi-tests/hash-table-size.lsp             |   6 +--
 ansi-tests/hash-table-test.lsp             |   5 +--
 ansi-tests/imagpart.lsp                    |   5 +--
 ansi-tests/input-stream-p.lsp              |   6 +--
 ansi-tests/integer-length.lsp              |   6 +--
 ansi-tests/interactive-stream-p.lsp        |   6 +--
 ansi-tests/isqrt.lsp                       |   2 +-
 ansi-tests/lcm.lsp                         |   5 +--
 ansi-tests/ldiff.lsp                       |  11 +++---
 ansi-tests/length.lsp                      | Bin 4162 -> 3900 bytes
 ansi-tests/list-length.lsp                 |   3 +-
 ansi-tests/logandc1.lsp                    |  10 +----
 62 files changed, 216 insertions(+), 449 deletions(-)

diff --git a/ansi-tests/acos.lsp b/ansi-tests/acos.lsp
index 6821bdc0..b8f2bc2d 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 f36b38de..2af7791c 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 0279e8de..6832be79 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 6009c9c0..232a2d7a 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 f96cb845..98d94cff 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 321cb415..ad668be5 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 c86c9a7a..6126d5e3 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 3abb0822..50ab953f 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 2f57ace2..3f26369f 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 b3212bc8..7db773c5 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 ac76d259..9501c01c 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 bdef875d..54c77b0a 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 ec1f2b69..1d4adffe 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 122e0d71..84a2a270 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 52b13d10..95034a5c 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 334a659d..73c12f81 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 b03f6b87..03f0ae80 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 0f383c63..3bb4fbd6 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 f60bbf7c..8d974b12 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 c38b1b2f..3cd38f6d 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 602d0942..60b07581 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 70331c5c..ecab1f7e 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 c16577b6..9558dbf6 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 d609430a..c2d87356 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 9c07604c..0916f4d6 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 6113f87c..7fe6e9fa 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 6a42ec14..36848484 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 c0a1fb22..ff34d76e 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 76154f47..1b5323ce 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 1c212169..9a6337e4 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 37a3f6c0..4d4d1158 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 cf8b933a..9fed1415 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 0d8eb6a1..1ec57151 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 274dd637..97781a49 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 73c36aa5..e087e532 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 e12005a8..b318724b 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 c774e4de..a657e5d8 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 01bf0f86..04c87069 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 803e303e..9825349a 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 08a2cf77..f6fab14e 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 9ca7b922..3f7200cd 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 f2ec4c66..af3584bc 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 8c6286c2..6c147bd6 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 404a412e..5e0a3b80 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 9044d7c4..409b07c0 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 163349b3..9ab82fb8 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 15a29cc8..d288c0a8 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 77aff2cd..04eb3c76 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 463ccb39..b189b0b0 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 83d819e5..4577e63a 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 e7fe8838..e486eced 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 39fd5517..fea19a49 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 2c04af32..b5fdcd13 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 75dbfae5..ca5f1d0a 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 7d7d786b..27b8a2aa 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 f8b5f642..e29cb0f1 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 1339e120..e1b7dcfb 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 3d4862da..b5a85b24 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 6714f63e..d682b0f0 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
GIT binary patch
delta 76
zcmX@4ut#pgeGcp7jMU_8-IB_JRNd5~qWmHSW%ZoYy!4U`AVVW3F*hkCQ9+|ZQ$Yiy
cq(GrULA^M&urxI<IaPD=0e<Pt)?Dmt04CEJ_y7O^

delta 114
zcmdlZcSvEweU8ZvoT8ix>WP{PC6xuKljAs57>y>|a7uD27#bjn8H2>Q6b$u{1x+A=
X$}z~gO+kX(K;8Pr2>qL_IT_gi`wbnE

diff --git a/ansi-tests/list-length.lsp b/ansi-tests/list-length.lsp
index aba9f348..36031ea1 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 f53f7a88..8f124ec9 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
-- 
GitLab