Commit 771d3512 authored by pfdietz's avatar pfdietz

More type error tests and refactoring

parent ced4881a
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......@@ -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)
......
......@@ -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)
......@@ -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)
......
......@@ -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)
......@@ -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
......
......@@ -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)
......@@ -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)
......
......@@ -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)
......
......@@ -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)
......@@ -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)
......@@ -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
......
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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
......
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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)
......
......@@ -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)
......@@ -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.
......@@ -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)
......@@ -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
......
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