diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index 232a2d7a76907f1dad4a65a791fb58a432221a69..24c5cc3e5a065d882e9f3482a307e3c918c6c99e 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 5706c11e16967b201358762248ccda3d8e5ecdb0..13ceaf37d3799b585746a12844d9afe526243987 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 421523a458130f557fd8064cdc542a496c864156..5fe31cfe753bdbed9238485ed413d99807bb9768 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 b8d90555fba19916140ccdf969cb0a5118a18a48..eec05ecf6e465a3aea5ed425f34c832e1e46bbb4 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 891118dce15d40f8a9534673075e500e73dc696a..c309a9ae33f2b395f471234e8d758dc86561294d 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 071903b9df6129ea40c8793bac19376eaa49d3b1..dbbfc73fce4ac289da1c801259d8eee8ce073cc9 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 032755e5ed55d6568a671fcc593cd213978b99cd..3bd145ebe2a77164041b8261aa75e0eb02da4cce 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 afbd1cbbce5b1ae9286c7239cff89ff67de9077d..aebbd3939992e63e8fab7196e42fc06b9fd2f8a5 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 7e9bec8f66c59498c6331378ac3a9d1f2eddd477..2e75e5e2fc367284c21e312e224a429d2479584c 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 94740f939e40d43bcab86153db2c896d2344a6b9..cb5fbbdb652f127af4ccc099f8ea3fabdfa351c7 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 58b8853ba1bb5be4352e30cef13771d6d348020c..24f003b889046613df073d8847adfd599fb0de9e 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 de05eb25e3b4e95834339355515c89f8f962eb79..9015b344791c4b103bbab9cb23eb3c770536dcbf 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 6f57832776b88f890462387fdb8dfd09789cb5bf..b781b7c058e611ec97be98ec417a57bfa2bb00a3 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 52c5a0caea35f45c2d70d21809d0ef6a2578625a..d94e8f36e1a071956e690984b5c822c867bad847 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 96392f0e7c6674c4306c93dd5dc785f0e7d13211..654a9d280d460c5cba1295b7140e1cf32dce40ae 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 5d65d46acfa96a1dde7c4e15ca0d523129ad1376..933f9809765427aaafb8e1acb29a5d78ec8eb2d3 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 eca5ff6a0b9e82fde7b3e7add3a800e4634f7b58..25615a96f0c9374ac937fab6fe528e47da9cb0c5 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 466fbae8a54fffd3f17be21fd5936ff69456d41f..671f1b61e132fe979c180a64c68673ca0232e34b 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 634f04b5c4a791bde825ba3219912cde590795f7..02602d6952709aae54e499b5fbd2d7c3b4d84200 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 9c3f1375a5aeb378c12b7751773bca17b2a97130..4a031e6530e4251fb789419e77e253b17a4bc659 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 a8240b6e7efc28a7d0432852d76bfb0b54b2864a..b5bab2d87f449b29aa34b9680de2730bff64eaf1 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 7a665703d9b6da317ede0f2161870a9e46654d46..e1a43d78a286353db5df8973af4bbc863f1de1c8 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 dea641f9a6ee3160a9ac4d2d36cd25a0e01d0c61..16aee8709926340a0806b639faa85d08aa596563 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 787aa7721f224f3e7e600af207d7f378a6fbce02..5089f03e38ba6d8073c2bea57abe5b048eb43efe 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 bf2028461d103e061378d97ecd94eaff44006c9c..0253fa10bd73a8d431afb4ce7437dfd1b8433f1b 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 1be931e9b6bef423b027a399619173720a0d330c..cf1b78d032595983f5c34a54a4d0c3de9db8f3f9 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 4278e1e729070d37e577f4f7672413e898e03516..4e93adfddf9576a88f17b2fd85e3c2c484fed5b6 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 d7aaccadcb37890f36cf8e25861b304fdd92e485..1b8598b16f489db738ea7a427abd1b59dded0cc8 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 bfefb8a97d117cd6602cfbfc9af76ebd576f4d60..58bb0fe878386ed931447dca238398dc104b9ede 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 d7e7bff7678b69257082546eaa924ec29bf0fa68..3907ae77a37dc408e38d05086c51446ac3b1917b 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 cdf72f941f51efbfef15482fd02eeb490e4e3cbf..b452ce05b515cb4e57c02ed0a7c53a4f287af402 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 c3d4efa26c334f103c10b69bc51e5ad4f7def028..c09ce3bc60d7a98a0ab09ed433518fc7928cc248 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 85d22c9d0cfd73e5bad372600223570324fc3743..63dc86654814c45c1eaea47da9357771d779542b 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 51915185fe5f2abc5de2b23ede5b61c2bdee3bd7..bb26099d571e5836d397c075225cd103b3cf7c6b 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 56666a2db786a3e71be15a24a3891367e7014dcf..b8595a4574723d1db0fac0acb32c0c01380044a0 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 b63c278e8989987d228191eefba6fee7159b8cd3..5b42fc2c128c0470aa205dd8e0c252e62e9f5336 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 554449082d5980cb14d4ff2f6cc7e68089dd186c..af6421dbb168b8ceacd8eedeadf08bf9bc412932 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 81b0b69ee9302c8645791d69ea3a1fc2fa96d73f..9266823ad518d3047192ac4aafd6dbb5bf01143d 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 8e5647c557a4a6b0836f6578264d7e9a119cdc58..cbce88aa92517fb9c73f58a6a205d0259e2ef15f 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 174c70b6fc0d9b79d8a7c6bd2ae139b86546ca61..3d9102ef7b5fe6bbb376e5352e6b520ba6ecdf1f 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 b9567dcf31b09006a35931022531b71e658a773d..49123083e6b1a3d5fb38fafe205a35c71fcccb41 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 f8246525e810c5772efb05a95dfdf66d60a093e9..394ec538aad0425850c5cac194c0925311d782c3 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 a1fb829e2a4f85d91bb0025a2f75fc899de63aa0..cd756937eefcd498875fe64b8c20c0026305592c 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 68e3a25476a22c2de14f0b71b372bfe5c63caa83..0e991d61f388a94628c1f13f0c52584ce6279453 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 5ee2c3a2f1b8448c75129a25c3f58ac0e5ac426d..395e8c8bb866f80ba7c4ca9dbe8bba03e3a5f5f8 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 45849707726a5661675bb9c6060f42f15c800ed7..dcfa2eb5046180d4c1882bb0ff5455e6af53ad63 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 8d2888241ff7e36094725e1dca34cecf724cae59..a8230f6140e6388c6b8ba0e35328e1e2fc6eb76c 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 0ae765bd36e7bec83f334aac9bb3628cb4026970..c91fcb8abf240e4513727d0ae95a1543461edd40 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 4823c1cc60a41ea07d2eed80ada52db1f5610a0c..8441b60fca569fd45deac137ddecab260deb908c 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 53df8a39b64bcf8ec10a04f81e4c288854a9505b..aa48149e16a2f8d1170480bc3edaaed9a3c16ff9 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 ee5770ead4b497e52c962f70e28816e276c6ccd0..2277e128ab2cd38bef79fe07c77c618c9a46dab5 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 c5a688b33de8bb01b1291a5571875cd9d1583c3d..ea4ed22210730abee729ec059e399ac62f1a9918 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 c137745b24ea4d1134ea16b82a00141d78effb06..e4f13c09d59c99c6b499e01168b0bea4493d1233 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 5115a1f1aa73d41357cf9c32db38b26229bc8564..e3e45563f04b57073416f23c1248df894c48e961 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 872b182c7d922eeadb3e0b57e0a0546fe7a8e3d4..bf9a6ac98b77f4d5cc915fa6bce9bef3537ac7b2 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 2aa7bd09cd59389d3e3ad21ceed52afce8a4e7d3..ad0e31f48502716b09f79d970e21e50b3dc4dfde 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 7f2d4633d9c2fee2d1e1d11613420458e4baa209..228682cb5eba4064cd7e680ed8dcf57c2e8545a5 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 ca2aadb12b6ceb50e284161f65908c8449932c13..01d86cd30016d4b024d23d93fc86855ab917a0b7 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 09a8f6e5881f19b9e397a3bb3c47c10b6094f0ee..7b697619137f3553330179042950f2b5099c2153 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 3a3f7d8d936dd90fb0b26a7c76ed16eefb215176..09bbd276fd8b7a1c4f5e22eefa1dd3f16b0e524d 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 c404cf5f136ecd277d089695ec90c7781a86f360..df030d60f72f4a83be7bdab773d86ed38e84b258 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 c9472e40a651a46e0c95d45c8dd280f8c3d26864..136977be1c517a958249490b8db163acdd9d707c 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 24dcadff0aff80def98f9a3cb812b5c308e2bf44..e97ac4a7992f6c58f4b3260606645161d49063d7 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 0035eacdc12265bf0e1e22d621c1610513ddd8eb..6ea2b996687b976ef30acd6767d04be8125e71c4 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 9aef592cdc626745c97cc648bbdca17e88902e88..88c2166a24a01f0b7374020c27456624dbdd700d 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 27b7852e24bdc3ff46896b7cce606792d31dc03a..d39ea2c8a35b4f0e38ee0c3078ce1ef474aef7fa 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 413b490acf9590f6b825207bca10e34cea62938a..3e244fc782e95007e883b33e71065ae3a93ab7d1 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 58cf16d219f1ed13d1aeb9768bbc914bc48c89e8..6c61d90390511972918449cd460d6cf0ad8b197d 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 49bf0cb307cd888a5d0907574c0a75455db62139..c049afc1f6248693c425e91621f32e0f68fd3d92 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 fc35ec4ad7371fba313cc28435914f442c9f184d..f5ce5ac43ccf026c04d60574b8197c77c2caa0f5 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 613ba3ed6cedfb27697e9008f66d5f0c72b7654a..7914802aa77e93afddcb52de37953da542e97332 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 104f9c1bfcee7446c56cba87bb201173a5892276..0496a359504d0db9782e5b971c90a7b9265315e8 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 f426a74863ec3e0741f7644af2ed3953467ea725..72cd1da9d52ac20d48ee5ce75da78b47045609e8 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 96ce39b663097f4adee3360141213de9e39ccc2d..1a25e22bc12ec14b9ed91c3b7c7b7ed43fae0ade 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 fc1d648cff8be05c931f3461d7638ad63a64cd60..302808380192aec78997209f03630629fa71a4fc 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 0c1082a64104332238cde6bcf0a73b2c05c10020..cafc5468c0f5f055dc81f42f58c0ce060a2e9891 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 8bd92c8f82b03e47a5e5f0997a3850cd6a839381..d39aabe028481d3a7daf08b03c327d8f90c06735 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 72fe845c8585a2339b458357eb498d47431042b8..5b17972583375b0d4f5480cb8c67817828b7ceb4 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 b6920f3a8601afdfc23438fc518cb100e9f6ed37..8b91139b504affe905bcf2235a9f3dd1641a89d9 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 12853fc474ba6c3648e3dc5b6b13a3ee9dcc4295..a6faf003416ba7723d2b6d23c32d1f5c7b7db05e 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 26049a132d1011a8769165132102c78cd01bf1c4..c6198e24590acd3d3e031fb91c40591dbe70640d 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