Commit 771d3512 authored by pfdietz's avatar pfdietz

More type error tests and refactoring

parent ced4881a
...@@ -223,8 +223,8 @@ ...@@ -223,8 +223,8 @@
;;;;;;;; ;;;;;;;;
(deftest reduce.error.1 (deftest reduce.error.1
(signals-error (reduce 'cons 'a) type-error) (check-type-error #'(lambda (x) (reduce 'cons x)) #'sequencep)
t) nil)
(deftest reduce.error.2 (deftest reduce.error.2
(signals-error (reduce) program-error) (signals-error (reduce) program-error)
......
...@@ -237,6 +237,10 @@ ...@@ -237,6 +237,10 @@
(signals-error (remove-duplicates (list 'a 'b 'c) :key #'car) type-error) (signals-error (remove-duplicates (list 'a 'b 'c) :key #'car) type-error)
t) t)
(deftest remove-duplicates.error.9
(check-type-error #'remove-duplicates #'sequencep)
nil)
;;; ;;;
(deftest delete-duplicates.error.1 (deftest delete-duplicates.error.1
...@@ -275,6 +279,10 @@ ...@@ -275,6 +279,10 @@
(signals-error (delete-duplicates (list 'a 'b 'c) :key #'car) type-error) (signals-error (delete-duplicates (list 'a 'b 'c) :key #'car) type-error)
t) t)
(deftest delete-duplicates.error.10
(check-type-error #'delete-duplicates #'sequencep)
nil)
;;; Specialized string tests ;;; Specialized string tests
(deftest remove-duplicates.string.1 (deftest remove-duplicates.string.1
......
...@@ -861,6 +861,10 @@ ...@@ -861,6 +861,10 @@
(signals-error (remove 'a (list 'a 'b 'c) :key #'car) type-error) (signals-error (remove 'a (list 'a 'b 'c) :key #'car) type-error)
t) t)
(deftest remove.error.11
(check-type-error #'(lambda (x) (remove 'a x)) #'sequencep)
nil)
;;; ;;;
...@@ -904,6 +908,10 @@ ...@@ -904,6 +908,10 @@
(signals-error (delete 'a (list 'a 'b 'c) :key #'car) type-error) (signals-error (delete 'a (list 'a 'b 'c) :key #'car) type-error)
t) t)
(deftest delete.error.11
(check-type-error #'(lambda (x) (delete 'a x)) #'sequencep)
nil)
;;; More specialized string tests ;;; More specialized string tests
(deftest remove-if-string.1 (deftest remove-if-string.1
......
...@@ -69,12 +69,5 @@ ...@@ -69,12 +69,5 @@
t) t)
(deftest remprop.error.4 (deftest remprop.error.4
(loop for x in *mini-universe* (check-type-error #'(lambda (x) (remprop x nil)) #'symbolp)
unless (or (symbolp x)
(eval `(signals-error (remprop ',x nil) type-error)))
collect x)
nil) nil)
...@@ -169,24 +169,8 @@ ...@@ -169,24 +169,8 @@
;;; Error cases ;;; Error cases
(deftest reverse.error.1 (deftest reverse.error.1
(signals-error (reverse 'a) type-error) (check-type-error #'reverse #'sequencep)
t) nil)
(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)
(deftest reverse.error.6 (deftest reverse.error.6
(signals-error (reverse) program-error) (signals-error (reverse) program-error)
......
...@@ -27,9 +27,7 @@ ...@@ -27,9 +27,7 @@
;; rplaca on a non-cons is a type error ;; rplaca on a non-cons is a type error
(deftest rplaca.error.1 (deftest rplaca.error.1
(loop for x in *universe* (check-type-error #'(lambda (x) (rplaca x 1)) #'consp)
thereis (and (not (consp x))
(not (eval `(signals-error (rplaca ',x 1) type-error)))))
nil) nil)
(deftest rplaca.error.2 (deftest rplaca.error.2
...@@ -44,10 +42,6 @@ ...@@ -44,10 +42,6 @@
(signals-error (rplaca (cons 'a 'b) (cons 'c 'd) 'garbage) program-error) (signals-error (rplaca (cons 'a 'b) (cons 'c 'd) 'garbage) program-error)
t) t)
(deftest rplaca.error.5
(signals-error (rplaca 'a 1) type-error)
t)
(deftest rplaca.error.6 (deftest rplaca.error.6
(signals-error (locally (rplaca 'a 1) t) type-error) (signals-error (locally (rplaca 'a 1) t) type-error)
t) t)
...@@ -27,9 +27,7 @@ ...@@ -27,9 +27,7 @@
;; rplacd on a non-cons is a type error ;; rplacd on a non-cons is a type error
(deftest rplacd.error.1 (deftest rplacd.error.1
(loop for x in *universe* (check-type-error #'(lambda (x) (rplacd x 1)) #'consp)
thereis (and (not (consp x))
(not (eval `(signals-error (rplacd ',x 1) type-error)))))
nil) nil)
(deftest rplacd.error.2 (deftest rplacd.error.2
...@@ -44,10 +42,6 @@ ...@@ -44,10 +42,6 @@
(signals-error (rplacd (cons 'a 'b) (cons 'c 'd) 'garbage) program-error) (signals-error (rplacd (cons 'a 'b) (cons 'c 'd) 'garbage) program-error)
t) t)
(deftest rplacd.error.5
(signals-error (rplacd 'a 1) type-error)
t)
(deftest rplacd.error.6 (deftest rplacd.error.6
(signals-error (locally (rplacd 'a 1) t) type-error) (signals-error (locally (rplacd 'a 1) t) type-error)
t) t)
......
...@@ -320,3 +320,12 @@ ...@@ -320,3 +320,12 @@
(deftest set-difference.error.12 (deftest set-difference.error.12
(signals-error (set-difference (list* 1 2 3) (list 4 5 6)) type-error) (signals-error (set-difference (list* 1 2 3) (list 4 5 6)) type-error)
t) 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)
...@@ -361,6 +361,14 @@ ...@@ -361,6 +361,14 @@
(signals-error (set-exclusive-or (list* 1 2 3) (list 4 5 6)) type-error) (signals-error (set-exclusive-or (list* 1 2 3) (list 4 5 6)) type-error)
t) 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 ;;; Randomized test
......
...@@ -167,8 +167,5 @@ ...@@ -167,8 +167,5 @@
t) t)
(deftest sin.error.3 (deftest sin.error.3
(loop for x in *mini-universe* (check-type-error #'sin #'numberp)
unless (or (numberp x)
(eval `(signals-error (sin ',x) type-error)))
collect x)
nil) nil)
...@@ -80,10 +80,7 @@ ...@@ -80,10 +80,7 @@
t) t)
(deftest sinh.error.3 (deftest sinh.error.3
(loop for x in *mini-universe* (check-type-error #'sinh #'numberp)
unless (or (numberp x)
(eval `(signals-error (sinh ',x) type-error)))
collect x)
nil) nil)
......
...@@ -273,32 +273,17 @@ ...@@ -273,32 +273,17 @@
(deftest some.error.1 (deftest some.error.1
(signals-error (some 1 '(a b c)) type-error) (check-type-error #'(lambda (x) (some x '(a b c)))
t) (typef '(or symbol function)))
nil)
(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)
(deftest some.error.4 (deftest some.error.4
(signals-error (some #'null 'a) type-error) (check-type-error #'(lambda (x) (some #'null x)) #'sequencep)
t) nil)
(deftest some.error.5
(signals-error (some #'null 100) type-error)
t)
(deftest some.error.6
(signals-error (some #'null 'a) type-error)
t)
(deftest some.error.7 (deftest some.error.7
(signals-error (some #'eq () 'a) type-error) (check-type-error #'(lambda (x) (some #'eql () x)) #'sequencep)
t) nil)
(deftest some.error.8 (deftest some.error.8
(signals-error (some) program-error) (signals-error (some) program-error)
......
...@@ -235,3 +235,7 @@ ...@@ -235,3 +235,7 @@
(deftest sort.error.10 (deftest sort.error.10
(signals-error (sort (list 1 2 3 4) #'elt) type-error) (signals-error (sort (list 1 2 3 4) #'elt) type-error)
t) t)
(deftest sort.error.11
(check-type-error #'(lambda (x) (sort x #'<)) #'sequencep)
nil)
...@@ -41,8 +41,8 @@ ...@@ -41,8 +41,8 @@
t 1) t 1)
(deftest special-operator-p.error.1 (deftest special-operator-p.error.1
(signals-error (special-operator-p 1) type-error) (check-type-error #'special-operator-p #'symbolp)
t) nil)
(deftest special-operator-p.error.2 (deftest special-operator-p.error.2
(signals-error (special-operator-p) program-error) (signals-error (special-operator-p) program-error)
...@@ -51,4 +51,3 @@ ...@@ -51,4 +51,3 @@
(deftest special-operator-p.error.3 (deftest special-operator-p.error.3
(signals-error (special-operator-p 'cons 'cons) program-error) (signals-error (special-operator-p 'cons 'cons) program-error)
t) t)
...@@ -16,10 +16,7 @@ ...@@ -16,10 +16,7 @@
t) t)
(deftest sqrt.error.3 (deftest sqrt.error.3
(loop for x in *mini-universe* (check-type-error #'sqrt #'numberp)
unless (or (numberp x)
(eval `(signals-error (sqrt ',x) type-error)))
collect x)
nil) nil)
(deftest sqrt.1 (deftest sqrt.1
......
...@@ -216,3 +216,7 @@ ...@@ -216,3 +216,7 @@
(deftest stable-sort.error.10 (deftest stable-sort.error.10
(signals-error (stable-sort (list 1 2 3 4) #'elt) type-error) (signals-error (stable-sort (list 1 2 3 4) #'elt) type-error)
t) t)
(deftest stable-sort.error.11
(check-type-error #'(lambda (x) (stable-sort x #'<)) #'sequencep)
nil)
...@@ -83,9 +83,5 @@ ...@@ -83,9 +83,5 @@
t) t)
(deftest stream-element-type.error.3 (deftest stream-element-type.error.3
(loop for x in *mini-universe* (check-type-error #'stream-element-type #'streamp)
unless (or (typep x 'stream)
(eval `(signals-error (stream-element-type ',x)
type-error)))
collect x)
nil) nil)
...@@ -259,3 +259,12 @@ ...@@ -259,3 +259,12 @@
(deftest subsetp.error.12 (deftest subsetp.error.12
(signals-error (subsetp (list* 1 2 3) (list 1 2 3 4 5 6)) type-error) (signals-error (subsetp (list* 1 2 3) (list 1 2 3 4 5 6)) type-error)
t) 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)
...@@ -867,3 +867,6 @@ ...@@ -867,3 +867,6 @@
program-error) program-error)
t) t)
(deftest substitute-if-not.error.12
(check-type-error #'(lambda (x) (substitute-if-not 'a #'not x)) #'sequencep)
nil)
...@@ -890,3 +890,7 @@ ...@@ -890,3 +890,7 @@
:key #'cons) :key #'cons)
program-error) program-error)
t) t)
(deftest substitute-if.error.12
(check-type-error #'(lambda (x) (substitute-if 'a #'not x)) #'sequencep)
nil)
...@@ -1138,3 +1138,6 @@ ...@@ -1138,3 +1138,6 @@
(signals-error (substitute 'a 'b (list 'a 'b 'c) :key #'car) type-error) (signals-error (substitute 'a 'b (list 'a 'b 'c) :key #'car) type-error)
t) t)
(deftest substitute.error.12
(check-type-error #'(lambda (x) (substitute 'a 'b x)) #'sequencep)
nil)
...@@ -24,18 +24,12 @@ ...@@ -24,18 +24,12 @@
t) t)
(deftest symbol-function.error.3 (deftest symbol-function.error.3
(loop for x in *mini-universe* (check-type-error #'symbol-function #'symbolp)
for form = `(signals-error (symbol-function ',x) type-error)
unless (or (symbolp x) (eval form))
collect x)
nil) nil)
(deftest symbol-function.error.4 (deftest symbol-function.error.4
(loop for x in *mini-universe* (check-type-error #'(lambda (x) (setf (symbol-function x) #'identity))
for form = `(signals-error (setf (symbol-function ',x) #'identity) #'symbolp)
type-error)
unless (or (symbolp x) (eval form))
collect x)
nil) nil)
(deftest symbol-function.error.5 (deftest symbol-function.error.5
......
...@@ -14,22 +14,6 @@ ...@@ -14,22 +14,6 @@
"1234abcdABCD") "1234abcdABCD")
(deftest symbol-name.3 (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|) (symbol-name :|abcdefg|)
"abcdefg") "abcdefg")
...@@ -44,10 +28,7 @@ ...@@ -44,10 +28,7 @@
t) t)
(deftest symbol-name.error.3 (deftest symbol-name.error.3
(loop for x in *mini-universe* (check-type-error #'symbol-name #'symbolp)
for form = `(signals-error (symbol-name ',x) type-error)
unless (or (symbolp x) (eval form))
collect x)
nil) nil)
...@@ -154,9 +154,5 @@ ...@@ -154,9 +154,5 @@
t) t)
(deftest tan.error.3 (deftest tan.error.3
(loop for x in *mini-universe* (check-type-error #'tan #'numberp)
unless (or (numberp x)
(eval `(signals-error (tan ',x) type-error)))
collect x)
nil) nil)
...@@ -80,8 +80,5 @@ ...@@ -80,8 +80,5 @@
t) t)
(deftest tanh.error.3 (deftest tanh.error.3
(loop for x in *mini-universe* (check-type-error #'tanh #'numberp)
unless (or (numberp x)
(eval `(signals-error (tanh ',x) type-error)))
collect x)
nil) nil)
...@@ -412,3 +412,12 @@ ...@@ -412,3 +412,12 @@
(deftest union.error.12 (deftest union.error.12
(signals-error (union (list* 1 2 3) (list 4 5 6)) type-error) (signals-error (union (list* 1 2 3) (list 4 5 6)) type-error)
t) 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)
...@@ -14,8 +14,8 @@ ...@@ -14,8 +14,8 @@
t) t)
(deftest values-list.error.3 (deftest values-list.error.3
(signals-error (values-list 'a) type-error) (check-type-error #'values-list #'list)
t) nil)
(deftest values-list.error.4 (deftest values-list.error.4
(signals-error (values-list '(a b c . d)) type-error) (signals-error (values-list '(a b c . d)) type-error)
......
...@@ -221,18 +221,14 @@ ...@@ -221,18 +221,14 @@
t) t)
(deftest wild-pathname-p.error.3 (deftest wild-pathname-p.error.3
(loop for x in *mini-universe* (check-type-error #'wild-pathname-p
unless (or (could-be-pathname-designator x) (typef '(or pathname string file-stream
(eval `(signals-error (wild-pathname-p ',x) synonym-stream)))
type-error)))
collect x)
nil) nil)
(deftest wild-pathname-p.error.4 (deftest wild-pathname-p.error.4
(loop for x in *mini-universe* (check-type-error #'(lambda (x) (declare (optimize (safety 0)))
unless (or (could-be-pathname-designator x) (wild-pathname-p x))
(eval `(signals-error (wild-pathname-p ',x) (typef '(or pathname string file-stream
type-error synonym-stream)))
:safety 0)))
collect x)
nil) nil)
...@@ -43,6 +43,7 @@ ...@@ -43,6 +43,7 @@
x)) x))
2 1) 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.
...@@ -205,3 +205,21 @@ ...@@ -205,3 +205,21 @@
(signals-error (write-sequence "abcde" *standard-output* :start) (signals-error (write-sequence "abcde" *standard-output* :start)
program-error) program-error)
t) 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)
...@@ -18,10 +18,7 @@ ...@@ -18,10 +18,7 @@
t) t)
(deftest zerop.error.4 (deftest zerop.error.4
(loop for x in *mini-universe* (check-type-error #'zerop #'numberp)
unless (or (numberp x)
(eval `(signals-error (zerop ',x) type-error)))
collect x)
nil) nil)
(deftest zerop.1 (deftest zerop.1
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment