From e30ff5572e85f969e28fc3aa20cab051d31f6905 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Fri, 6 May 2005 13:34:42 +0000 Subject: [PATCH] More type error refactoring --- ansi-tests/ansi-aux.lsp | 11 ++++++ ansi-tests/intersection.lsp | 8 +++++ ansi-tests/logand.lsp | 14 ++++---- ansi-tests/logandc2.lsp | 10 ++---- ansi-tests/logbitp.lsp | 9 ++--- ansi-tests/logcount.lsp | 5 +-- ansi-tests/logeqv.lsp | 10 ++---- ansi-tests/logical-pathname.lsp | 9 ++--- ansi-tests/logior.lsp | 10 ++---- ansi-tests/lognand.lsp | 10 ++---- ansi-tests/lognor.lsp | 10 ++---- ansi-tests/lognot.lsp | 5 +-- ansi-tests/logorc1.lsp | 10 ++---- ansi-tests/logorc2.lsp | 10 ++---- ansi-tests/logtest.lsp | 10 ++---- ansi-tests/logxor.lsp | 10 ++---- ansi-tests/make-broadcast-stream.lsp | 20 +++-------- ansi-tests/make-list.lsp | 8 ++--- ansi-tests/make-random-state.lsp | 5 +-- ansi-tests/make-symbol.lsp | 34 ++----------------- ansi-tests/make-synonym-stream.lsp | 6 +--- ansi-tests/make-two-way-stream.lsp | 38 ++++++--------------- ansi-tests/makunbound.lsp | 6 +--- ansi-tests/map-into.lsp | 10 +++--- ansi-tests/map.lsp | 12 +++++++ ansi-tests/mapc.lsp | 4 +-- ansi-tests/mapcan.lsp | 4 +-- ansi-tests/mapcar.lsp | 4 +-- ansi-tests/mapcon.lsp | 4 +-- ansi-tests/mapl.lsp | 4 +-- ansi-tests/maplist.lsp | 4 +-- ansi-tests/max.lsp | 9 ++--- ansi-tests/member-if-not.lsp | 4 +-- ansi-tests/member-if.lsp | 4 +-- ansi-tests/member.lsp | 4 +-- ansi-tests/min.lsp | 10 ++---- ansi-tests/minusp.lsp | 5 +-- ansi-tests/nintersection.lsp | 7 ++++ ansi-tests/notany.lsp | 29 ++++------------ ansi-tests/notevery.lsp | 29 ++++------------ ansi-tests/nreconc.lsp | 4 +++ ansi-tests/nreverse.lsp | 20 ++--------- ansi-tests/nset-difference.lsp | 7 ++++ ansi-tests/nset-exclusive-or.lsp | 8 +++++ ansi-tests/nsublis.lsp | 4 +++ ansi-tests/nsubstitute-if-not.lsp | 3 ++ ansi-tests/nsubstitute-if.lsp | 3 ++ ansi-tests/nsubstitute.lsp | 3 ++ ansi-tests/nthcdr.lsp | 20 ++--------- ansi-tests/nunion.lsp | 8 +++++ ansi-tests/oddp.lsp | 5 +-- ansi-tests/open-stream-p.lsp | 5 +-- ansi-tests/output-stream-p.lsp | 5 +-- ansi-tests/package-name.lsp | 3 ++ ansi-tests/package-nicknames.lsp | 5 +++ ansi-tests/pairlis.lsp | 7 ++++ ansi-tests/pathname-device.lsp | 7 +--- ansi-tests/pathname-directory.lsp | 7 +--- ansi-tests/pathname-host.lsp | 8 +---- ansi-tests/pathname-match-p.lsp | 36 +++++--------------- ansi-tests/pathname-name.lsp | 7 +--- ansi-tests/pathname-type.lsp | 7 +--- ansi-tests/pathname-version.lsp | 7 +--- ansi-tests/phase.lsp | 5 +-- ansi-tests/plusp.lsp | 5 +-- ansi-tests/position-if-not.lsp | 12 ++----- ansi-tests/position-if.lsp | 12 ++----- ansi-tests/position.lsp | 12 ++----- ansi-tests/pprint-logical-block.lsp | 51 ++++++++++++---------------- ansi-tests/pprint-newline.lsp | 12 +++---- ansi-tests/random-types.lsp | 8 ++++- ansi-tests/random.lsp | 5 +-- ansi-tests/rassoc-if-not.lsp | 4 +++ ansi-tests/rassoc-if.lsp | 3 ++ ansi-tests/rassoc.lsp | 4 +++ ansi-tests/rational.lsp | 5 +-- ansi-tests/rationalize.lsp | 5 +-- ansi-tests/read-byte.lsp | 10 ++---- ansi-tests/read-sequence.lsp | 47 +++++++++++-------------- ansi-tests/readtable-case.lsp | 26 +++++--------- ansi-tests/realpart.lsp | 5 +-- 81 files changed, 298 insertions(+), 537 deletions(-) diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index 232a2d7a..24c5cc3e 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 5706c11e..13ceaf37 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 421523a4..5fe31cfe 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 b8d90555..eec05ecf 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 891118dc..c309a9ae 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 071903b9..dbbfc73f 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 032755e5..3bd145eb 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 afbd1cbb..aebbd393 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 7e9bec8f..2e75e5e2 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 94740f93..cb5fbbdb 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 58b8853b..24f003b8 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 de05eb25..9015b344 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 6f578327..b781b7c0 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 52c5a0ca..d94e8f36 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 96392f0e..654a9d28 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 5d65d46a..933f9809 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 eca5ff6a..25615a96 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 466fbae8..671f1b61 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 634f04b5..02602d69 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 9c3f1375..4a031e65 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 a8240b6e..b5bab2d8 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 7a665703..e1a43d78 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 dea641f9..16aee870 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 787aa772..5089f03e 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 bf202846..0253fa10 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 1be931e9..cf1b78d0 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 4278e1e7..4e93adfd 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 d7aaccad..1b8598b1 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 bfefb8a9..58bb0fe8 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 d7e7bff7..3907ae77 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 cdf72f94..b452ce05 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 c3d4efa2..c09ce3bc 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 85d22c9d..63dc8665 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 51915185..bb26099d 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 56666a2d..b8595a45 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 b63c278e..5b42fc2c 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 55444908..af6421db 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 81b0b69e..9266823a 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 8e5647c5..cbce88aa 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 174c70b6..3d9102ef 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 b9567dcf..49123083 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 f8246525..394ec538 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 a1fb829e..cd756937 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 68e3a254..0e991d61 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 5ee2c3a2..395e8c8b 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 45849707..dcfa2eb5 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 8d288824..a8230f61 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 0ae765bd..c91fcb8a 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 4823c1cc..8441b60f 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 53df8a39..aa48149e 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 ee5770ea..2277e128 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 c5a688b3..ea4ed222 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 c137745b..e4f13c09 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 5115a1f1..e3e45563 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 872b182c..bf9a6ac9 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 2aa7bd09..ad0e31f4 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 7f2d4633..228682cb 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 ca2aadb1..01d86cd3 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 09a8f6e5..7b697619 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 3a3f7d8d..09bbd276 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 c404cf5f..df030d60 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 c9472e40..136977be 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 24dcadff..e97ac4a7 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 0035eacd..6ea2b996 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 9aef592c..88c2166a 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 27b7852e..d39ea2c8 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 413b490a..3e244fc7 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 58cf16d2..6c61d903 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 49bf0cb3..c049afc1 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 fc35ec4a..f5ce5ac4 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 613ba3ed..7914802a 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 104f9c1b..0496a359 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 f426a748..72cd1da9 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 96ce39b6..1a25e22b 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 fc1d648c..30280838 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 0c1082a6..cafc5468 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 8bd92c8f..d39aabe0 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 72fe845c..5b179725 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 b6920f3a..8b91139b 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 12853fc4..a6faf003 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 26049a13..c6198e24 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 -- GitLab