From e30ff5572e85f969e28fc3aa20cab051d31f6905 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Fri, 6 May 2005 13:34:42 +0000
Subject: [PATCH] More type error refactoring

---
 ansi-tests/ansi-aux.lsp              | 11 ++++++
 ansi-tests/intersection.lsp          |  8 +++++
 ansi-tests/logand.lsp                | 14 ++++----
 ansi-tests/logandc2.lsp              | 10 ++----
 ansi-tests/logbitp.lsp               |  9 ++---
 ansi-tests/logcount.lsp              |  5 +--
 ansi-tests/logeqv.lsp                | 10 ++----
 ansi-tests/logical-pathname.lsp      |  9 ++---
 ansi-tests/logior.lsp                | 10 ++----
 ansi-tests/lognand.lsp               | 10 ++----
 ansi-tests/lognor.lsp                | 10 ++----
 ansi-tests/lognot.lsp                |  5 +--
 ansi-tests/logorc1.lsp               | 10 ++----
 ansi-tests/logorc2.lsp               | 10 ++----
 ansi-tests/logtest.lsp               | 10 ++----
 ansi-tests/logxor.lsp                | 10 ++----
 ansi-tests/make-broadcast-stream.lsp | 20 +++--------
 ansi-tests/make-list.lsp             |  8 ++---
 ansi-tests/make-random-state.lsp     |  5 +--
 ansi-tests/make-symbol.lsp           | 34 ++-----------------
 ansi-tests/make-synonym-stream.lsp   |  6 +---
 ansi-tests/make-two-way-stream.lsp   | 38 ++++++---------------
 ansi-tests/makunbound.lsp            |  6 +---
 ansi-tests/map-into.lsp              | 10 +++---
 ansi-tests/map.lsp                   | 12 +++++++
 ansi-tests/mapc.lsp                  |  4 +--
 ansi-tests/mapcan.lsp                |  4 +--
 ansi-tests/mapcar.lsp                |  4 +--
 ansi-tests/mapcon.lsp                |  4 +--
 ansi-tests/mapl.lsp                  |  4 +--
 ansi-tests/maplist.lsp               |  4 +--
 ansi-tests/max.lsp                   |  9 ++---
 ansi-tests/member-if-not.lsp         |  4 +--
 ansi-tests/member-if.lsp             |  4 +--
 ansi-tests/member.lsp                |  4 +--
 ansi-tests/min.lsp                   | 10 ++----
 ansi-tests/minusp.lsp                |  5 +--
 ansi-tests/nintersection.lsp         |  7 ++++
 ansi-tests/notany.lsp                | 29 ++++------------
 ansi-tests/notevery.lsp              | 29 ++++------------
 ansi-tests/nreconc.lsp               |  4 +++
 ansi-tests/nreverse.lsp              | 20 ++---------
 ansi-tests/nset-difference.lsp       |  7 ++++
 ansi-tests/nset-exclusive-or.lsp     |  8 +++++
 ansi-tests/nsublis.lsp               |  4 +++
 ansi-tests/nsubstitute-if-not.lsp    |  3 ++
 ansi-tests/nsubstitute-if.lsp        |  3 ++
 ansi-tests/nsubstitute.lsp           |  3 ++
 ansi-tests/nthcdr.lsp                | 20 ++---------
 ansi-tests/nunion.lsp                |  8 +++++
 ansi-tests/oddp.lsp                  |  5 +--
 ansi-tests/open-stream-p.lsp         |  5 +--
 ansi-tests/output-stream-p.lsp       |  5 +--
 ansi-tests/package-name.lsp          |  3 ++
 ansi-tests/package-nicknames.lsp     |  5 +++
 ansi-tests/pairlis.lsp               |  7 ++++
 ansi-tests/pathname-device.lsp       |  7 +---
 ansi-tests/pathname-directory.lsp    |  7 +---
 ansi-tests/pathname-host.lsp         |  8 +----
 ansi-tests/pathname-match-p.lsp      | 36 +++++---------------
 ansi-tests/pathname-name.lsp         |  7 +---
 ansi-tests/pathname-type.lsp         |  7 +---
 ansi-tests/pathname-version.lsp      |  7 +---
 ansi-tests/phase.lsp                 |  5 +--
 ansi-tests/plusp.lsp                 |  5 +--
 ansi-tests/position-if-not.lsp       | 12 ++-----
 ansi-tests/position-if.lsp           | 12 ++-----
 ansi-tests/position.lsp              | 12 ++-----
 ansi-tests/pprint-logical-block.lsp  | 51 ++++++++++++----------------
 ansi-tests/pprint-newline.lsp        | 12 +++----
 ansi-tests/random-types.lsp          |  8 ++++-
 ansi-tests/random.lsp                |  5 +--
 ansi-tests/rassoc-if-not.lsp         |  4 +++
 ansi-tests/rassoc-if.lsp             |  3 ++
 ansi-tests/rassoc.lsp                |  4 +++
 ansi-tests/rational.lsp              |  5 +--
 ansi-tests/rationalize.lsp           |  5 +--
 ansi-tests/read-byte.lsp             | 10 ++----
 ansi-tests/read-sequence.lsp         | 47 +++++++++++--------------
 ansi-tests/readtable-case.lsp        | 26 +++++---------
 ansi-tests/realpart.lsp              |  5 +--
 81 files changed, 298 insertions(+), 537 deletions(-)

diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp
index 232a2d7a..24c5cc3e 100644
--- a/ansi-tests/ansi-aux.lsp
+++ b/ansi-tests/ansi-aux.lsp
@@ -1144,3 +1144,14 @@ the condition to go uncaught if it cannot be classified."
     (rational 0)))
 
 (defun sequencep (x) (typep x 'sequence))
+
+(defun typef (type) #'(lambda (x) (typep x type)))
+
+(defun package-designator-p (x)
+  "TRUE if x could be a package designator.  The package need not
+   actually exist."
+  (or (packagep x)
+      (handler-case (and (locally (declare (optimize safety))
+				  (string x))
+			 t)
+		    (type-error () nil))))
diff --git a/ansi-tests/intersection.lsp b/ansi-tests/intersection.lsp
index 5706c11e..13ceaf37 100644
--- a/ansi-tests/intersection.lsp
+++ b/ansi-tests/intersection.lsp
@@ -405,3 +405,11 @@
   (signals-error (intersection '(a b . c) '(d e f))
 		 type-error)
   t)
+
+(deftest intersection.error.13
+  (check-type-error #'(lambda (x) (intersection x '(a b c))) #'listp)
+  nil)
+
+(deftest intersection.error.14
+  (check-type-error #'(lambda (x) (intersection '(a b c) x)) #'listp)
+  nil)
\ No newline at end of file
diff --git a/ansi-tests/logand.lsp b/ansi-tests/logand.lsp
index 421523a4..5fe31cfe 100644
--- a/ansi-tests/logand.lsp
+++ b/ansi-tests/logand.lsp
@@ -10,17 +10,15 @@
 ;;; Error tests
 
 (deftest logand.error.1
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logand ',x) type-error)))
-	collect x)
+  (check-type-error #'logand #'integerp)
   nil)
 
 (deftest logand.error.2
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logand 0 ',x) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (logand 0 x)) #'integerp)
+  nil)
+
+(deftest logand.error.3
+  (check-type-error #'(lambda (x) (logand x 1)) #'integerp)
   nil)
 
 ;;; Non-error tests
diff --git a/ansi-tests/logandc2.lsp b/ansi-tests/logandc2.lsp
index b8d90555..eec05ecf 100644
--- a/ansi-tests/logandc2.lsp
+++ b/ansi-tests/logandc2.lsp
@@ -10,17 +10,11 @@
 ;;; Error tests
 
 (deftest logandc2.error.1
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logandc2 ',x 0) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (logandc2 x 0)) #'integerp)
   nil)
 
 (deftest logandc2.error.2
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logandc2 0 ',x) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (logandc2 0 x)) #'integerp)
   nil)
 
 (deftest logandc2.error.3
diff --git a/ansi-tests/logbitp.lsp b/ansi-tests/logbitp.lsp
index 891118dc..c309a9ae 100644
--- a/ansi-tests/logbitp.lsp
+++ b/ansi-tests/logbitp.lsp
@@ -22,14 +22,11 @@
   t)
 
 (deftest logbitp.error.4
-  (signals-error (logbitp -1 0) type-error)
-  t)
+  (check-type-error #'(lambda (x) (logbitp x 0)) (typef 'unsigned-byte))
+  nil)
 
 (deftest logbitp.error.5
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logbitp 0 ',x) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (logbitp 0 x)) #'integerp)
   nil)
 
 ;;; Non-error tests
diff --git a/ansi-tests/logcount.lsp b/ansi-tests/logcount.lsp
index 071903b9..dbbfc73f 100644
--- a/ansi-tests/logcount.lsp
+++ b/ansi-tests/logcount.lsp
@@ -16,10 +16,7 @@
   t)
 
 (deftest logcount.error.3
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logcount ',x) type-error)))
-	collect x)
+  (check-type-error #'logcount #'integerp)
   nil)
 
 ;;; Non-error tests
