diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp
index 11daeb72437cfade76052d724adf23d483e48739..7b0808e5ba9cd08ea04e3eed6abc6df61ebbac4e 100644
--- a/ansi-tests/ansi-aux.lsp
+++ b/ansi-tests/ansi-aux.lsp
@@ -172,9 +172,10 @@ Results: ~A~%" expected-number form n results))))
     (assert (fboundp p))
     (setf p (symbol-function p)))
   (assert (typep p 'function))
-  
+
   (loop
-      for x in *universe* count
+      for x in *universe*
+      when
 	(block failed
 	  (let ((p1 (handler-case
 			(normally (funcall (the function p) x))
@@ -190,7 +191,18 @@ Results: ~A~%" expected-number form n results))))
 			(and (not p1) p2))
 		(format t "(FUNCALL ~S ~S) = ~S, (TYPEP ~S '~S) = ~S~%"
 			P x p1 x TYPE p2)
-		t)))))
+		t)))
+	collect x))
+
+;;; We have a common idiom where a guarded predicate should be
+;;; true everywhere
+
+(defun check-predicate (predicate &optional guard (universe *universe*))
+  "Return all elements of UNIVERSE for which the guard (if present) is false
+   and for which PREDICATE is false."
+  (remove-if #'(lambda (e) (or (and guard (funcall guard e))
+			       (funcall predicate e)))
+	     universe))
 
 (declaim (special *catch-error-type*))
 
