From 771d35129a68ea4907ddfbb48ada11e0a4ebf91e Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Sat, 7 May 2005 01:55:34 +0000
Subject: [PATCH] More type error tests and refactoring

---
 ansi-tests/reduce.lsp                |  4 ++--
 ansi-tests/remove-duplicates.lsp     |  8 ++++++++
 ansi-tests/remove.lsp                |  8 ++++++++
 ansi-tests/remprop.lsp               |  9 +--------
 ansi-tests/reverse.lsp               | 20 ++-----------------
 ansi-tests/rplaca.lsp                |  8 +-------
 ansi-tests/rplacd.lsp                |  8 +-------
 ansi-tests/set-difference.lsp        |  9 +++++++++
 ansi-tests/set-exclusive-or.lsp      |  8 ++++++++
 ansi-tests/sin.lsp                   |  5 +----
 ansi-tests/sinh.lsp                  |  5 +----
 ansi-tests/some.lsp                  | 29 +++++++---------------------
 ansi-tests/sort.lsp                  |  4 ++++
 ansi-tests/special-operator-p.lsp    |  5 ++---
 ansi-tests/sqrt.lsp                  |  5 +----
 ansi-tests/stable-sort.lsp           |  4 ++++
 ansi-tests/stream-element-type.lsp   |  6 +-----
 ansi-tests/subsetp.lsp               |  9 +++++++++
 ansi-tests/substitute-if-not.lsp     |  3 +++
 ansi-tests/substitute-if.lsp         |  4 ++++
 ansi-tests/substitute.lsp            |  3 +++
 ansi-tests/symbol-function.lsp       | 12 +++---------
 ansi-tests/symbol-name.lsp           | 21 +-------------------
 ansi-tests/tan.lsp                   |  6 +-----
 ansi-tests/tanh.lsp                  |  5 +----
 ansi-tests/union.lsp                 |  9 +++++++++
 ansi-tests/values-list.lsp           |  4 ++--
 ansi-tests/wild-pathname-p.lsp       | 18 +++++++----------
 ansi-tests/with-compilation-unit.lsp |  7 ++++---
 ansi-tests/write-sequence.lsp        | 18 +++++++++++++++++
 ansi-tests/zerop.lsp                 |  5 +----
 31 files changed, 127 insertions(+), 142 deletions(-)