diff --git a/ansi-tests/logeqv.lsp b/ansi-tests/logeqv.lsp
index 032755e5..3bd145eb 100644
--- a/ansi-tests/logeqv.lsp
+++ b/ansi-tests/logeqv.lsp
@@ -10,17 +10,11 @@
 ;;; Error tests
 
 (deftest logeqv.error.1
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logeqv ',x) type-error)))
-	collect x)
+  (check-type-error #'logeqv #'integerp)
   nil)
 
 (deftest logeqv.error.2
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logeqv 0 ',x) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (logeqv 0 x)) #'integerp)
   nil)
 
 ;;; Non-error tests
diff --git a/ansi-tests/logical-pathname.lsp b/ansi-tests/logical-pathname.lsp
index afbd1cbb..aebbd393 100644
--- a/ansi-tests/logical-pathname.lsp
+++ b/ansi-tests/logical-pathname.lsp
@@ -29,13 +29,8 @@
 ;;; Error tests
 
 (deftest logical-pathname.error.1
-  (loop for x in *mini-universe*
-	unless (or (stringp x)
-		   (typep x 'stream)
-		   (typep x 'logical-pathname)
-		   (eval `(signals-error (logical-pathname ',x)
-					 type-error)))
-	collect x)
+  (check-type-error #'logical-pathname
+		    (typef '(or string stream logical-pathname)))
   nil)
 
 (deftest logical-pathname.error.2
diff --git a/ansi-tests/logior.lsp b/ansi-tests/logior.lsp
index 7e9bec8f..2e75e5e2 100644
--- a/ansi-tests/logior.lsp
+++ b/ansi-tests/logior.lsp
@@ -12,17 +12,11 @@
 ;;; Error tests
 
 (deftest logior.error.1
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logior ',x) type-error)))
-	collect x)
+  (check-type-error #'logior #'integerp)
   nil)
 
 (deftest logior.error.2
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logior 0 ',x) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (logior 0 x)) #'integerp)
   nil)
 
 ;;; Non-error tests
diff --git a/ansi-tests/lognand.lsp b/ansi-tests/lognand.lsp
index 94740f93..cb5fbbdb 100644
--- a/ansi-tests/lognand.lsp
+++ b/ansi-tests/lognand.lsp
@@ -10,17 +10,11 @@
 ;;; Error tests
 
 (deftest lognand.error.1
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (lognand ',x 0) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (lognand x 0)) #'integerp)
   nil)
 
 (deftest lognand.error.2
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (lognand 0 ',x) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (lognand 0 x)) #'integerp)
   nil)
 
 (deftest lognand.error.3
diff --git a/ansi-tests/lognor.lsp b/ansi-tests/lognor.lsp
index 58b8853b..24f003b8 100644
--- a/ansi-tests/lognor.lsp
+++ b/ansi-tests/lognor.lsp
@@ -10,17 +10,11 @@
 ;;; Error tests
 
 (deftest lognor.error.1
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (lognor ',x 0) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (lognor x 0)) #'integerp)
   nil)
 
 (deftest lognor.error.2
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (lognor 0 ',x) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (lognor 0 x)) #'integerp)
   nil)
 
 (deftest lognor.error.3
diff --git a/ansi-tests/lognot.lsp b/ansi-tests/lognot.lsp
index de05eb25..9015b344 100644
--- a/ansi-tests/lognot.lsp
+++ b/ansi-tests/lognot.lsp
@@ -10,10 +10,7 @@
 ;;; Error tests
 
 (deftest lognot.error.1
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (lognot ',x) type-error)))
-	collect x)
+  (check-type-error #'lognot #'integerp)
   nil)
 
 (deftest lognot.error.2
diff --git a/ansi-tests/logorc1.lsp b/ansi-tests/logorc1.lsp
index 6f578327..b781b7c0 100644
--- a/ansi-tests/logorc1.lsp
+++ b/ansi-tests/logorc1.lsp
@@ -10,17 +10,11 @@
 ;;; Error tests
 
 (deftest logorc1.error.1
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logorc1 ',x 0) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (logorc1 x 0)) #'integerp)
   nil)
 
 (deftest logorc1.error.2
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logorc1 0 ',x) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (logorc1 0 x)) #'integerp)
   nil)
 
 (deftest logorc1.error.3
diff --git a/ansi-tests/logorc2.lsp b/ansi-tests/logorc2.lsp
index 52c5a0ca..d94e8f36 100644
--- a/ansi-tests/logorc2.lsp
+++ b/ansi-tests/logorc2.lsp
@@ -10,17 +10,11 @@
 ;;; Error tests
 
 (deftest logorc2.error.1
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logorc2 ',x 0) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (logorc2 x 0)) #'integerp)
   nil)
 
 (deftest logorc2.error.2
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logorc2 0 ',x) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (logorc2 0 x)) #'integerp)
   nil)
 
 (deftest logorc2.error.3
diff --git a/ansi-tests/logtest.lsp b/ansi-tests/logtest.lsp
index 96392f0e..654a9d28 100644
--- a/ansi-tests/logtest.lsp
+++ b/ansi-tests/logtest.lsp
@@ -20,17 +20,11 @@
   t)
 
 (deftest logtest.error.4
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logtest ',x -1) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (logtest x -1)) #'integerp)
   nil)
 
 (deftest logtest.error.5
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logtest -1 ',x) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (logtest -1 x)) #'integerp)
   nil)
 
 ;;; Non-error tests
diff --git a/ansi-tests/logxor.lsp b/ansi-tests/logxor.lsp
index 5d65d46a..933f9809 100644
--- a/ansi-tests/logxor.lsp
+++ b/ansi-tests/logxor.lsp
@@ -10,17 +10,11 @@
 ;;; Error tests
 
 (deftest logxor.error.1
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logxor ',x) type-error)))
-	collect x)
+  (check-type-error #'logxor #'integerp)
   nil)
 
 (deftest logxor.error.2
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (logxor 0 ',x) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (logxor 0 x)) #'integerp)
   nil)
 
 
diff --git a/ansi-tests/make-broadcast-stream.lsp b/ansi-tests/make-broadcast-stream.lsp
index eca5ff6a..25615a96 100644
--- a/ansi-tests/make-broadcast-stream.lsp
+++ b/ansi-tests/make-broadcast-stream.lsp
@@ -88,22 +88,12 @@
 ;;; Error tests
 
 (deftest make-broadcast-stream.error.1
-  (loop for x in *mini-universe*
-	unless (or (and (typep x 'stream) (output-stream-p x))
-		   (handler-case (progn (make-broadcast-stream x) nil)
-				 (type-error () t)
-				 (condition nil)))
-
-	collect x)
+  (check-type-error #'make-broadcast-stream
+		    #'(lambda (x) (and (streamp x) (output-stream-p x))))
   nil)
 
 (deftest make-broadcast-stream.error.2
-  (loop for x in *streams*
-	unless (or (and (typep x 'stream) (output-stream-p x))
-		   (handler-case (progn (make-broadcast-stream x) nil)
-				 (type-error () t)
-				 (condition nil)))
-
-	collect x)
+  (check-type-error #'make-broadcast-stream
+		    #'(lambda (x) (and (streamp x) (output-stream-p x)))
+		    *streams*)
   nil)
-
diff --git a/ansi-tests/make-list.lsp b/ansi-tests/make-list.lsp
index 466fbae8..671f1b61 100644
--- a/ansi-tests/make-list.lsp
+++ b/ansi-tests/make-list.lsp
@@ -71,12 +71,8 @@
 
 
 (deftest make-list.error.1
-  (catch-type-error (make-list -1))
-  type-error)
-
-(deftest make-list.error.2
-  (signals-error (make-list 'a) type-error)
-  t)
+  (check-type-error #'make-list (typef 'unsigned-byte))
+  nil)
 
 (deftest make-list.error.3
   (signals-error (make-list) program-error)
diff --git a/ansi-tests/make-random-state.lsp b/ansi-tests/make-random-state.lsp
index 634f04b5..02602d69 100644
--- a/ansi-tests/make-random-state.lsp
+++ b/ansi-tests/make-random-state.lsp
@@ -20,10 +20,7 @@
   t)
 
 (deftest make-random-state.error.4
-  (loop for x in *mini-universe*
-	unless (or (null x) (eq x t) (random-state-p x)
-		   (eval `(signals-error (make-random-state ',x) type-error)))
-	collect x)
+  (check-type-error #'make-random-state (typef '(or (member nil t) random-state)))
   nil)
 
 ;;; Non-error tests
diff --git a/ansi-tests/make-symbol.lsp b/ansi-tests/make-symbol.lsp
index 9c3f1375..4a031e65 100644
--- a/ansi-tests/make-symbol.lsp
+++ b/ansi-tests/make-symbol.lsp
@@ -118,36 +118,8 @@
   "ABC" 1)
 
 (deftest make-symbol.error.1
-  (signals-error (make-symbol nil) type-error)
-  t)
-
-(deftest make-symbol.error.2
-  (signals-error (make-symbol 'a) type-error)
-  t)
-
-(deftest make-symbol.error.3
-  (signals-error (make-symbol 1) type-error)
-  t)
-
-(deftest make-symbol.error.4
-  (signals-error (make-symbol -1) type-error)
-  t)
-
-(deftest make-symbol.error.5
-  (signals-error (make-symbol 1.213) type-error)
-  t)
-
-(deftest make-symbol.error.6
-  (signals-error (make-symbol -1312.2) type-error)
-  t)
-
-(deftest make-symbol.error.7
-  (signals-error (make-symbol #\w) type-error)
-  t)
-
-(deftest make-symbol.error.8
-  (signals-error (make-symbol '(a)) type-error)
-  t)
+  (check-type-error #'make-symbol #'stringp)
+  nil)
 
 (deftest make-symbol.error.9
   (signals-error (make-symbol) program-error)
@@ -158,5 +130,5 @@
   t)
 
 (deftest make-symbol.error.11
-  (signals-error (make-symbol '(#\a #\b #\c))  type-error)
+  (signals-type-error x '(#\a #\b #\c) (make-symbol x))
   t)
diff --git a/ansi-tests/make-synonym-stream.lsp b/ansi-tests/make-synonym-stream.lsp
index a8240b6e..b5bab2d8 100644
--- a/ansi-tests/make-synonym-stream.lsp
+++ b/ansi-tests/make-synonym-stream.lsp
@@ -93,9 +93,5 @@
   t)
 
 (deftest make-synonym-stream.error.3
-  (loop for x in *mini-universe*
-	unless (or (symbolp x)
-		   (eval `(signals-error (make-synonym-stream ',x)
-					 type-error)))
-	collect x)
+  (check-type-error #'make-synonym-stream #'symbolp)
   nil)
diff --git a/ansi-tests/make-two-way-stream.lsp b/ansi-tests/make-two-way-stream.lsp
index 7a665703..e1a43d78 100644
--- a/ansi-tests/make-two-way-stream.lsp
+++ b/ansi-tests/make-two-way-stream.lsp
@@ -218,43 +218,25 @@
   t)
 
 (deftest make-two-way-stream.error.4
-  (loop for x in *mini-universe*
-	unless (or (and (typep x 'stream) (input-stream-p x))
-		   (eval `(signals-error
-			   (let ((os (make-string-output-stream)))
-			     (make-two-way-stream ',x os))
-			   type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (make-two-way-stream x (make-string-output-stream)))
+		    #'(lambda (x) (and (streamp x) (input-stream-p x))))
   nil)
 
 (deftest make-two-way-stream.error.5
-  (loop for x in *streams*
-	unless (or (and (typep x 'stream) (input-stream-p x))
-		   (eval `(signals-error
-			   (let ((os (make-string-output-stream)))
-			     (make-two-way-stream ',x os))
-			   type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (make-two-way-stream x (make-string-output-stream)))
+		    #'(lambda (x) (and (streamp x) (input-stream-p x)))
+		    *streams*)
   nil)
 
 (deftest make-two-way-stream.error.6
-  (loop for x in *mini-universe*
-	unless (or (and (typep x 'stream) (output-stream-p x))
-		   (eval `(signals-error
-			   (let ((is (make-string-input-stream "foo")))
-			     (make-two-way-stream is ',x))
-			   type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (make-two-way-stream (make-string-input-stream "foo") x))
+		    #'(lambda (x) (and (streamp x) (output-stream-p x))))
   nil)
 
 (deftest make-two-way-stream.error.7
-  (loop for x in *streams*
-	unless (or (and (typep x 'stream) (output-stream-p x))
-		   (eval `(signals-error
-			   (let ((is (make-string-input-stream "foo")))
-			     (make-two-way-stream is ',x))
-			   type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (make-two-way-stream (make-string-input-stream "foo") x))
+		    #'(lambda (x) (and (streamp x) (output-stream-p x)))
+		    *streams*)
   nil)
 
 
diff --git a/ansi-tests/makunbound.lsp b/ansi-tests/makunbound.lsp
index dea641f9..16aee870 100644
--- a/ansi-tests/makunbound.lsp
+++ b/ansi-tests/makunbound.lsp
@@ -41,9 +41,5 @@
   t)
 
 (deftest makunbound.error.3
-  (loop for x in *mini-universe*
-	for form = `(signals-error (makunbound ',x) type-error)
-	unless (or (symbolp x) (eval form))
-	collect x)
+  (check-type-error #'makunbound #'symbolp)
   nil)
-
diff --git a/ansi-tests/map-into.lsp b/ansi-tests/map-into.lsp
index 787aa772..5089f03e 100644
--- a/ansi-tests/map-into.lsp
+++ b/ansi-tests/map-into.lsp
@@ -454,8 +454,8 @@
 ;;; Error cases
 
 (deftest map-into.error.1
-  (signals-error (map-into 'a #'(lambda () nil)) type-error)
-  t)
+  (check-type-error #'(lambda (x) (map-into x (constantly nil))) #'sequencep)
+  nil)
 
 ;;; The next test was changed because if the first argument
 ;;; is NIL, map-into is said to 'return nil immediately', so
@@ -469,9 +469,9 @@
   nil)
 
 (deftest map-into.error.3
-  (signals-error (map-into (copy-seq '(a b c)) #'cons '(d e f) 100)
-		 type-error)
-  t)
+  (check-type-error #'(lambda (x) (map-into (copy-seq '(a b c)) #'cons '(d e f) x))
+		    #'sequencep)
+  nil)
 
 (deftest map-into.error.4
   (signals-error (map-into) program-error)
diff --git a/ansi-tests/map.lsp b/ansi-tests/map.lsp
index bf202846..0253fa10 100644
--- a/ansi-tests/map.lsp
+++ b/ansi-tests/map.lsp
@@ -220,6 +220,10 @@
   (signals-error-always (map 'symbol #'identity '(a b c)) type-error)
   t t)
 
+(deftest map.error.1a
+  (signals-error (map 'symbol #'identity '(a b c)) type-error)
+  t)
+
 (deftest map.error.2
   (signals-error (map '(vector * 8) #'identity '(a b c)) type-error)
   t)
@@ -268,6 +272,14 @@
       t))
   t)
 
+(deftest map.error.12
+  (check-type-error #'(lambda (x) (map 'list #'identity x)) #'sequencep)
+  nil)
+
+(deftest map.error.13
+  (check-type-error #'(lambda (x) (map 'vector #'cons '(a b c d) x)) #'sequencep)
+  nil)
+
 ;;; Test mapping on arrays with fill pointers
 
 (deftest map.fill.1
diff --git a/ansi-tests/mapc.lsp b/ansi-tests/mapc.lsp
index 1be931e9..cf1b78d0 100644
--- a/ansi-tests/mapc.lsp
+++ b/ansi-tests/mapc.lsp
@@ -74,8 +74,8 @@
   (a b c) 3 1 2 3)
 
 (deftest mapc.error.1
-  (signals-error (mapc #'identity 1) type-error)
-  t)
+  (check-type-error #'(lambda (x) (mapc #'identity x)) #'listp)
+  nil)
 
 (deftest mapc.error.2
   (signals-error (mapc) program-error)
diff --git a/ansi-tests/mapcan.lsp b/ansi-tests/mapcan.lsp
index 4278e1e7..4e93adfd 100644
--- a/ansi-tests/mapcan.lsp
+++ b/ansi-tests/mapcan.lsp
@@ -88,8 +88,8 @@
   1)
 
 (deftest mapcan.error.1
-  (signals-error (mapcan #'identity 1) type-error)
-  t)
+  (check-type-error #'(lambda (x) (mapcan #'identity x)) #'listp)
+  nil)
 
 (deftest mapcan.error.2
   (signals-error (mapcan) program-error)
diff --git a/ansi-tests/mapcar.lsp b/ansi-tests/mapcar.lsp
index d7aaccad..1b8598b1 100644
--- a/ansi-tests/mapcar.lsp
+++ b/ansi-tests/mapcar.lsp
@@ -81,8 +81,8 @@
   3 1 2 3)
 
 (deftest mapcar.error.1
-  (signals-error (mapcar #'identity 1) type-error)
-  t)
+  (check-type-error #'(lambda (x) (mapcar #'identity x)) #'listp)
+  nil)
 
 (deftest mapcar.error.2
   (signals-error (mapcar) program-error)
diff --git a/ansi-tests/mapcon.lsp b/ansi-tests/mapcon.lsp
index bfefb8a9..58bb0fe8 100644
--- a/ansi-tests/mapcon.lsp
+++ b/ansi-tests/mapcon.lsp
@@ -54,8 +54,8 @@
   3 1 2 3)
 
 (deftest mapcon.error.1
-  (signals-error (mapcon #'identity 1) type-error)
-  t)
+  (check-type-error #'(lambda (x) (mapcon #'identity x)) #'listp)
+  nil)
 
 (deftest mapcon.error.2
   (signals-error (mapcon) program-error)
diff --git a/ansi-tests/mapl.lsp b/ansi-tests/mapl.lsp
index d7e7bff7..3907ae77 100644
--- a/ansi-tests/mapl.lsp
+++ b/ansi-tests/mapl.lsp
@@ -100,8 +100,8 @@
   (a b c) 3 1 2 3)
 
 (deftest mapl.error.1
-  (signals-error (mapl #'identity 1) type-error)
-  t)
+  (check-type-error #'(lambda (x) (mapl #'identity x)) #'sequencep)
+  nil)
 
 (deftest mapl.error.2
   (signals-error (mapl) program-error)
diff --git a/ansi-tests/maplist.lsp b/ansi-tests/maplist.lsp
index cdf72f94..b452ce05 100644
--- a/ansi-tests/maplist.lsp
+++ b/ansi-tests/maplist.lsp
@@ -95,8 +95,8 @@
   (1 2 3) 3 1 2 3)
 
 (deftest maplist.error.1
-  (signals-error (maplist #'identity 'a) type-error)
-  t)
+  (check-type-error #'(lambda (x) (maplist #'identity x)) #'listp)
+  nil)
 
 (deftest maplist.error.2
   (signals-error (maplist #'identity 1) type-error)
diff --git a/ansi-tests/max.lsp b/ansi-tests/max.lsp
index c3d4efa2..c09ce3bc 100644
--- a/ansi-tests/max.lsp
+++ b/ansi-tests/max.lsp
@@ -14,10 +14,11 @@
   t)
 
 (deftest max.error.2
-  (loop for x in *mini-universe*
-	unless (or (realp x)
-		   (eval `(signals-error (max ',x) type-error)))
-	collect x)
+  (check-type-error #'max #'realp)
+  nil)
+
+(deftest max.error.3
+  (check-type-error #'(lambda (x) (max 0 x)) #'realp)
   nil)
 
 ;;; Non-error tests
diff --git a/ansi-tests/member-if-not.lsp b/ansi-tests/member-if-not.lsp
index 85d22c9d..63dc8665 100644
--- a/ansi-tests/member-if-not.lsp
+++ b/ansi-tests/member-if-not.lsp
@@ -95,8 +95,8 @@
 ;;; Error tests
 
 (deftest member-if-not.error.1
-  (signals-error (member-if-not #'identity 'a) type-error)
-  t)
+  (check-type-error #'(lambda (x) (member-if-not #'identity x)) #'listp)
+  nil)
   
 (deftest member-if-not.error.2
   (signals-error (member-if-not) program-error)
diff --git a/ansi-tests/member-if.lsp b/ansi-tests/member-if.lsp
index 51915185..bb26099d 100644
--- a/ansi-tests/member-if.lsp
+++ b/ansi-tests/member-if.lsp
@@ -101,8 +101,8 @@
 ;;; Error cases
 
 (deftest member-if.error.1
-  (signals-error (member-if #'identity 'a) type-error)
-  t)
+  (check-type-error #'(lambda (x) (member-if #'identity x)) #'listp)
+  nil)
   
 (deftest member-if.error.2
   (signals-error (member-if) program-error)
diff --git a/ansi-tests/member.lsp b/ansi-tests/member.lsp
index 56666a2d..b8595a45 100644
--- a/ansi-tests/member.lsp
+++ b/ansi-tests/member.lsp
@@ -235,8 +235,8 @@
 ;;; Error cases
 
 (deftest member.error.1
-  (signals-error (member 'a 'b) type-error)
-  t)
+  (check-type-error #'(lambda (x) (member 'a x)) #'listp)
+  nil)
 
 (deftest member.error.2
   (signals-error (member 'a 1.3) type-error)
diff --git a/ansi-tests/min.lsp b/ansi-tests/min.lsp
index b63c278e..5b42fc2c 100644
--- a/ansi-tests/min.lsp
+++ b/ansi-tests/min.lsp
@@ -12,17 +12,11 @@
   t)
 
 (deftest min.error.2
-  (loop for x in *mini-universe*
-	unless (or (realp x)
-		   (eval `(signals-error (min ',x) type-error)))
-	collect x)
+  (check-type-error #'min #'realp)
   nil)
 
 (deftest min.error.3
-  (loop for x in *mini-universe*
-	unless (or (realp x)
-		   (eval `(signals-error (min 0 ',x) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (min 0 x)) #'realp)
   nil)
 
 (deftest min.1
diff --git a/ansi-tests/minusp.lsp b/ansi-tests/minusp.lsp
index 55444908..af6421db 100644
--- a/ansi-tests/minusp.lsp
+++ b/ansi-tests/minusp.lsp
@@ -18,10 +18,7 @@
   t)
 
 (deftest minusp.error.4
-  (loop for x in *mini-universe*
-	unless (realp x)
-	unless (eval `(signals-error (minusp ',x) type-error))
-	collect x)
+  (check-type-error #'minusp #'realp)
   nil)
 
 (deftest minusp.1
diff --git a/ansi-tests/nintersection.lsp b/ansi-tests/nintersection.lsp
index 81b0b69e..9266823a 100644
--- a/ansi-tests/nintersection.lsp
+++ b/ansi-tests/nintersection.lsp
@@ -367,3 +367,10 @@
   (signals-error (nintersection (list* 1 2 3) (list 4 5 6)) type-error)
   t)
 
+(deftest nintersection.error.13
+  (check-type-error #'(lambda (x) (nintersection x (copy-seq '(a b c)))) #'listp)
+  nil)
+
+(deftest nintersection.error.14
+  (check-type-error #'(lambda (x) (nintersection (copy-seq '(a b c)) x)) #'listp)
+  nil)
\ No newline at end of file
diff --git a/ansi-tests/notany.lsp b/ansi-tests/notany.lsp
index 8e5647c5..cbce88aa 100644
--- a/ansi-tests/notany.lsp
+++ b/ansi-tests/notany.lsp
@@ -267,32 +267,17 @@
 ;;; Error cases
 
 (deftest notany.error.1
-  (signals-error (notany 1 '(a b c)) type-error)
-  t)
-
-(deftest notany.error.2
-  (signals-error (notany #\a '(a b c)) type-error)
-  t)
-
-(deftest notany.error.3
-  (signals-error (notany #() '(a b c)) type-error)
-  t)
+  (check-type-error #'(lambda (x) (notany x '(a b c)))
+		    (typef '(or symbol function)))
+  nil)
 
 (deftest notany.error.4
-  (signals-error (notany #'null 'a) type-error)
-  t)
-
-(deftest notany.error.5
-  (signals-error (notany #'null 100) type-error)
-  t)
-
-(deftest notany.error.6
-  (signals-error (notany #'null 'a) type-error)
-  t)
+  (check-type-error #'(lambda (x) (notany #'null x)) #'sequencep)
+  nil)
 
 (deftest notany.error.7
-  (signals-error (notany #'eq () 'a) type-error)
-  t)
+  (check-type-error #'(lambda (x) (notany #'eql () x)) #'sequencep)
+  nil)
 
 (deftest notany.error.8
   (signals-error (notany) program-error)
diff --git a/ansi-tests/notevery.lsp b/ansi-tests/notevery.lsp
index 174c70b6..3d9102ef 100644
--- a/ansi-tests/notevery.lsp
+++ b/ansi-tests/notevery.lsp
@@ -270,32 +270,17 @@
 ;;; Error cases
 
 (deftest notevery.error.1
-  (signals-error (notevery 1 '(a b c)) type-error)
-  t)
-
-(deftest notevery.error.2
-  (signals-error (notevery #\a '(a b c)) type-error)
-  t)
-
-(deftest notevery.error.3
-  (signals-error (notevery #() '(a b c)) type-error)
-  t)
+  (check-type-error #'(lambda (x) (notevery x '(a b c)))
+		    (typef '(or symbol function)))
+  nil)
 
 (deftest notevery.error.4
-  (signals-error (notevery #'null 'a) type-error)
-  t)
-
-(deftest notevery.error.5
-  (signals-error (notevery #'null 100) type-error)
-  t)
-
-(deftest notevery.error.6
-  (signals-error (notevery #'null 'a) type-error)
-  t)
+  (check-type-error #'(lambda (x) (notevery #'null x)) #'sequencep)
+  nil)
 
 (deftest notevery.error.7
-  (signals-error (notevery #'eq () 'a) type-error)
-  t)
+  (check-type-error #'(lambda (x) (notevery #'eql () x)) #'sequencep)
+  nil)
 
 (deftest notevery.error.8
   (signals-error (notevery) program-error)
diff --git a/ansi-tests/nreconc.lsp b/ansi-tests/nreconc.lsp
index b9567dcf..49123083 100644
--- a/ansi-tests/nreconc.lsp
+++ b/ansi-tests/nreconc.lsp
@@ -42,3 +42,7 @@
 (deftest nreconc.error.4
   (signals-error (nreconc (cons 'a 'b) (list 'z)) type-error)
   t)
+
+(deftest nreconc.error.5
+  (check-type-error #'(lambda (x) (nreconc x '(a b))) #'listp)
+  nil)
diff --git a/ansi-tests/nreverse.lsp b/ansi-tests/nreverse.lsp
index f8246525..394ec538 100644
--- a/ansi-tests/nreverse.lsp
+++ b/ansi-tests/nreverse.lsp
@@ -154,24 +154,8 @@
 ;;; Error tests
 
 (deftest nreverse.error.1
-  (signals-error (nreverse 'a) type-error)
-  t)
-
-(deftest nreverse.error.2
-  (signals-error (nreverse #\a) type-error)
-  t)
-
-(deftest nreverse.error.3
-  (signals-error (nreverse 10) type-error)
-  t)
-
-(deftest nreverse.error.4
-  (signals-error (nreverse 0.3) type-error)
-  t)
-
-(deftest nreverse.error.5
-  (signals-error (nreverse 10/3) type-error)
-  t)
+  (check-type-error #'nreverse #'sequencep)
+  nil)
 
 (deftest nreverse.error.6
   (signals-error (nreverse) program-error)
diff --git a/ansi-tests/nset-difference.lsp b/ansi-tests/nset-difference.lsp
index a1fb829e..cd756937 100644
--- a/ansi-tests/nset-difference.lsp
+++ b/ansi-tests/nset-difference.lsp
@@ -319,3 +319,10 @@
   (signals-error (nset-difference (list* 1 2 3) (list 4 5 6)) type-error)
   t)
 
+(deftest nset-difference.error.13
+  (check-type-error #'(lambda (x) (nset-difference (list 'a 'b) x)) #'listp)
+  nil)
+
+(deftest nset-difference.error.14
+  (check-type-error #'(lambda (x) (nset-difference x (list 'a 'b))) #'listp)
+  nil)
diff --git a/ansi-tests/nset-exclusive-or.lsp b/ansi-tests/nset-exclusive-or.lsp
index 68e3a254..0e991d61 100644
--- a/ansi-tests/nset-exclusive-or.lsp
+++ b/ansi-tests/nset-exclusive-or.lsp
@@ -367,3 +367,11 @@
 (deftest nset-exclusive-or.error.12
   (signals-error (nset-exclusive-or (list* 1 2 3) (list 4 5 6)) type-error)
   t)
+
+(deftest nset-exclusive-or.error.13
+  (check-type-error #'(lambda (x) (nset-exclusive-or x (list 'a 'b))) #'listp)
+  nil)
+
+(deftest nset-exclusive-or.error.14
+  (check-type-error #'(lambda (x) (nset-exclusive-or (list 'a 'b) x)) #'listp)
+  nil)
diff --git a/ansi-tests/nsublis.lsp b/ansi-tests/nsublis.lsp
index 5ee2c3a2..395e8c8b 100644
--- a/ansi-tests/nsublis.lsp
+++ b/ansi-tests/nsublis.lsp
@@ -192,3 +192,7 @@
 			   (list 'a 'b 'c 'd))
 		 type-error)
   t)
+
+(deftest nsublis.error.9
+  (check-type-error #'(lambda (x) (nsublis x (list 'a 'b))) #'listp)
+  nil)
diff --git a/ansi-tests/nsubstitute-if-not.lsp b/ansi-tests/nsubstitute-if-not.lsp
index 45849707..dcfa2eb5 100644
--- a/ansi-tests/nsubstitute-if-not.lsp
+++ b/ansi-tests/nsubstitute-if-not.lsp
@@ -794,3 +794,6 @@
 		 program-error)
   t)
 
+(deftest nsubstitute-if-not.error.12
+  (check-type-error #'(lambda (x) (nsubstitute-if-not 1 #'null x)) #'sequencep)
+  nil)
diff --git a/ansi-tests/nsubstitute-if.lsp b/ansi-tests/nsubstitute-if.lsp
index 8d288824..a8230f61 100644
--- a/ansi-tests/nsubstitute-if.lsp
+++ b/ansi-tests/nsubstitute-if.lsp
@@ -792,3 +792,6 @@
 				  :key #'cons) program-error)
   t)
 
+(deftest nsubstitute-if.error.12
+  (check-type-error #'(lambda (x) (nsubstitute-if 0 #'identity x)) #'sequencep)
+  nil)
diff --git a/ansi-tests/nsubstitute.lsp b/ansi-tests/nsubstitute.lsp
index 0ae765bd..c91fcb8a 100644
--- a/ansi-tests/nsubstitute.lsp
+++ b/ansi-tests/nsubstitute.lsp
@@ -1024,3 +1024,6 @@
   (signals-error (nsubstitute 'a 'b (list 'a 'b 'c) :key #'car) type-error)
   t)
 
+(deftest nsubstitute.error.12
+  (check-type-error #'(lambda (x) (nsubstitute 1 0 x)) #'sequencep)
+  nil)
diff --git a/ansi-tests/nthcdr.lsp b/ansi-tests/nthcdr.lsp
index 4823c1cc..8441b60f 100644
--- a/ansi-tests/nthcdr.lsp
+++ b/ansi-tests/nthcdr.lsp
@@ -10,24 +10,8 @@
 ;;; Error tests
 
 (deftest nthcdr.error.1
-  (signals-error (nthcdr nil (copy-tree '(a b c d))) type-error)
-  t)
-
-(deftest nthcdr.error.2
-  (signals-error (nthcdr 'a (copy-tree '(a b c d))) type-error)
-  t)
-
-(deftest nthcdr.error.3
-  (signals-error (nthcdr 0.1 (copy-tree '(a b c d))) type-error)
-  t)
-
-(deftest nthcdr.error.4
-  (signals-error (nthcdr #\A (copy-tree '(a b c d))) type-error)
-  t)
-
-(deftest nthcdr.error.5
-  (signals-error (nthcdr '(a) (copy-tree '(a b c d))) type-error)
-  t)
+  (check-type-error #'(lambda (x) (nthcdr x (copy-list '(a b c d)))) (typef 'unsigned-byte))
+  nil)
 
 (deftest nthcdr.error.6
   (signals-error (nthcdr -10 (copy-tree '(a b c d))) type-error)
diff --git a/ansi-tests/nunion.lsp b/ansi-tests/nunion.lsp
index 53df8a39..aa48149e 100644
--- a/ansi-tests/nunion.lsp
+++ b/ansi-tests/nunion.lsp
@@ -408,3 +408,11 @@
 (deftest nunion.error.12
   (signals-error (nunion (list* 1 2 3) (list 4 5 6)) type-error)
   t)
+
+(deftest nunion.error.13
+  (check-type-error #'(lambda (x) (nunion x (list 1 2 3))) #'listp)
+  nil)
+
+(deftest nunion.error.14
+  (check-type-error #'(lambda (x) (nunion (list 1 2 3) x)) #'listp)
+  nil)
diff --git a/ansi-tests/oddp.lsp b/ansi-tests/oddp.lsp
index ee5770ea..2277e128 100644
--- a/ansi-tests/oddp.lsp
+++ b/ansi-tests/oddp.lsp
@@ -18,10 +18,7 @@
   t)
 
 (deftest oddp.error.3
-  (loop for x in *mini-universe*
-	unless (or (integerp x)
-		   (eval `(signals-error (oddp ',x) type-error)))
-	collect x)
+  (check-type-error #'oddp #'integerp)
   nil)
 
 ;;; Non-error tests
diff --git a/ansi-tests/open-stream-p.lsp b/ansi-tests/open-stream-p.lsp
index c5a688b3..ea4ed222 100644
--- a/ansi-tests/open-stream-p.lsp
+++ b/ansi-tests/open-stream-p.lsp
@@ -50,8 +50,5 @@
   t)
 
 (deftest open-stream-p.error.3
-  (loop for x in *mini-universe*
-	unless (or (typep x 'stream)
-		   (eval `(signals-error (open-stream-p ',x) type-error)))
-	collect x)
+  (check-type-error #'open-stream-p #'streamp)
   nil)
diff --git a/ansi-tests/output-stream-p.lsp b/ansi-tests/output-stream-p.lsp
index c137745b..e4f13c09 100644
--- a/ansi-tests/output-stream-p.lsp
+++ b/ansi-tests/output-stream-p.lsp
@@ -35,8 +35,5 @@
   t)
 
 (deftest output-stream-p.error.3
-  (loop for x in *mini-universe*
-	unless (or (typep x 'stream)
-		   (eval `(signals-error (output-stream-p ',x) type-error)))
-	collect x)
+  (check-type-error #'output-stream-p #'streamp)
   nil)
diff --git a/ansi-tests/package-name.lsp b/ansi-tests/package-name.lsp
index 5115a1f1..e3e45563 100644
--- a/ansi-tests/package-name.lsp
+++ b/ansi-tests/package-name.lsp
@@ -175,3 +175,6 @@
   (signals-error (package-name "CL" nil) program-error)
   t)
 
+(deftest package-name.error.3
+  (check-type-error #'package-name #'package-designator-p)
+  nil)
diff --git a/ansi-tests/package-nicknames.lsp b/ansi-tests/package-nicknames.lsp
index 872b182c..bf9a6ac9 100644
--- a/ansi-tests/package-nicknames.lsp
+++ b/ansi-tests/package-nicknames.lsp
@@ -147,3 +147,8 @@
 (deftest package-nicknames.error.2
   (signals-error (package-nicknames "CL" nil) program-error)
   t)
+
+(deftest package-nicknames.error.3
+  (check-type-error #'package-nicknames #'package-designator-p)
+  nil)
+
diff --git a/ansi-tests/pairlis.lsp b/ansi-tests/pairlis.lsp
index 2aa7bd09..ad0e31f4 100644
--- a/ansi-tests/pairlis.lsp
+++ b/ansi-tests/pairlis.lsp
@@ -87,3 +87,10 @@
   (signals-error (pairlis '(a . b) '(c . d)) type-error)
   t)
 
+(deftest pairlis.error.7
+  (check-type-error #'(lambda (x) (pairlis x '(a b))) #'listp)
+  nil)
+
+(deftest pairlis.error.8
+  (check-type-error #'(lambda (x) (pairlis '(a b) x)) #'listp)
+  nil)
diff --git a/ansi-tests/pathname-device.lsp b/ansi-tests/pathname-device.lsp
index 7f2d4633..228682cb 100644
--- a/ansi-tests/pathname-device.lsp
+++ b/ansi-tests/pathname-device.lsp
@@ -70,10 +70,5 @@
   t)
 
 (deftest pathname-device.error.2
-  (loop for x in *mini-universe*
-	unless (or (could-be-pathname-designator x)
-		   (handler-case (progn (pathname-device x) nil)
-				 (type-error () t)
-				 (condition () nil)))
-	collect x)
+  (check-type-error #'pathname-device #'could-be-pathname-designator)
   nil)
\ No newline at end of file
diff --git a/ansi-tests/pathname-directory.lsp b/ansi-tests/pathname-directory.lsp
index ca2aadb1..01d86cd3 100644
--- a/ansi-tests/pathname-directory.lsp
+++ b/ansi-tests/pathname-directory.lsp
@@ -85,10 +85,5 @@
   t)
 
 (deftest pathname-directory.error.2
-  (loop for x in *mini-universe*
-	unless (or (could-be-pathname-designator x)
-		   (handler-case (progn (pathname-directory x) nil)
-				 (type-error () t)
-				 (condition () nil)))
-	collect x)
+  (check-type-error #'pathname-directory #'could-be-pathname-designator)
   nil)
diff --git a/ansi-tests/pathname-host.lsp b/ansi-tests/pathname-host.lsp
index 09a8f6e5..7b697619 100644
--- a/ansi-tests/pathname-host.lsp
+++ b/ansi-tests/pathname-host.lsp
@@ -71,16 +71,10 @@
   t)
 
 (deftest pathname-host.error.2
-  (loop for x in *mini-universe*
-	unless (or (could-be-pathname-designator x)
-		   (handler-case (progn (pathname-host x) nil)
-				 (type-error () t)
-				 (condition () nil)))
-	collect x)
+  (check-type-error #'pathname-host #'could-be-pathname-designator)
   nil)
 
 (deftest pathname-host.error.3
   (signals-error (pathname-host *default-pathname-defaults* '#:bogus t)
 		 program-error)
   t)
-
diff --git a/ansi-tests/pathname-match-p.lsp b/ansi-tests/pathname-match-p.lsp
index 3a3f7d8d..09bbd276 100644
--- a/ansi-tests/pathname-match-p.lsp
+++ b/ansi-tests/pathname-match-p.lsp
@@ -83,41 +83,21 @@
   t)
 
 (deftest pathname-match-p.error.4
-  (loop for x in *mini-universe*
-	unless (or (could-be-pathname-designator x)
-		   (eval `(signals-error (pathname-match-p ',x #p"")
-					 type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (pathname-match-p x #p""))
+		    #'could-be-pathname-designator)
   nil)
 
 (deftest pathname-match-p.error.5
-  (loop for x in *mini-universe*
-	unless (or (could-be-pathname-designator x)
-		   (eval `(signals-error (pathname-match-p ',x #p"")
-					 type-error
-					 :safety 0)))
-	collect x)
+  (check-type-error #'(lambda (x) (declare (optimize (safety 0))) (pathname-match-p x #p""))
+		    #'could-be-pathname-designator)
   nil)
 
 (deftest pathname-match-p.error.6
-  (loop for x in *mini-universe*
-	unless (or (could-be-pathname-designator x)
-		   (eval `(signals-error (pathname-match-p #p"" ',x)
-					 type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (pathname-match-p #p"" x))
+		    #'could-be-pathname-designator)
   nil)
 
 (deftest pathname-match-p.error.7
-  (loop for x in *mini-universe*
-	unless (or (could-be-pathname-designator x)
-		   (eval `(signals-error (pathname-match-p #p"" ',x)
-					 type-error
-					 :safety 0)))
-	collect x)
+  (check-type-error #'(lambda (x) (declare (optimize (safety 0))) (pathname-match-p #p"" x))
+		    #'could-be-pathname-designator)
   nil)
-
-
-
-
-
-
diff --git a/ansi-tests/pathname-name.lsp b/ansi-tests/pathname-name.lsp
index c404cf5f..df030d60 100644
--- a/ansi-tests/pathname-name.lsp
+++ b/ansi-tests/pathname-name.lsp
@@ -71,10 +71,5 @@
   t)
 
 (deftest pathname-name.error.2
-  (loop for x in *mini-universe*
-	unless (or (could-be-pathname-designator x)
-		   (handler-case (progn (pathname-name x) nil)
-				 (type-error () t)
-				 (condition () nil)))
-	collect x)
+  (check-type-error #'pathname-name #'could-be-pathname-designator)
   nil)
diff --git a/ansi-tests/pathname-type.lsp b/ansi-tests/pathname-type.lsp
index c9472e40..136977be 100644
--- a/ansi-tests/pathname-type.lsp
+++ b/ansi-tests/pathname-type.lsp
@@ -71,10 +71,5 @@
   t)
 
 (deftest pathname-type.error.2
-  (loop for x in *mini-universe*
-	unless (or (could-be-pathname-designator x)
-		   (handler-case (progn (pathname-type x) nil)
-				 (type-error () t)
-				 (condition () nil)))
-	collect x)
+  (check-type-error #'pathname-type #'could-be-pathname-designator)
   nil)
diff --git a/ansi-tests/pathname-version.lsp b/ansi-tests/pathname-version.lsp
index 24dcadff..e97ac4a7 100644
--- a/ansi-tests/pathname-version.lsp
+++ b/ansi-tests/pathname-version.lsp
@@ -35,11 +35,6 @@
   t)
 
 (deftest pathname-version.error.3
-  (loop for x in *mini-universe*
-	unless (or (could-be-pathname-designator x)
-		   (handler-case (progn (pathname-version x) nil)
-				 (type-error () t)
-				 (condition () nil)))
-	collect x)
+  (check-type-error #'pathname-version #'could-be-pathname-designator)
   nil)
 
diff --git a/ansi-tests/phase.lsp b/ansi-tests/phase.lsp
index 0035eacd..6ea2b996 100644
--- a/ansi-tests/phase.lsp
+++ b/ansi-tests/phase.lsp
@@ -14,10 +14,7 @@
   t)
 
 (deftest phase.error.3
-  (loop for x in *mini-universe*
-	unless (or (numberp x)
-		   (eval `(signals-error (phase ',x) type-error)))
-	collect x)
+  (check-type-error #'phase #'numberp)
   nil)
 
 (deftest phase.1
diff --git a/ansi-tests/plusp.lsp b/ansi-tests/plusp.lsp
index 9aef592c..88c2166a 100644
--- a/ansi-tests/plusp.lsp
+++ b/ansi-tests/plusp.lsp
@@ -20,10 +20,7 @@
   t)
 
 (deftest plusp.error.4
-  (loop for x in *mini-universe*
-	unless (realp x)
-	unless (eval `(signals-error (plusp ',x) type-error))
-	collect x)
+  (check-type-error #'plusp #'realp)
   nil)
 
 ;;; Non-error tests
diff --git a/ansi-tests/position-if-not.lsp b/ansi-tests/position-if-not.lsp
index 27b7852e..d39ea2c8 100644
--- a/ansi-tests/position-if-not.lsp
+++ b/ansi-tests/position-if-not.lsp
@@ -537,16 +537,8 @@
 ;;; Error tests
 
 (deftest position-if-not.error.1
-  (signals-error (position-if-not #'identity 'b) type-error)
-  t)
-
-(deftest position-if-not.error.2
-  (signals-error (position-if-not #'identity 10) type-error)
-  t)
-
-(deftest position-if-not.error.3
-  (signals-error (position-if-not 'null 1.4) type-error)
-  t)
+  (check-type-error #'(lambda (x) (position-if-not #'identity x)) #'sequencep)
+  nil)
 
 (deftest position-if-not.error.4
   (signals-error (position-if-not 'identity '(a b c . d)) type-error)
diff --git a/ansi-tests/position-if.lsp b/ansi-tests/position-if.lsp
index 413b490a..3e244fc7 100644
--- a/ansi-tests/position-if.lsp
+++ b/ansi-tests/position-if.lsp
@@ -535,16 +535,8 @@
 ;;; Error tests
 
 (deftest position-if.error.1
-  (signals-error (position-if #'identity 'b) type-error)
-  t)
-
-(deftest position-if.error.2
-  (signals-error (position-if #'identity 10) type-error)
-  t)
-
-(deftest position-if.error.3
-  (signals-error (position-if 'null 1.4) type-error)
-  t)
+  (check-type-error #'(lambda (x) (position-if #'identity x)) #'sequencep)
+  nil)
 
 (deftest position-if.error.4
   (signals-error (position-if 'null '(a b c . d)) type-error)
diff --git a/ansi-tests/position.lsp b/ansi-tests/position.lsp
index 58cf16d2..6c61d903 100644
--- a/ansi-tests/position.lsp
+++ b/ansi-tests/position.lsp
@@ -808,16 +808,8 @@
 ;;; Error tests
 
 (deftest position.error.1
-  (signals-error (position 'a 'b) type-error)
-  t)
-
-(deftest position.error.2
-  (signals-error (position 'a 10) type-error)
-  t)
-
-(deftest position.error.3
-  (signals-error (position 'a 1.4) type-error)
-  t)
+  (check-type-error #'(lambda (x) (position 'a x)) #'sequencep)
+  nil)
 
 (deftest position.error.4
   (signals-error (position 'e '(a b c . d)) type-error)
diff --git a/ansi-tests/pprint-logical-block.lsp b/ansi-tests/pprint-logical-block.lsp
index 49bf0cb3..c049afc1 100644
--- a/ansi-tests/pprint-logical-block.lsp
+++ b/ansi-tests/pprint-logical-block.lsp
@@ -252,51 +252,42 @@ abcd3")
 ;;; Error cases
 
 (deftest pprint-logical-block.error.1
-  (loop for x in *mini-universe*
-	for form = `(pprint-logical-block (*standard-output* '(1) :prefix ',x))
-	unless (or (stringp x)
-		   (eq (eval `(signals-error ,form type-error)) t))
-	collect x)
+  (check-type-error #'(lambda (x)
+			(pprint-logical-block (*standard-output* '(1) :prefix x)))
+		    #'stringp)
   nil)
 
 (deftest pprint-logical-block.error.1-unsafe
-  (loop for x in *mini-universe*
-	for form = `(pprint-logical-block (*standard-output* '(1) :prefix ',x))
-	unless (or (stringp x)
-		   (eq (eval `(signals-error ,form type-error :safety 0)) t))
-	collect x)
+  (check-type-error #'(lambda (x)
+			(declare (optimize (safety 0)))
+			(pprint-logical-block (*standard-output* '(1) :prefix x)))
+		    #'stringp)
   nil)
 
 (deftest pprint-logical-block.error.2
-  (loop for x in *mini-universe*
-	for form = `(pprint-logical-block (*standard-output* '(1) :suffix ',x))
-	unless (or (stringp x)
-		   (eq (eval `(signals-error ,form type-error)) t))
-	collect x)
+  (check-type-error #'(lambda (x)
+			(pprint-logical-block (*standard-output* '(1) :suffix x)))
+		    #'stringp)
   nil)
 
 (deftest pprint-logical-block.error.2-unsafe
-  (loop for x in *mini-universe*
-	for form = `(pprint-logical-block (*standard-output* '(1) :suffix ',x))
-	unless (or (stringp x)
-		   (eq (eval `(signals-error ,form type-error :safety 0)) t))
-	collect x)
+  (check-type-error #'(lambda (x)
+			(declare (optimize (safety 0)))
+			(pprint-logical-block (*standard-output* '(1) :suffix x)))
+		    #'stringp)
   nil)
 
 (deftest pprint-logical-block.error.3
-  (loop for x in *mini-universe*
-	for form = `(pprint-logical-block (*standard-output* '(1) :per-line-prefix ',x))
-	unless (or (stringp x)
-		   (eq (eval `(signals-error ,form type-error)) t))
-	collect x)
+  (check-type-error #'(lambda (x)
+			(pprint-logical-block (*standard-output* '(1) :per-line-prefix x)))
+		    #'stringp)
   nil)
 
 (deftest pprint-logical-block.error.3-unsafe
-  (loop for x in *mini-universe*
-	for form = `(pprint-logical-block (*standard-output* '(1) :per-line-prefix ',x))
-	unless (or (stringp x)
-		   (eq (eval `(signals-error ,form type-error :safety 0)) t))
-	collect x)
+  (check-type-error #'(lambda (x)
+			(declare (optimize (safety 0)))
+			(pprint-logical-block (*standard-output* '(1) :per-line-prefix x)))
+		    #'stringp)
   nil)
 
 (deftest pprint-logical-block.error.4
diff --git a/ansi-tests/pprint-newline.lsp b/ansi-tests/pprint-newline.lsp
index fc35ec4a..f5ce5ac4 100644
--- a/ansi-tests/pprint-newline.lsp
+++ b/ansi-tests/pprint-newline.lsp
@@ -453,17 +453,13 @@ A "
 ;;; Error cases
 
 (deftest pprint-newline.error.1
-  (loop for x in *mini-universe*
-	unless (member x '(:linear :miser :fill :mandatory))
-	unless (eval `(signals-error (pprint-newline ',x) type-error))
-	collect x)
+  (check-type-error #'pprint-newline
+		    (typef '(member :linear :miser :fill :mandatory)))
   nil)
 
 (deftest pprint-newline.error.1-unsafe
-  (loop for x in *mini-universe*
-	unless (member x '(:linear :miser :fill :mandatory))
-	unless (eval `(signals-error (locally (declare (optimize (safety 0))) (pprint-newline ',x)) type-error))
-	collect x)
+  (check-type-error #'(lambda (x) (declare (optimize (safety 0))) (pprint-newline x))
+		    (typef '(member :linear :miser :fill :mandatory)))
   nil)
 
 (deftest pprint-newline.error.2
diff --git a/ansi-tests/random-types.lsp b/ansi-tests/random-types.lsp
index 613ba3ed..7914802a 100644
--- a/ansi-tests/random-types.lsp
+++ b/ansi-tests/random-types.lsp
@@ -18,7 +18,7 @@
 		   (random-from-interval r (- r)))))
        (1 (random-from-seq #(integer unsigned-byte ratio rational real float
 			     short-float single-float double-float
-			     long-float complex symbol cons)))
+			     long-float complex symbol cons function)))
        (1
 	(let* ((len (random *maximum-random-int-bits*))
 	       (r1 (ash 1 len))
@@ -36,8 +36,14 @@
 	       (sizes (random-partition (1- size) nargs)))
 	  `(,op ,@(mapcar #'make-random-type sizes))))
      (1 `(not ,(make-random-type (1- size))))
+     (1 (make-random-function-type size))
      )))
 
+(defun make-random-function-type (size)
+  (let* ((sizes (random-partition (1- size) 2))
+	 (types (mapcar #'make-random-type sizes)))
+    `(function (,(car types)) ,(cadr types))))
+
 (defun test-random-types (n size)
   (loop for t1 = (make-random-type size)
 	for t2 = (make-random-type size)
diff --git a/ansi-tests/random.lsp b/ansi-tests/random.lsp
index 104f9c1b..0496a359 100644
--- a/ansi-tests/random.lsp
+++ b/ansi-tests/random.lsp
@@ -17,10 +17,7 @@
   t)
 
 (deftest random.error.3
-  (loop for x in *mini-universe*
-	unless (or (and (realp x) (> x 0))
-		   (eval `(signals-error (random ',x) type-error)))
-	collect x)
+  (check-type-error #'random (typef '(real (0))))
   nil)
 
 (deftest random.1
diff --git a/ansi-tests/rassoc-if-not.lsp b/ansi-tests/rassoc-if-not.lsp
index f426a748..72cd1da9 100644
--- a/ansi-tests/rassoc-if-not.lsp
+++ b/ansi-tests/rassoc-if-not.lsp
@@ -140,3 +140,7 @@
 (deftest rassoc-if-not.error.11
   (signals-error (rassoc-if-not #'identity '((a . b) . c)) type-error)
   t)
+
+(deftest rassoc-if-not.error.12
+  (check-type-error #'(lambda (x) (rassoc-if-not #'identity x)) #'listp)
+  nil)
diff --git a/ansi-tests/rassoc-if.lsp b/ansi-tests/rassoc-if.lsp
index 96ce39b6..1a25e22b 100644
--- a/ansi-tests/rassoc-if.lsp
+++ b/ansi-tests/rassoc-if.lsp
@@ -137,3 +137,6 @@
   (signals-error (rassoc-if #'not '((a . b) . c)) type-error)
   t)
 
+(deftest rassoc-if.error.12
+  (check-type-error #'(lambda (x) (rassoc-if #'identity x)) #'listp)
+  nil)
diff --git a/ansi-tests/rassoc.lsp b/ansi-tests/rassoc.lsp
index fc1d648c..30280838 100644
--- a/ansi-tests/rassoc.lsp
+++ b/ansi-tests/rassoc.lsp
@@ -303,3 +303,7 @@
 (deftest rassoc.error.10
   (signals-error (rassoc 'z '((a . b) . c)) type-error)
   t)
+
+(deftest rassoci.error.11
+  (check-type-error #'(lambda (x) (rassoc 'a x)) #'listp)
+  nil)
diff --git a/ansi-tests/rational.lsp b/ansi-tests/rational.lsp
index 0c1082a6..cafc5468 100644
--- a/ansi-tests/rational.lsp
+++ b/ansi-tests/rational.lsp
@@ -18,10 +18,7 @@
   t)
 
 (deftest rational.error.4
-  (loop for x in *mini-universe*
-	unless (or (realp x)
-		   (eval `(signals-error (rational ',x) type-error)))
-	collect x)
+  (check-type-error #'rational #'realp)
   nil)
 
 (deftest rational.1
diff --git a/ansi-tests/rationalize.lsp b/ansi-tests/rationalize.lsp
index 8bd92c8f..d39aabe0 100644
--- a/ansi-tests/rationalize.lsp
+++ b/ansi-tests/rationalize.lsp
@@ -18,10 +18,7 @@
   t)
 
 (deftest rationalize.error.4
-  (loop for x in *mini-universe*
-	unless (or (realp x)
-		   (eval `(signals-error (rationalize ',x) type-error)))
-	collect x)
+  (check-type-error #'rationalize #'realp)
   nil)
 
 (deftest rationalize.1
diff --git a/ansi-tests/read-byte.lsp b/ansi-tests/read-byte.lsp
index 72fe845c..5b179725 100644
--- a/ansi-tests/read-byte.lsp
+++ b/ansi-tests/read-byte.lsp
@@ -132,10 +132,7 @@
   t t)
 
 (deftest read-byte.error.5
-  (loop for x in *mini-universe*
-	unless (or (streamp x)
-		   (eval `(signals-error (read-byte ',x) type-error)))
-	collect x)
+  (check-type-error #'read-byte #'streamp)
   nil)
 
 (deftest read-byte.error.6
@@ -177,10 +174,7 @@
   t)
 
 (deftest write-byte.error.4
-  (loop for x in *mini-universe*
-	unless (or (streamp x)
-		   (eval `(signals-error (write-byte 0 ',x) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (write-byte 0 x)) #'streamp)
   nil)
 
 (deftest write-byte.error.5
diff --git a/ansi-tests/read-sequence.lsp b/ansi-tests/read-sequence.lsp
index b6920f3a..8b91139b 100644
--- a/ansi-tests/read-sequence.lsp
+++ b/ansi-tests/read-sequence.lsp
@@ -254,10 +254,9 @@
   t)
 
 (deftest read-sequence.error.6
-  (signals-error
-   (read-sequence 'a (make-string-input-stream "abc"))
-   type-error)
-  t)
+  (check-type-error #'(lambda (x) (read-sequence x (make-string-input-stream "abc")))
+		    #'sequencep)
+  nil)
 
 (deftest read-sequence.error.7
   (signals-error
@@ -267,34 +266,28 @@
 
 ;;; This test appears to cause Allegro CL to crash
 (deftest read-sequence.error.8
-  (signals-error
-   (read-sequence (make-string 3) (make-string-input-stream "abc")
-		  :start -1)
-
-   type-error)
+  (signals-type-error x -1
+		      (read-sequence (make-string 3)
+				     (make-string-input-stream "abc")
+				     :start x))
   t)
 
 (deftest read-sequence.error.9
-  (signals-error
-   (read-sequence (make-string 3) (make-string-input-stream "abc")
-		  :start 'a)
-
-   type-error)
-  t)
+  (check-type-error #'(lambda (s)
+			(read-sequence (make-string 3) (make-string-input-stream "abc")
+				       :start s))
+		    (typef 'unsigned-byte))
+  nil)
 
 (deftest read-sequence.error.10
-  (signals-error
-   (read-sequence (make-string 3) (make-string-input-stream "abc")
-		  :end -1)
-   type-error)
+  (signals-type-error x -1
+		      (read-sequence (make-string 3) (make-string-input-stream "abc")
+				     :end x))
   t)
 
 (deftest read-sequence.error.11
-  (signals-error
-   (read-sequence (make-string 3) (make-string-input-stream "abc")
-		  :end 'b)
-   type-error)
-  t)
-
-
-
+  (check-type-error #'(lambda (e)
+			(read-sequence (make-string 3) (make-string-input-stream "abc")
+				       :end e))
+		    (typef '(or unsigned-byte null)))
+  nil)
diff --git a/ansi-tests/readtable-case.lsp b/ansi-tests/readtable-case.lsp
index 12853fc4..a6faf003 100644
--- a/ansi-tests/readtable-case.lsp
+++ b/ansi-tests/readtable-case.lsp
@@ -64,28 +64,18 @@
   t)
 
 (deftest readtable-case.error.3
-  (loop for x in *mini-universe*
-	for form = `(signals-error (readtable-case ',x) type-error)
-	unless (or (typep x 'readtable)
-		   (eql (eval form) t))
-	collect (list x form))
+  (check-type-error #'readtable-case (typef 'readtable))
   nil)
 
 (deftest readtable-case.error.4
-  (loop for x in *mini-universe*
-	for form = `(signals-error (let ((rt (copy-readtable)))
-				     (setf (readtable-case rt) ',x))
-				   type-error)
-	unless (or (member x '(:upcase :downcase :preserve :invert))
-		   (eql (eval form) t))
-	collect x)
+  (check-type-error #'(lambda (x)
+			(let ((rt (copy-readtable)))
+			  (setf (readtable-case rt) x)))
+		    (typef '(member :upcase :downcase :preserve :invert)))
   nil)
 
 (deftest readtable-case.error.5
-  (loop for x in *mini-universe*
-	for form = `(signals-error (setf (readtable-case ',x) :upcase)
-				   type-error)
-	unless (or (typep x 'readtable)
-		   (eql (eval form) t))
-	collect x)
+  (check-type-error #'(lambda (x) (setf (readtable-case x) :upcase))
+		    (typef 'readtable))
   nil)
+
diff --git a/ansi-tests/realpart.lsp b/ansi-tests/realpart.lsp
index 26049a13..c6198e24 100644
--- a/ansi-tests/realpart.lsp
+++ b/ansi-tests/realpart.lsp
@@ -14,10 +14,7 @@
   t)
 
 (deftest realpart.error.3
-  (loop for x in *mini-universe*
-	unless (or (numberp x)
-		   (eval `(signals-error (realpart ',x) type-error)))
-	collect x)
+  (check-type-error #'realpart #'numberp)
   nil)
 
 (deftest realpart.1
-- 
GitLab