diff --git a/ansi-tests/array-rank.lsp b/ansi-tests/array-rank.lsp
index 6126d5e3618259a388597bf04ce9e7f5db40d929..e08dc1f7b502936cb765da1d58562d9eb31959b2 100644
--- a/ansi-tests/array-rank.lsp
+++ b/ansi-tests/array-rank.lsp
@@ -12,10 +12,8 @@
   0)
 
 (deftest array-rank.2
-  (loop for e in *universe*
-	when (and (typep e 'vector)
-		  (not (eql (array-rank e) 1)))
-	collect e)
+  (check-predicate #'(lambda (e) (or (not (typep e 'vector))
+				     (eql (array-rank e) 1))))
   nil)
 
 (deftest array-rank.order.1
diff --git a/ansi-tests/arrayp.lsp b/ansi-tests/arrayp.lsp
index eadc342d2d83532363d0c19ae3a40e8bc986d134..341626add881068ece18ff6749171867be173e45 100644
--- a/ansi-tests/arrayp.lsp
+++ b/ansi-tests/arrayp.lsp
@@ -28,12 +28,7 @@
   t)
 
 (deftest arrayp.6
-  (loop for e in *universe*
-	for a = (arrayp e)
-	for b = (typep e 'array)
-	when (or (and a (not b))
-		 (and b (not a)))
-	collect e)
+  (check-type-predicate #'arrayp 'array)
   nil)
 
 (deftest arrayp.order.1
diff --git a/ansi-tests/bit-vector-p.lsp b/ansi-tests/bit-vector-p.lsp
index 0100befe9b2813bbe34d9cf3c9b99ed45b2940ef..8898adf31a0db285e9e1f32c9b9684c7c42937f3 100644
--- a/ansi-tests/bit-vector-p.lsp
+++ b/ansi-tests/bit-vector-p.lsp
@@ -47,11 +47,8 @@
   nil)
 
 (deftest bit-vector-p.12
-  (loop for e in *universe*
-	for p1 = (typep e 'bit-vector)
-	for p2 = (bit-vector-p e)
-	always (if p1 p2 (not p2)))
-  t)
+  (check-type-predicate #'bit-vector-p 'bit-vector)
+  nil)
 
 (deftest bit-vector-p.order.1
   (let ((i 0) x)
diff --git a/ansi-tests/coerce.lsp b/ansi-tests/coerce.lsp
index 126b5f66b37a2afead441b08b96c165a16bfc08b..ea4c798915d4871dbe755b64e09ce38049050788 100644
--- a/ansi-tests/coerce.lsp
+++ b/ansi-tests/coerce.lsp
@@ -6,22 +6,21 @@
 (in-package :cl-test)
 
 (deftest coerce.1
-  (loop for x in *universe*
-	for type = (type-of x)
-	unless (and (consp type) (eqt (car type) 'function))
-	count (not (eql (coerce x type) x)))
-  0)
+  (check-predicate #'(lambda (x)
+		       (let ((type (type-of x)))
+			 (or (and (consp type) (eqt (car type) 'function))
+			     (eql (coerce x type) x)))))
+  nil)
 
 (deftest coerce.2
-  (loop for x in *universe*
-	count (not (eql (coerce x t) x)))
-  0)
+  (check-predicate #'(lambda (x) (eql (coerce x t) x)))
+  nil)
 
 (deftest coerce.3
-  (loop for x in *universe*
-	for class = (class-of x)
-	when (and class (not (eql (coerce x class) x)))
-	collect x)
+  (check-predicate
+   #'(lambda (x)
+       (let ((class (class-of x)))
+	 (eql (coerce x class) x))))
   nil)
 
 (deftest coerce.4
diff --git a/ansi-tests/compiled-function-p.lsp b/ansi-tests/compiled-function-p.lsp
index 27cd82a6d43cf1e8676651c45def14ddcd87aaa9..d98489fdd9b89aa987920c709636c18460638044 100644
--- a/ansi-tests/compiled-function-p.lsp
+++ b/ansi-tests/compiled-function-p.lsp
@@ -6,11 +6,7 @@
 (in-package :cl-test)
 
 (deftest compiled-function-p.1
-  (some #'(lambda (obj)
-	     (if (check-values (compiled-function-p obj))
-		 (not (typep obj 'compiled-function))
-	       (typep obj 'compiled-function)))
-	 *universe*)
+  (check-type-predicate #'compiled-function-p 'compiled-function)
   nil)
 
 (deftest compiled-function-p.2
diff --git a/ansi-tests/complement.lsp b/ansi-tests/complement.lsp
index ddcd6f0c00751807b8282257ce43c0d1952f0ee2..fefb1a3cf9c05f6ee426298c19bc7aa35c541df0 100644
--- a/ansi-tests/complement.lsp
+++ b/ansi-tests/complement.lsp
@@ -14,10 +14,10 @@
   nil)
 
 (deftest complement.3
-  (every #'(lambda (x) (eql (funcall (cl::complement #'not) x)
-			    (not (not x))))
-	 *universe*)
-  t)
+  (check-predicate
+   #'(lambda (x) (eql (funcall (cl::complement #'not) x)
+		      (not (not x)))))
+  nil)
 
 (deftest complement.4
   (let ((x '(#\b)))
diff --git a/ansi-tests/complexp.lsp b/ansi-tests/complexp.lsp
index 9c5dd24e9dd4af6c06d227a1ede728613f3a7d4b..3bcd96184456d3a5abf895077c36408ec806a011 100644
--- a/ansi-tests/complexp.lsp
+++ b/ansi-tests/complexp.lsp
@@ -18,11 +18,5 @@
   t)
 
 (deftest complexp.1
-  (loop for x in *universe*
-	for vals = (multiple-value-list (complexp x))
-	when (or (/= (length vals) 1)
-		 (if (typep x 'complex)
-		     (not (car vals))
-		   (car vals)))
-	collect (cons x vals))
+  (check-type-predicate #'complexp 'complex)
   nil)
diff --git a/ansi-tests/cons-test-01.lsp b/ansi-tests/cons-test-01.lsp
index 02c15a0ed3a1aaa5544d67f76e97beb3648c517f..18cd3f60efcd1a3119a7cae80dad851b7db7f43b 100644
--- a/ansi-tests/cons-test-01.lsp
+++ b/ansi-tests/cons-test-01.lsp
@@ -54,7 +54,7 @@
 ;;
 (deftest null-null-universe
   (check-type-predicate 'null 'null)
-  0)
+  nil)
 
 (defvar *cons-fns*
   (list 'cons 'consp 'atom 'rplaca 'rplacd
diff --git a/ansi-tests/consp.lsp b/ansi-tests/consp.lsp
index 13493d4c3dff6bebad7001674cb9090a65c743c5..c141d54dd29fbd3ee0081983a2a4fe44d7fd44e1 100644
--- a/ansi-tests/consp.lsp
+++ b/ansi-tests/consp.lsp
@@ -35,16 +35,14 @@
 ;; For everything in *universe*, it is either an atom, or satisfies
 ;; consp, but not both
 (deftest consp-xor-atom-universe
-  (notnot-mv
-   (every #'(lambda (x) (or (and (consp x) (not (atom x)))
-			    (and (not (consp x)) (atom x))))
-	  *universe*))
-  t)
+  (check-predicate #'(lambda (x) (or (and (consp x) (not (atom x)))
+				     (and (not (consp x)) (atom x)))))
+  nil)
 
 ;; Everything in type cons satisfies consp, and vice versa
 (deftest consp-cons-universe
   (check-type-predicate 'consp 'cons)
-  0)
+  nil)
 
 (deftest consp.order.1
   (let ((i 0))
diff --git a/ansi-tests/constantp.lsp b/ansi-tests/constantp.lsp
index bf8dc08603f28be319ba85a5ae21bb3879865f19..a3801106339e85bd94a54408195a43dd0e24c53a 100644
--- a/ansi-tests/constantp.lsp
+++ b/ansi-tests/constantp.lsp
@@ -20,11 +20,7 @@
 ;;; Non-error tests
 
 (deftest constantp.1
-  (loop for e in *universe*
-	when (and (not (symbolp e))
-		   (not (consp e))
-		   (not (constantp e)))
-	collect e)
+  (check-predicate #'(lambda (e) (or (symbolp e) (consp e) (constantp e))))
   nil)
 
 (deftest constantp.2
diff --git a/ansi-tests/copy-alist.lsp b/ansi-tests/copy-alist.lsp
index b72d1574f60f78fd3324b91b346f3d1c2507ab53..c43bfc1827df879bc969352aea9193ad2c8e7cbd 100644
--- a/ansi-tests/copy-alist.lsp
+++ b/ansi-tests/copy-alist.lsp
@@ -25,9 +25,9 @@
        t))
   t)
 
-(def-fold-test copy-alist.1 (copy-alist '((a . b) nil (c . d))))
-(def-fold-test copy-alist.2 (car (copy-alist '((a . b) nil (c . d)))))
-(def-fold-test copy-alist.3 (caddr (copy-alist '((a . b) nil (c . d)))))
+(def-fold-test copy-alist.2 (copy-alist '((a . b) nil (c . d))))
+(def-fold-test copy-alist.3 (car (copy-alist '((a . b) nil (c . d)))))
+(def-fold-test copy-alist.4 (caddr (copy-alist '((a . b) nil (c . d)))))
 
 ;;; Error tests
 
diff --git a/ansi-tests/eql.lsp b/ansi-tests/eql.lsp
index e85a6d9d9867141485487181e835de6165bbc7d2..2f7f529f9bc8bc6e628ee279e8740b9490061cb3 100644
--- a/ansi-tests/eql.lsp
+++ b/ansi-tests/eql.lsp
@@ -10,8 +10,8 @@
 ;;; is true.
 
 (deftest eql.1
-  (loop for x in *universe* always (check-values (eql x x)))
-  t)
+  (check-predicate #'(lambda (x) (eql x x)))
+  nil)
 
 (deftest eql.2
   (eqlt 2 (1+ 1))
diff --git a/ansi-tests/floatp.lsp b/ansi-tests/floatp.lsp
index 0d4cf1c2b9706a1b97fac9a5e4ed849e7150b96e..a52440142fe8d0f28817fb8d7c72ce01415951d3 100644
--- a/ansi-tests/floatp.lsp
+++ b/ansi-tests/floatp.lsp
@@ -26,12 +26,6 @@
   nil)
 
 (deftest floatp.3
-  (loop for x in *universe*
-	for vals = (multiple-value-list (floatp x))
-	unless (and (= (length vals) 1)
-		    (if (car vals)
-			(typep x 'float)
-		      (not (typep x 'float))))
-	collect x)
+  (check-type-predicate #'floatp 'float)
   nil)
 
diff --git a/ansi-tests/function.lsp b/ansi-tests/function.lsp
index 07ead156b3226b153516a0145f2b8bc3e2a9763a..0d1e01e48c489ada4cad59f4cbacef6d055685b4 100644
--- a/ansi-tests/function.lsp
+++ b/ansi-tests/function.lsp
@@ -65,12 +65,9 @@
 ;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL.
 ;;; In ANSI CL, symbols and cons can no longer also be of type FUNCTION.
 (deftest function.10
-  (loop for x in *universe*
-	when (and (or (numberp x) (characterp x)
-		      (symbolp x) (consp x)
-		      (typep x 'array))
-		  (typep x 'function))
-	collect x)
+  (check-predicate (typef '(not (and (or number character symbol
+					 cons array)
+				     function))))
   nil)
 
 (deftest function.11
diff --git a/ansi-tests/functionp.lsp b/ansi-tests/functionp.lsp
index af2723db51e7c7ac3ada82b606852639b85244d4..7b3b355a7bb623dc0988a4e05817faea0e7fc4d4 100644
--- a/ansi-tests/functionp.lsp
+++ b/ansi-tests/functionp.lsp
@@ -63,12 +63,11 @@
 
 ;;; In ANSI CL, symbols and cons can no longer be functions
 (deftest functionp.10
-  (loop for x in *universe*
-	when (and (or (numberp x) (characterp x)
-		      (symbolp x) (consp x)
-		      (typep x 'array))
-		  (functionp x))
-	collect x)
+  (check-predicate #'(lambda (x)
+		       (not (and (or (numberp x) (characterp x)
+				     (symbolp x) (consp x)
+				     (typep x 'array))
+				 (functionp x)))))
   nil)
 
 (deftest functionp.11
@@ -79,6 +78,8 @@
   (flet ((%f () nil)) (not-mv (functionp #'%f)))
   nil)
 
+;;; TODO: Add check-type-predicate test?
+
 (deftest functionp.order.1
   (let ((i 0))
     (values
diff --git a/ansi-tests/hash-table-p.lsp b/ansi-tests/hash-table-p.lsp
index 713f8d6ed7ff864d8079742270597beec6487160..1fa211f0867340922b468d15f677fe6eb070aef4 100644
--- a/ansi-tests/hash-table-p.lsp
+++ b/ansi-tests/hash-table-p.lsp
@@ -14,11 +14,8 @@
   nil)
 
 (deftest hash-table-p.2
-  (loop for e in *universe*
-	for p = (typep e 'hash-table)
-	for q = (hash-table-p e)
-	always (if p q (not q)))
-  t)
+  (check-type-predicate #'hash-table-p 'hash-table)
+  nil)
 
 (deftest hash-table-p.3
   (let ((i 0))
diff --git a/ansi-tests/identity.lsp b/ansi-tests/identity.lsp
index a2d666c59d23cc0b3e605667929d89a7162ae814..02fb021c4178b9dad1e19a755cd22cd287edc1f7 100644
--- a/ansi-tests/identity.lsp
+++ b/ansi-tests/identity.lsp
@@ -6,9 +6,8 @@
 (in-package :cl-test)
 
 (deftest identity.1
-  (loop for x in *universe*
-	always (eqlt x (check-values (identity x))))
-  t)
+  (check-predicate #'(lambda (x) (eqlt x (check-values (identity x)))))
+  nil)
 
 (deftest identity.2
   (let ((x (ash 1 100)))
diff --git a/ansi-tests/listp.lsp b/ansi-tests/listp.lsp
index bfc0810ef2645c4ecbc37f611e6f014ff5352fd4..df099d1319f39d8ddc61ce5ae01a3385fbb6801d 100644
--- a/ansi-tests/listp.lsp
+++ b/ansi-tests/listp.lsp
@@ -33,7 +33,7 @@
 
 (deftest listp-universe
   (check-type-predicate 'listp 'list)
-  0)
+  nil)
 
 (deftest listp.order.1
   (let ((i 0))
diff --git a/ansi-tests/macroexpand-1.lsp b/ansi-tests/macroexpand-1.lsp
index 3cac79bb9f787cd7be364b02f850d849f49288f5..cdc5a025797c9f1aebe9d71da801383830e4db77 100644
--- a/ansi-tests/macroexpand-1.lsp
+++ b/ansi-tests/macroexpand-1.lsp
@@ -16,49 +16,39 @@
 ;;; Non-error tests
 
 (deftest macroexpand-1.1
-  (let (vals)
-    (loop for x in *universe*
-	  unless (or (symbolp x)
-		     (consp x)
-		     (progn
-		       (setq vals (multiple-value-list (macroexpand-1 x)))
-		       (and (= (length vals) 2)
-			    (eql (car vals) x)
-			    (null (cadr vals)))))
-	  collect (cons x vals)))
+  (check-predicate
+   #'(lambda (x)
+       (or (symbolp x) (consp x)
+	   (let ((vals (multiple-value-list (macroexpand-1 x))))
+	     (and (= (length vals) 2)
+		  (eql (car vals) x)
+		  (null (cadr vals)))))))
   nil)
 
 (deftest macroexpand-1.2
-  (let (vals)
-    (loop for x in *universe*
-	  unless (or (symbolp x)
-		     (consp x)
-		     (progn
-		       (setq vals (multiple-value-list (macroexpand-1 x nil)))
-		       (and (= (length vals) 2)
-			    (eql (car vals) x)
-			    (null (cadr vals)))))
-	  collect (cons x vals)))
+  (check-predicate
+   #'(lambda (x)
+       (or (symbolp x) (consp x)
+	   (let ((vals (multiple-value-list (macroexpand-1 x nil))))
+	     (and (= (length vals) 2)
+		  (eql (car vals) x)
+		  (null (cadr vals)))))))
   nil)
 
 (deftest macroexpand-1.3
   (macrolet
       ((%m (&environment env)
 	   `(quote
-	     ,(let (vals)
-		(loop for x in *universe*
-		      unless (or (symbolp x)
-				 (consp x)
-				 (progn
-				   (setq vals (multiple-value-list (macroexpand-1 x env)))
-				   (and (= (length vals) 2)
-					(eql (car vals) x)
-					(null (cadr vals)))))
-		      collect (cons x vals))))))
+	     ,(check-predicate
+	       #'(lambda (x)
+		   (or (symbolp x) (consp x)
+		       (let ((vals (multiple-value-list (macroexpand-1 x env))))
+			 (and (= (length vals) 2)
+			      (eql (car vals) x)
+			      (null (cadr vals))))))))))
     (%m))
   nil)
 
-
 (deftest macroexpand-1.4
   (macrolet ((%m () ''foo))
     (macrolet ((%m2 (&environment env)
diff --git a/ansi-tests/macroexpand.lsp b/ansi-tests/macroexpand.lsp
index c458f35d3a99254748eb00afaf500e1336a0467c..3c70a344524dc46eec591ce6e213c947a308ca2e 100644
--- a/ansi-tests/macroexpand.lsp
+++ b/ansi-tests/macroexpand.lsp
@@ -16,49 +16,38 @@
 ;;; Non-error tests
 
 (deftest macroexpand.1
-  (let (vals)
-    (loop for x in *universe*
-	  unless (or (symbolp x)
-		     (consp x)
-		     (progn
-		       (setq vals (multiple-value-list (macroexpand x)))
-		       (and (= (length vals) 2)
-			    (eql (car vals) x)
-			    (null (cadr vals)))))
-	  collect (cons x vals)))
+  (check-predicate
+   #'(lambda (x)
+       (or (symbolp x) (consp x)
+	   (let ((vals (multiple-value-list (macroexpand x))))
+	     (and (= (length vals) 2)
+		  (eql (car vals) x)
+		  (null (cadr vals)))))))
   nil)
 
 (deftest macroexpand.2
-  (let (vals)
-    (loop for x in *universe*
-	  unless (or (symbolp x)
-		     (consp x)
-		     (progn
-		       (setq vals (multiple-value-list (macroexpand x nil)))
-		       (and (= (length vals) 2)
-			    (eql (car vals) x)
-			    (null (cadr vals)))))
-	  collect (cons x vals)))
+  (check-predicate
+   #'(lambda (x)
+       (or (symbolp x) (consp x)
+	   (let ((vals (multiple-value-list (macroexpand x nil))))
+	     (and (= (length vals) 2)
+		  (eql (car vals) x)
+		  (null (cadr vals)))))))
   nil)
 
 (deftest macroexpand.3
   (macrolet
       ((%m (&environment env)
 	   `(quote
-	     ,(let (vals)
-		(loop for x in *universe*
-		      unless (or (symbolp x)
-				 (consp x)
-				 (progn
-				   (setq vals (multiple-value-list (macroexpand x env)))
+	     ,(check-predicate
+	       #'(lambda (x) (or (symbolp x) (consp x)
+				 (let ((vals (multiple-value-list (macroexpand x env))))
 				   (and (= (length vals) 2)
 					(eql (car vals) x)
-					(null (cadr vals)))))
-		      collect (cons x vals))))))
+					(null (cadr vals))))))))))
     (%m))
   nil)
 
-
 (deftest macroexpand.4
   (macrolet ((%m () ''foo))
     (macrolet ((%m2 (&environment env)
diff --git a/ansi-tests/nil.lsp b/ansi-tests/nil.lsp
index b0f567416f5be4cdd2d17a11eb718fa533a6a5e2..1c369f88c50e8daa8301fb327d362e8b21921098 100644
--- a/ansi-tests/nil.lsp
+++ b/ansi-tests/nil.lsp
@@ -6,15 +6,12 @@
 (in-package :cl-test)
 
 (deftest nil.1
-  (loop for x in *universe*
-	thereis (subtypep (type-of x) nil))
+  (check-predicate #'(lambda (x) (not (subtypep (type-of x) nil))))
   nil)
 
 
 (deftest nil.2
-  (loop for x in *universe*
-	unless (subtypep nil (type-of x))
-	collect (type-of x))
+  (check-predicate #'(lambda (x) (subtypep nil (type-of x))))
   nil)
 
 (deftest nil.3
diff --git a/ansi-tests/numberp.lsp b/ansi-tests/numberp.lsp
index 9ae321ba39ac74c94e717dc2900ac53d70802d09..08931f781bef24fbabae96f96f9be174a82c32dc 100644
--- a/ansi-tests/numberp.lsp
+++ b/ansi-tests/numberp.lsp
@@ -18,11 +18,5 @@
   t)
 
 (deftest numberp.1
-  (loop for x in *universe*
-	for vals = (multiple-value-list (numberp x))
-	for val = (car vals)
-	unless (and (= (length vals) 1)
-		    (if val (typep x 'number)
-		      (not (typep x 'number))))
-	collect (cons x vals))
+  (check-type-predicate #'numberp 'number)
   nil)
diff --git a/ansi-tests/packagep.lsp b/ansi-tests/packagep.lsp
index 77793506634ce5c56e9509214d0162cce1c8d99f..94290b1628e684ee77125504bd6c5b4a263663b4 100644
--- a/ansi-tests/packagep.lsp
+++ b/ansi-tests/packagep.lsp
@@ -6,15 +6,8 @@
 (in-package :cl-test)
 
 (deftest packagep.1
-  (loop
-   for x in *universe* count
-   (unless (eqt (not (packagep x))
-		(not (typep x 'package)))
-	   (format t
-		   "(packagep ~S) = ~S, (typep x 'package) = ~S~%"
-		   x (packagep x) x (typep x 'package))
-	   t))
-  0)
+  (check-type-predicate #'packagep 'package)
+  nil)
 
 ;;; *package* is always a package
 
diff --git a/ansi-tests/pathnamep.lsp b/ansi-tests/pathnamep.lsp
index 9c6cf01f5917b14de5b2602f86435b64184b90ac..e796847a0842e390a20011981de12a8f74f4d1c1 100644
--- a/ansi-tests/pathnamep.lsp
+++ b/ansi-tests/pathnamep.lsp
@@ -6,22 +6,16 @@
 (in-package :cl-test)
 
 (deftest pathnamep.1
-  (loop for x in *universe*
-	unless (if (pathnamep x) (typep x 'pathname)
-		 (not (typep x 'pathname)))
-	collect x)
+  (check-type-predicate #'pathnamep 'pathname)
   nil)
 
 (deftest pathnamep.2
-  (loop for x in *universe*
-	always (eql (length (multiple-value-list (pathnamep x))) 1))
-  t)
+  (check-predicate #'(lambda (x) (eql (length (multiple-value-list (pathnamep x))) 1)))
+  nil)
 
 (deftest pathnamep.3
-  (loop for x in *universe*
-	always (or (not (typep x 'logical-pathname))
-		   (pathnamep x)))
-  t)
+  (check-predicate (typef '(not logical-pathname)) #'pathnamep)
+  nil)
 
 (deftest pathnamep.error.1
   (signals-error (pathnamep) program-error)
diff --git a/ansi-tests/random-state-p.lsp b/ansi-tests/random-state-p.lsp
index 87d71fe6bba8c71a55bd654358344aa6759fbf15..0b78c8384218813d00f6ed83dae140c02a3ae1b2 100644
--- a/ansi-tests/random-state-p.lsp
+++ b/ansi-tests/random-state-p.lsp
@@ -14,11 +14,7 @@
   t)
 
 (deftest random-state-p.1
-  (loop for x in *universe*
-	when (if (typep x 'random-state)
-		 (not (random-state-p x))
-	       (random-state-p x))
-	collect x)
+  (check-type-predicate #'random-state-p 'random-state)
   nil)
 
 (deftest random-state-p.2
diff --git a/ansi-tests/rationalp.lsp b/ansi-tests/rationalp.lsp
index 64b581c23271ce69c51f567397f71873d107ca78..796a0a8669e43f8b7b8c8ef60e5c8a0317a91f55 100644
--- a/ansi-tests/rationalp.lsp
+++ b/ansi-tests/rationalp.lsp
@@ -34,9 +34,7 @@
   nil)
 
 (deftest rationalp.3
-  (loop for x in *universe*
-	when (if (typep x 'rational) (not (rationalp x)) (rationalp x))
-	collect x)
+  (check-type-predicate #'rationalp 'rational)
   nil)
 
 
diff --git a/ansi-tests/readtablep.lsp b/ansi-tests/readtablep.lsp
index 0acce958ea18f9559cb129a45e4b14382642fe2f..a93dac86eb572ac66172bfb244ce5e7ceeb06902 100644
--- a/ansi-tests/readtablep.lsp
+++ b/ansi-tests/readtablep.lsp
@@ -33,10 +33,7 @@
   t)
 
 (deftest readtablep.2
-  (loop for x in *universe*
-	unless (if (typep x 'readtable) (readtablep x)
-		 (not (readtablep x)))
-	collect x)
+  (check-type-predicate #'readtablep 'readtable)
   nil)
 
 (deftest readtablep.3
diff --git a/ansi-tests/realp.lsp b/ansi-tests/realp.lsp
index 7d8ea97088205389a59c63ab8297645b4f93a898..8cbf4e9e8c21de6ced74a6f53a4730687dfad8aa 100644
--- a/ansi-tests/realp.lsp
+++ b/ansi-tests/realp.lsp
@@ -38,12 +38,8 @@
   nil)
 
 (deftest realp.6
-  (loop for x in *universe*
-	for vals = (multiple-value-list (realp x))
-	for p = (car vals)
-	when (or (/= (length vals) 1)
-		 (if (typep x 'real) (not p) p))
-	collect (cons x vals))
+  (check-type-predicate #'realp 'real)
   nil)
 
 
+
diff --git a/ansi-tests/simple-bit-vector-p.lsp b/ansi-tests/simple-bit-vector-p.lsp
index aaeff271c59bf4c8d1e8ff525e2529d6e53444c0..6c598dc9af37bdd4ff74f5041b36e367508ce824 100644
--- a/ansi-tests/simple-bit-vector-p.lsp
+++ b/ansi-tests/simple-bit-vector-p.lsp
@@ -47,11 +47,8 @@
   nil)
 
 (deftest simple-bit-vector-p.12
-  (loop for e in *universe*
-	for p1 = (typep e 'simple-bit-vector)
-	for p2 = (simple-bit-vector-p e)
-	always (if p1 p2 (not p2)))
-  t)
+  (check-type-predicate #'simple-bit-vector-p 'simple-bit-vector)
+  nil)
 
 (deftest simple-bit-vector-p.error.1
   (signals-error (simple-bit-vector-p) program-error)
diff --git a/ansi-tests/simple-string-p.lsp b/ansi-tests/simple-string-p.lsp
index 1959eef0b74db1b72aea5011bdf610315a061efc..b64255b8548a4dfc8b4c21f0cfbd397065d54abb 100644
--- a/ansi-tests/simple-string-p.lsp
+++ b/ansi-tests/simple-string-p.lsp
@@ -6,11 +6,8 @@
 (in-package :cl-test)
 
 (deftest simple-string-p.1
-  (loop for x in *universe*
-	always (if (typep x 'simple-string)
-		   (simple-string-p x)
-		 (not (simple-string-p x))))
-  t)
+  (check-type-predicate #'simple-string-p 'simple-string)
+  nil)
 
 (deftest simple-string-p.2
   (notnot-mv (simple-string-p "ancd"))
diff --git a/ansi-tests/simple-vector-p.lsp b/ansi-tests/simple-vector-p.lsp
index 18402b84b82d7c88cc01754d7f2562c14eb51882..48a03d46370aa04d4bfdd319472cbcc67dae3ca1 100644
--- a/ansi-tests/simple-vector-p.lsp
+++ b/ansi-tests/simple-vector-p.lsp
@@ -8,11 +8,7 @@
 ;;; More tests for this are in make-array.lsp
 
 (deftest simple-vector-p.1
-  (loop for e in *universe*
-	unless (if (typep e 'simple-vector)
-		   (simple-vector-p e)
-		 (not (simple-vector-p e)))
-	collect e)
+  (check-type-predicate #'simple-vector-p 'simple-vector)
   nil)
 
 (deftest simple-vector-p.2
diff --git a/ansi-tests/slot-exists-p.lsp b/ansi-tests/slot-exists-p.lsp
index b4c4ca0da30731bcbfd52464348174ef3ba3c2cf..c81bf3cc1d5d49eed7fcbb26fd5367e2772f6950 100644
--- a/ansi-tests/slot-exists-p.lsp
+++ b/ansi-tests/slot-exists-p.lsp
@@ -49,9 +49,7 @@
 
 (deftest slot-exists-p.8
   (let ((slot-name (gensym)))
-    (loop for x in *universe*
-	  when (slot-exists-p x slot-name)
-	  collect x))
+    (check-predicate #'(lambda (x) (not (slot-exists-p x slot-name)))))
   nil)
 
 ;;; With various types
diff --git a/ansi-tests/slot-value.lsp b/ansi-tests/slot-value.lsp
index 195dcfd89c601121dcad837a98543d980c2786d5..0a66f5a318ca2beedabe93fbf982cb4751b9ecd9 100644
--- a/ansi-tests/slot-value.lsp
+++ b/ansi-tests/slot-value.lsp
@@ -131,21 +131,21 @@
 (deftest slot-value.error.5
   (let ((built-in-class (find-class 'built-in-class))
 	(slot-name (gensym)))
-    (loop for e in *universe*
-	  for class = (class-of e)
-	  when (and (eq (class-of class) built-in-class)
-		    (handler-case (progn (slot-value e slot-name) t)
-				  (error () nil)))
-	  collect e))
+    (check-predicate
+     #'(lambda (e)
+	 (let ((class (class-of e)))
+	   (or (not (eq (class-of class) built-in-class))
+	       (handler-case (progn (slot-value e slot-name) nil)
+			     (error () t)))))))
   nil)
 
 (deftest slot-value.error.6
   (let ((built-in-class (find-class 'built-in-class))
 	(slot-name (gensym)))
-    (loop for e in *universe*
-	  for class = (class-of e)
-	  when (and (eq (class-of class) built-in-class)
-		    (handler-case (setf (slot-value e slot-name) t)
-				  (error () nil)))
-	  collect e))
+    (check-predicate
+     #'(lambda (e)
+	 (let ((class (class-of e)))
+	   (or (not (eq (class-of class) built-in-class))
+	       (handler-case (setf (slot-value e slot-name) nil)
+				  (error () t)))))))
   nil)
diff --git a/ansi-tests/streamp.lsp b/ansi-tests/streamp.lsp
index d4927431795afdc8adcad5b0e8d0b1ace1b3b209..2ffd9658a1ee5c21694bc2da2c7407226013d38b 100644
--- a/ansi-tests/streamp.lsp
+++ b/ansi-tests/streamp.lsp
@@ -15,11 +15,7 @@
   nil)
 
 (deftest streamp.2
-  (loop for x in *universe*
-	when (if (typep x 'stream)
-		 (not (streamp x))
-	       (streamp x))
-	collect x)
+  (check-type-predicate #'streamp 'stream)
   nil)
 
 (deftest streamp.3
diff --git a/ansi-tests/string.lsp b/ansi-tests/string.lsp
index b97ca2fc320ec9910cb0e3dd0015afebb446e5dc..70a971928b9d05e6d18dfad417732ec95f0240d5 100644
--- a/ansi-tests/string.lsp
+++ b/ansi-tests/string.lsp
@@ -33,10 +33,11 @@
   t "FOO")
 
 (deftest string.7
-  (loop for x in *universe*
-	always (handler-case (stringp (string x))
-			     (type-error () :caught)))
-  t)
+  (check-predicate
+   #'(lambda (x)
+       (handler-case (stringp (string x))
+		     (type-error () :caught))))
+  nil)
 
 (deftest string.8 
   :notes (:nil-vectors-are-strings)
@@ -94,10 +95,7 @@
   nil)
 
 (deftest string.16
-  (loop for s in *universe*
-	when (and (stringp s)
-		  (not (eq s (string s))))
-	collect s)
+  (check-predicate #'(lambda (s) (or (not (stringp s)) (eq s (string s)))))
   nil)
 
 (deftest string.17
diff --git a/ansi-tests/stringp.lsp b/ansi-tests/stringp.lsp
index f16fca0920e7b0cebbd605a56a2452bfe695c8bf..f892ea2100e2d1f1cd8854a869a8648ce581562b 100644
--- a/ansi-tests/stringp.lsp
+++ b/ansi-tests/stringp.lsp
@@ -6,11 +6,8 @@
 (in-package :cl-test)
 
 (deftest stringp.1
-  (loop for x in *universe*
-	always (if (typep x 'string)
-		   (stringp x)
-		 (not (stringp x))))
-  t)
+  (check-type-predicate #'stringp 'string)
+  nil)
 
 (deftest stringp.2
   (notnot (stringp "abcd"))
diff --git a/ansi-tests/sxhash.lsp b/ansi-tests/sxhash.lsp
index 15ae2d3e26617a2438bb9b6a24d24a978419a8cd..f5682f6540bf21936d6e1e5b3ca21cbac4777a95 100644
--- a/ansi-tests/sxhash.lsp
+++ b/ansi-tests/sxhash.lsp
@@ -6,10 +6,7 @@
 (in-package :cl-test)
 
 (deftest sxhash.1
-  (loop for x in *universe*
-	for hash-code = (sxhash x)
-	unless (typep hash-code '(and unsigned-byte fixnum))
-	collect x)
+  (check-predicate #'(lambda (x) (typep (sxhash x) '(and unsigned-byte fixnum))))
   nil)
 
 (deftest sxhash.2
diff --git a/ansi-tests/symbolp.lsp b/ansi-tests/symbolp.lsp
index 9cd545fa548c53ef754310b636c74d1d023e1f2b..c56329c359c5a1db4a5cbb2c2f98966aafef6ddb 100644
--- a/ansi-tests/symbolp.lsp
+++ b/ansi-tests/symbolp.lsp
@@ -10,15 +10,11 @@
   t)
 
 (deftest symbolp.2
-  (loop for x in *symbols*
-	unless (symbolp x)
-	collect x)
+  (check-predicate #'symbolp nil *symbols*)
   nil)
 
 (deftest symbolp.3
-  (loop for x in (set-difference *universe* *symbols*)
-	when (symbolp x)
-	collect x)
+  (check-predicate (complement #'symbolp) #'(lambda (x) (member x *symbols*)))
   nil)
 
 ;;; Error cases
diff --git a/ansi-tests/the.lsp b/ansi-tests/the.lsp
index aa4ee9bdc14087606956241a1bb2dd70963b697f..a62de8b596944f336e644d3043856d68a093594d 100644
--- a/ansi-tests/the.lsp
+++ b/ansi-tests/the.lsp
@@ -13,72 +13,59 @@
   a)
 
 (deftest the.3
-  (loop for e in *universe*
-	for x = (multiple-value-list (eval `(the (values) (quote ,e))))
-	unless (and x (not (cdr x)) (eql (car x) e))
-	collect e)
+  (check-predicate #'(lambda (e)
+		       (let ((x (multiple-value-list (eval `(the (values) (quote ,e))))))
+			 (and x (not (cdr x)) (eql (car x) e)))))
   nil)
 
 (deftest the.4
-  (loop for e in *universe*
-	for x = (multiple-value-list (eval `(the ,(type-of e) (quote ,e))))
-	unless (and x (not (cdr x)) (eql (car x) e))
-	collect e)
+  (check-predicate #'(lambda (e)
+		       (let ((x (multiple-value-list (eval `(the ,(type-of e) (quote ,e))))))
+			 (and x (not (cdr x)) (eql (car x) e)))))
   nil)
 
 (deftest the.5
-  (loop for e in *universe*
-	for x = (multiple-value-list (eval `(the (values ,(type-of e))
-					      (quote ,e))))
-	unless (and x (not (cdr x)) (eql (car x) e))
-	collect e)
+  (check-predicate #'(lambda (e)
+		       (let ((x (multiple-value-list (eval `(the (values ,(type-of e)) (quote ,e))))))
+			 (and x (not (cdr x)) (eql (car x) e)))))
   nil)
 
 (deftest the.6
-  (loop for e in *universe*
-	for x = (multiple-value-list (eval `(the (values ,(type-of e) t)
-					      (quote ,e))))
-	unless (and x (not (cdr x)) (eql (car x) e))
-	collect e)
+  (check-predicate #'(lambda (e)
+		       (let ((x (multiple-value-list (eval `(the (values ,(type-of e) t) (quote ,e))))))
+			 (and x (not (cdr x)) (eql (car x) e)))))
   nil)
 
 (deftest the.7
-  (loop for e in *universe*
-	for x = (multiple-value-list (eval `(the (values ,(type-of e))
-					      (values (quote ,e) :ignored))))
-	unless (and (eql (length x) 2)
-		    (eql (car x) e)
-		    (eql (cadr x) :ignored))
-	collect e)
+  (check-predicate
+   #'(lambda (e)
+       (let ((x (multiple-value-list (eval `(the (values ,(type-of e))
+					      (values (quote ,e) :ignored))))))
+	 (and (eql (length x) 2)
+	      (eql (car x) e)
+	      (eql (cadr x) :ignored)))))
   nil)
 
 (deftest the.8
-  (loop for e in *universe*
-	when (and (constantp e)
-		  (not (eql (eval `(the ,(type-of e) ,e)) e)))
-	collect e)
+  (check-predicate #'(lambda (e) (or (not (constantp e))
+				     (eql (eval `(the ,(type-of e) ,e)) e))))
   nil)
 
 (deftest the.9
-  (loop for e in *universe*
-	when (and (constantp e)
-		  (not (eql (eval `(the ,(class-of e) ,e)) e)))
-	collect e)
+  (check-predicate #'(lambda (e) (or (not (constantp e))
+				     (eql (eval `(the ,(class-of e) ,e)) e))))
   nil)
 
 (deftest the.10
-  (loop for e in *universe*
-	unless (eql (eval `(the ,(class-of e) ',e)) e)
-	collect e)
+  (check-predicate #'(lambda (e) (eql (eval `(the ,(class-of e) ',e)) e)))
   nil)
 
 (deftest the.11
-  (loop for e in *universe*
-	for type = (type-of e)
-	for x = (multiple-value-list (eval `(the ,type (the ,type
-							 (quote ,e)))))
-	unless (and x (not (cdr x)) (eql (car x) e))
-	collect e)
+  (check-predicate
+   #'(lambda (e)
+       (let* ((type (type-of e))
+	      (x (multiple-value-list (eval `(the ,type (the ,type (quote ,e)))))))
+	 (and x (not (cdr x)) (eql (car x) e)))))
   nil)
 
 (deftest the.12
diff --git a/ansi-tests/types-and-class.lsp b/ansi-tests/types-and-class.lsp
index 7fa8fc01a0d5fe1316f5150dfdfeef8a8e5e3889..f217f6a146e1d3d9ae76af10905273ece154ecbd 100644
--- a/ansi-tests/types-and-class.lsp
+++ b/ansi-tests/types-and-class.lsp
@@ -21,7 +21,7 @@
 
 (deftest boolean-type.3
   (check-type-predicate 'is-t-or-nil 'boolean)
-  0)
+  nil)
 
 (deftest types.3
   (loop
diff --git a/ansi-tests/upgraded-array-element-type.lsp b/ansi-tests/upgraded-array-element-type.lsp
index efd9a148521f312ec9d4ed068c7495d62a745fc7..2f8d42eb030117a8ae2380776217f6b35cb0d2bc 100644
--- a/ansi-tests/upgraded-array-element-type.lsp
+++ b/ansi-tests/upgraded-array-element-type.lsp
@@ -110,9 +110,7 @@
 
 (deftest upgraded-array-element-type.nil.1
   (let ((uaet-nil (upgraded-array-element-type nil)))
-    (loop for e in *universe*
-	  when (typep e uaet-nil)
-	  collect e))
+    (check-predicate (typef `(not ,uaet-nil))))
   nil)
     
 ;;; Error tests