diff --git a/ansi-tests/reduce.lsp b/ansi-tests/reduce.lsp
index 0968fe43..8f15549b 100644
--- a/ansi-tests/reduce.lsp
+++ b/ansi-tests/reduce.lsp
@@ -223,8 +223,8 @@
 ;;;;;;;;
 
 (deftest reduce.error.1
-  (signals-error (reduce 'cons 'a) type-error)
-  t)
+  (check-type-error #'(lambda (x) (reduce 'cons x)) #'sequencep)
+  nil)
 
 (deftest reduce.error.2
   (signals-error (reduce) program-error)
diff --git a/ansi-tests/remove-duplicates.lsp b/ansi-tests/remove-duplicates.lsp
index 50a7aaf2..58dc556e 100644
--- a/ansi-tests/remove-duplicates.lsp
+++ b/ansi-tests/remove-duplicates.lsp
@@ -237,6 +237,10 @@
   (signals-error (remove-duplicates (list 'a 'b 'c) :key #'car) type-error)
   t)
 
+(deftest remove-duplicates.error.9
+  (check-type-error #'remove-duplicates #'sequencep)
+  nil)
+
 ;;;
 
 (deftest delete-duplicates.error.1
@@ -275,6 +279,10 @@
   (signals-error (delete-duplicates (list 'a 'b 'c) :key #'car) type-error)
   t)
 
+(deftest delete-duplicates.error.10
+  (check-type-error #'delete-duplicates #'sequencep)
+  nil)
+
 ;;; Specialized string tests
 
 (deftest remove-duplicates.string.1
diff --git a/ansi-tests/remove.lsp b/ansi-tests/remove.lsp
index ec11fbeb..db015a49 100644
--- a/ansi-tests/remove.lsp
+++ b/ansi-tests/remove.lsp
@@ -861,6 +861,10 @@
   (signals-error (remove 'a (list 'a 'b 'c) :key #'car) type-error)
   t)
 
+(deftest remove.error.11
+  (check-type-error #'(lambda (x) (remove 'a x)) #'sequencep)
+  nil)
+
 
 ;;;
 
@@ -904,6 +908,10 @@
   (signals-error (delete 'a (list 'a 'b 'c) :key #'car) type-error)
   t)
 
+(deftest delete.error.11
+  (check-type-error #'(lambda (x) (delete 'a x)) #'sequencep)
+  nil)
+
 ;;; More specialized string tests
 
 (deftest remove-if-string.1
diff --git a/ansi-tests/remprop.lsp b/ansi-tests/remprop.lsp
index 8950b825..8a535bec 100644
--- a/ansi-tests/remprop.lsp
+++ b/ansi-tests/remprop.lsp
@@ -69,12 +69,5 @@
   t)
 
 (deftest remprop.error.4
-  (loop for x in *mini-universe*
-	unless (or (symbolp x)
-		   (eval `(signals-error (remprop ',x nil) type-error)))
-	collect x)
+  (check-type-error #'(lambda (x) (remprop x nil)) #'symbolp)
   nil)
-
-
-
-	
diff --git a/ansi-tests/reverse.lsp b/ansi-tests/reverse.lsp
index fa84ea8e..2038683a 100644
--- a/ansi-tests/reverse.lsp
+++ b/ansi-tests/reverse.lsp
@@ -169,24 +169,8 @@
 ;;; Error cases
 
 (deftest reverse.error.1
-  (signals-error (reverse 'a) type-error)
-  t)
-
-(deftest reverse.error.2
-  (signals-error (reverse #\a) type-error)
-  t)
-
-(deftest reverse.error.3
-  (signals-error (reverse 10) type-error)
-  t)
-
-(deftest reverse.error.4
-  (signals-error (reverse 0.3) type-error)
-  t)
-
-(deftest reverse.error.5
-  (signals-error (reverse 10/3) type-error)
-  t)
+  (check-type-error #'reverse #'sequencep)
+  nil)
 
 (deftest reverse.error.6
   (signals-error (reverse) program-error)
diff --git a/ansi-tests/rplaca.lsp b/ansi-tests/rplaca.lsp
index ec5ea782..cb7c43d4 100644
--- a/ansi-tests/rplaca.lsp
+++ b/ansi-tests/rplaca.lsp
@@ -27,9 +27,7 @@
 
 ;; rplaca on a non-cons is a type error
 (deftest rplaca.error.1
-  (loop for x in *universe*
-	thereis (and (not (consp x))
-		     (not (eval `(signals-error (rplaca ',x 1) type-error)))))
+  (check-type-error #'(lambda (x) (rplaca x 1)) #'consp)
   nil)
 
 (deftest rplaca.error.2
@@ -44,10 +42,6 @@
   (signals-error (rplaca (cons 'a 'b) (cons 'c 'd) 'garbage) program-error)
   t)
 
-(deftest rplaca.error.5
-  (signals-error (rplaca 'a 1) type-error)
-  t)
-
 (deftest rplaca.error.6
   (signals-error (locally (rplaca 'a 1) t) type-error)
   t)
diff --git a/ansi-tests/rplacd.lsp b/ansi-tests/rplacd.lsp
index f8e55119..bf53c10b 100644
--- a/ansi-tests/rplacd.lsp
+++ b/ansi-tests/rplacd.lsp
@@ -27,9 +27,7 @@
 
 ;; rplacd on a non-cons is a type error
 (deftest rplacd.error.1
-  (loop for x in *universe*
-	thereis (and (not (consp x))
-		     (not (eval `(signals-error (rplacd ',x 1) type-error)))))
+  (check-type-error #'(lambda (x) (rplacd x 1)) #'consp)
   nil)
 
 (deftest rplacd.error.2
@@ -44,10 +42,6 @@
   (signals-error (rplacd (cons 'a 'b) (cons 'c 'd) 'garbage) program-error)
   t)
 
-(deftest rplacd.error.5
-  (signals-error (rplacd 'a 1) type-error)
-  t)
-
 (deftest rplacd.error.6
   (signals-error (locally (rplacd 'a 1) t) type-error)
   t)
diff --git a/ansi-tests/set-difference.lsp b/ansi-tests/set-difference.lsp
index 7a84b4cb..c10c7ffa 100644
--- a/ansi-tests/set-difference.lsp
+++ b/ansi-tests/set-difference.lsp
@@ -320,3 +320,12 @@
 (deftest set-difference.error.12
   (signals-error (set-difference (list* 1 2 3) (list 4 5 6)) type-error)
   t)
+
+(deftest set-difference.error.13
+  (check-type-error #'(lambda (x) (set-difference x '(a b c))) #'listp)
+  nil)
+
+(deftest set-difference.error.14
+  (check-type-error #'(lambda (x) (set-difference '(a b c) x)) #'listp)
+  nil)
+
diff --git a/ansi-tests/set-exclusive-or.lsp b/ansi-tests/set-exclusive-or.lsp
index b937263a..f2a3e2f3 100644
--- a/ansi-tests/set-exclusive-or.lsp
+++ b/ansi-tests/set-exclusive-or.lsp
@@ -361,6 +361,14 @@
   (signals-error (set-exclusive-or (list* 1 2 3) (list 4 5 6)) type-error)
   t)
 
+(deftest set-exclusive-or.error.13
+  (check-type-error #'(lambda (x) (set-exclusive-or x '(a b c))) #'listp)
+  nil)
+
+(deftest set-exclusive-or.error.14
+  (check-type-error #'(lambda (x) (set-exclusive-or '(a b c) x)) #'listp)
+  nil)
+
 
 ;;; Randomized test
 
diff --git a/ansi-tests/sin.lsp b/ansi-tests/sin.lsp
index 723dc36d..0b4f2468 100644
--- a/ansi-tests/sin.lsp
+++ b/ansi-tests/sin.lsp
@@ -167,8 +167,5 @@
   t)
 
 (deftest sin.error.3
-  (loop for x in *mini-universe*
-	unless (or (numberp x)
-		   (eval `(signals-error (sin ',x) type-error)))
-	collect x)
+  (check-type-error #'sin #'numberp)
   nil)
diff --git a/ansi-tests/sinh.lsp b/ansi-tests/sinh.lsp
index 5efa0f85..0df39b0c 100644
--- a/ansi-tests/sinh.lsp
+++ b/ansi-tests/sinh.lsp
@@ -80,10 +80,7 @@
   t)
 
 (deftest sinh.error.3
-  (loop for x in *mini-universe*
-	unless (or (numberp x)
-		   (eval `(signals-error (sinh ',x) type-error)))
-	collect x)
+  (check-type-error #'sinh #'numberp)
   nil)
 
 
diff --git a/ansi-tests/some.lsp b/ansi-tests/some.lsp
index 6158b35b..0e21c8d4 100644
--- a/ansi-tests/some.lsp
+++ b/ansi-tests/some.lsp
@@ -273,32 +273,17 @@
 
 
 (deftest some.error.1
-  (signals-error (some 1 '(a b c)) type-error)
-  t)
-
-(deftest some.error.2
-  (signals-error (some #\a '(a b c)) type-error)
-  t)
-
-(deftest some.error.3
-  (signals-error (some #() '(a b c)) type-error)
-  t)
+  (check-type-error #'(lambda (x) (some x '(a b c)))
+		    (typef '(or symbol function)))
+  nil)
 
 (deftest some.error.4
-  (signals-error (some #'null 'a) type-error)
-  t)
-
-(deftest some.error.5
-  (signals-error (some #'null 100) type-error)
-  t)
-
-(deftest some.error.6
-  (signals-error (some #'null 'a) type-error)
-  t)
+  (check-type-error #'(lambda (x) (some #'null x)) #'sequencep)
+  nil)
 
 (deftest some.error.7
-  (signals-error (some #'eq () 'a) type-error)
-  t)
+  (check-type-error #'(lambda (x) (some #'eql () x)) #'sequencep)
+  nil)
 
 (deftest some.error.8
   (signals-error (some) program-error)
diff --git a/ansi-tests/sort.lsp b/ansi-tests/sort.lsp
index 4cf39828..9ef42fd9 100644
--- a/ansi-tests/sort.lsp
+++ b/ansi-tests/sort.lsp
@@ -235,3 +235,7 @@
 (deftest sort.error.10
   (signals-error (sort (list 1 2 3 4) #'elt) type-error)
   t)
+
+(deftest sort.error.11
+  (check-type-error #'(lambda (x) (sort x #'<)) #'sequencep)
+  nil)
diff --git a/ansi-tests/special-operator-p.lsp b/ansi-tests/special-operator-p.lsp
index f1ba5e5e..1695d809 100644
--- a/ansi-tests/special-operator-p.lsp
+++ b/ansi-tests/special-operator-p.lsp
@@ -41,8 +41,8 @@
   t 1)
 
 (deftest special-operator-p.error.1
-  (signals-error (special-operator-p 1) type-error)
-  t)
+  (check-type-error #'special-operator-p #'symbolp)
+  nil)
 
 (deftest special-operator-p.error.2
   (signals-error (special-operator-p) program-error)
@@ -51,4 +51,3 @@
 (deftest special-operator-p.error.3
   (signals-error (special-operator-p 'cons 'cons) program-error)
   t)
-
diff --git a/ansi-tests/sqrt.lsp b/ansi-tests/sqrt.lsp
index cfba0364..58a1259c 100644
--- a/ansi-tests/sqrt.lsp
+++ b/ansi-tests/sqrt.lsp
@@ -16,10 +16,7 @@
   t)
 
 (deftest sqrt.error.3
-  (loop for x in *mini-universe*
-	unless (or (numberp x)
-		   (eval `(signals-error (sqrt ',x) type-error)))
-	collect x)
+  (check-type-error #'sqrt #'numberp)
   nil)
 
 (deftest sqrt.1
diff --git a/ansi-tests/stable-sort.lsp b/ansi-tests/stable-sort.lsp
index ea0443d1..3ea8f726 100644
--- a/ansi-tests/stable-sort.lsp
+++ b/ansi-tests/stable-sort.lsp
@@ -216,3 +216,7 @@
 (deftest stable-sort.error.10
   (signals-error (stable-sort (list 1 2 3 4) #'elt) type-error)
   t)
+
+(deftest stable-sort.error.11
+  (check-type-error #'(lambda (x) (stable-sort x #'<)) #'sequencep)
+  nil)
diff --git a/ansi-tests/stream-element-type.lsp b/ansi-tests/stream-element-type.lsp
index 6142b229..e595ecea 100644
--- a/ansi-tests/stream-element-type.lsp
+++ b/ansi-tests/stream-element-type.lsp
@@ -83,9 +83,5 @@
   t)
 
 (deftest stream-element-type.error.3
-  (loop for x in *mini-universe*
-	unless (or (typep x 'stream)
-		   (eval `(signals-error (stream-element-type ',x)
-					 type-error)))
-	collect x)
+  (check-type-error #'stream-element-type #'streamp)
   nil)
diff --git a/ansi-tests/subsetp.lsp b/ansi-tests/subsetp.lsp
index 9116091e..a296047f 100644
--- a/ansi-tests/subsetp.lsp
+++ b/ansi-tests/subsetp.lsp
@@ -259,3 +259,12 @@
 (deftest subsetp.error.12
   (signals-error (subsetp (list* 1 2 3) (list 1 2 3 4 5 6)) type-error)
   t)
+
+(deftest subsetp.error.13
+  (check-type-error #'(lambda (x) (subsetp x nil)) #'listp)
+  nil)
+
+(deftest subsetp.error.14
+  (check-type-error #'(lambda (x) (subsetp nil x)) #'listp)
+  nil)
+
diff --git a/ansi-tests/substitute-if-not.lsp b/ansi-tests/substitute-if-not.lsp
index c8c3e541..186c9548 100644
--- a/ansi-tests/substitute-if-not.lsp
+++ b/ansi-tests/substitute-if-not.lsp
@@ -867,3 +867,6 @@
 		 program-error)
   t)
 
+(deftest substitute-if-not.error.12
+  (check-type-error #'(lambda (x) (substitute-if-not 'a #'not x)) #'sequencep)
+  nil)
diff --git a/ansi-tests/substitute-if.lsp b/ansi-tests/substitute-if.lsp
index b0868389..8a031356 100644
--- a/ansi-tests/substitute-if.lsp
+++ b/ansi-tests/substitute-if.lsp
@@ -890,3 +890,7 @@
 				  :key #'cons)
 		 program-error)
   t)
+
+(deftest substitute-if.error.12
+  (check-type-error #'(lambda (x) (substitute-if 'a #'not x)) #'sequencep)
+  nil)
diff --git a/ansi-tests/substitute.lsp b/ansi-tests/substitute.lsp
index 7526f6de..f8c24e95 100644
--- a/ansi-tests/substitute.lsp
+++ b/ansi-tests/substitute.lsp
@@ -1138,3 +1138,6 @@
   (signals-error (substitute 'a 'b (list 'a 'b 'c) :key #'car) type-error)
   t)
 
+(deftest substitute.error.12
+  (check-type-error #'(lambda (x) (substitute 'a 'b x)) #'sequencep)
+  nil)
diff --git a/ansi-tests/symbol-function.lsp b/ansi-tests/symbol-function.lsp
index 70115081..9aa6b64c 100644
--- a/ansi-tests/symbol-function.lsp
+++ b/ansi-tests/symbol-function.lsp
@@ -24,18 +24,12 @@
   t)
 
 (deftest symbol-function.error.3
-  (loop for x in *mini-universe*
-	for form = `(signals-error (symbol-function ',x) type-error)
-	unless (or (symbolp x) (eval form))
-	collect x)
+  (check-type-error #'symbol-function #'symbolp)
   nil)
 
 (deftest symbol-function.error.4
-  (loop for x in *mini-universe*
-	for form = `(signals-error (setf (symbol-function ',x) #'identity)
-				   type-error)
-	unless (or (symbolp x) (eval form))
-	collect x)
+  (check-type-error #'(lambda (x) (setf (symbol-function x) #'identity))
+		    #'symbolp)
   nil)
 
 (deftest symbol-function.error.5
diff --git a/ansi-tests/symbol-name.lsp b/ansi-tests/symbol-name.lsp
index 3c07259f..65d7bb3c 100644
--- a/ansi-tests/symbol-name.lsp
+++ b/ansi-tests/symbol-name.lsp
@@ -14,22 +14,6 @@
   "1234abcdABCD")
 
 (deftest symbol-name.3
-  (signals-error (symbol-name 1) type-error)
-  t)
-
-(deftest symbol-name.4
-  (signals-error (symbol-name '(a)) type-error)
-  t)
-
-(deftest symbol-name.5
-  (signals-error (symbol-name "ABCDE") type-error)
-  t)
-
-(deftest symbol-name.6
-  (signals-error (symbol-name 12913.0213) type-error)
-  t)
-
-(deftest symbol-name.7
   (symbol-name :|abcdefg|)
   "abcdefg")
 
@@ -44,10 +28,7 @@
   t)
 
 (deftest symbol-name.error.3
-  (loop for x in *mini-universe*
-	for form = `(signals-error (symbol-name ',x) type-error)
-	unless (or (symbolp x) (eval form))
-	collect x)
+  (check-type-error #'symbol-name #'symbolp)
   nil)
 
 
diff --git a/ansi-tests/tan.lsp b/ansi-tests/tan.lsp
index fa2764ae..778ed1fe 100644
--- a/ansi-tests/tan.lsp
+++ b/ansi-tests/tan.lsp
@@ -154,9 +154,5 @@
   t)
 
 (deftest tan.error.3
-  (loop for x in *mini-universe*
-	unless (or (numberp x)
-		   (eval `(signals-error (tan ',x) type-error)))
-	collect x)
+  (check-type-error #'tan #'numberp)
   nil)
-
diff --git a/ansi-tests/tanh.lsp b/ansi-tests/tanh.lsp
index 5b147927..b36feb20 100644
--- a/ansi-tests/tanh.lsp
+++ b/ansi-tests/tanh.lsp
@@ -80,8 +80,5 @@
   t)
 
 (deftest tanh.error.3
-  (loop for x in *mini-universe*
-	unless (or (numberp x)
-		   (eval `(signals-error (tanh ',x) type-error)))
-	collect x)
+  (check-type-error #'tanh #'numberp)
   nil)
diff --git a/ansi-tests/union.lsp b/ansi-tests/union.lsp
index 74460494..b4309cd3 100644
--- a/ansi-tests/union.lsp
+++ b/ansi-tests/union.lsp
@@ -412,3 +412,12 @@
 (deftest union.error.12
   (signals-error (union (list* 1 2 3) (list 4 5 6)) type-error)
   t)
+
+(deftest union.error.13
+  (check-type-error #'(lambda (x) (union x nil)) #'listp)
+  nil)
+
+(deftest union.error.14
+  (check-type-error #'(lambda (x) (union nil x)) #'listp)
+  nil)
+
diff --git a/ansi-tests/values-list.lsp b/ansi-tests/values-list.lsp
index faae61e6..e3c92169 100644
--- a/ansi-tests/values-list.lsp
+++ b/ansi-tests/values-list.lsp
@@ -14,8 +14,8 @@
   t)
 
 (deftest values-list.error.3
-  (signals-error (values-list 'a) type-error)
-  t)
+  (check-type-error #'values-list #'list)
+  nil)
 
 (deftest values-list.error.4
   (signals-error (values-list '(a b c . d)) type-error)
diff --git a/ansi-tests/wild-pathname-p.lsp b/ansi-tests/wild-pathname-p.lsp
index d8a66b66..d161c434 100644
--- a/ansi-tests/wild-pathname-p.lsp
+++ b/ansi-tests/wild-pathname-p.lsp
@@ -221,18 +221,14 @@
   t)
 
 (deftest wild-pathname-p.error.3
-  (loop for x in *mini-universe*
-	unless (or (could-be-pathname-designator x)
-		   (eval `(signals-error (wild-pathname-p ',x)
-					 type-error)))
-	collect x)
+  (check-type-error #'wild-pathname-p
+		    (typef '(or pathname string file-stream
+				synonym-stream)))
   nil)
 
 (deftest wild-pathname-p.error.4
-  (loop for x in *mini-universe*
-	unless (or (could-be-pathname-designator x)
-		   (eval `(signals-error (wild-pathname-p ',x)
-					 type-error
-					 :safety 0)))
-	collect x)
+  (check-type-error #'(lambda (x) (declare (optimize (safety 0)))
+			(wild-pathname-p x))
+		    (typef '(or pathname string file-stream
+				synonym-stream)))
   nil)
diff --git a/ansi-tests/with-compilation-unit.lsp b/ansi-tests/with-compilation-unit.lsp
index 7f4661ba..b748b1c5 100644
--- a/ansi-tests/with-compilation-unit.lsp
+++ b/ansi-tests/with-compilation-unit.lsp
@@ -43,6 +43,7 @@
      x))
   2 1)
 
-
-
- 
+;;; Add a test that (1) checks if the compiler normally delays
+;;; warnings until the end of a file and, if so, (2) checks that
+;;; with-compilation-unit delays the warnings for more than one
+;;; file compilation until the end of the unit.
diff --git a/ansi-tests/write-sequence.lsp b/ansi-tests/write-sequence.lsp
index bbc39fcb..c16ef8e5 100644
--- a/ansi-tests/write-sequence.lsp
+++ b/ansi-tests/write-sequence.lsp
@@ -205,3 +205,21 @@
   (signals-error (write-sequence "abcde" *standard-output* :start)
 		 program-error)
   t)
+
+(deftest write-sequence.error.14
+  (check-type-error #'(lambda (x) (write-sequence x *standard-output*))
+		    #'sequencep)
+  nil)
+
+(deftest write-sequence.error.15
+  (check-type-error #'(lambda (x) (write-sequence "abcde" *standard-output*
+						  :start x))
+		    (typef 'unsigned-byte))
+  nil)
+
+(deftest write-sequence.error.16
+  (check-type-error #'(lambda (x) (write-sequence "abcde" *standard-output*
+						  :end x))
+		    (typef '(or null unsigned-byte)))
+  nil)
+
diff --git a/ansi-tests/zerop.lsp b/ansi-tests/zerop.lsp
index c21d08d5..bc12c1d6 100644
--- a/ansi-tests/zerop.lsp
+++ b/ansi-tests/zerop.lsp
@@ -18,10 +18,7 @@
   t)
 
 (deftest zerop.error.4
-  (loop for x in *mini-universe*
-	unless (or (numberp x)
-		   (eval `(signals-error (zerop ',x) type-error)))
-	collect x)
+  (check-type-error #'zerop #'numberp)
   nil)
 
 (deftest zerop.1
-- 
GitLab