diff --git a/ansi-tests/char-compare.lsp b/ansi-tests/char-compare.lsp index 29251d00caac2830c47a0ef90c94a65944dbbec0..238c073f4ca75d7bdd4f47dbdb5dca3079a68be6 100644 --- a/ansi-tests/char-compare.lsp +++ b/ansi-tests/char-compare.lsp @@ -11,9 +11,9 @@ (loop for f in '(char= char/= char< char> char<= char>= char-lessp char-greaterp char-equal char-not-lessp char-not-greaterp char-not-equal) - collect (handler-case (funcall f) (program-error () :caught))) - (:caught :caught :caught :caught :caught :caught - :caught :caught :caught :caught :caught :caught)) + collect (classify-error (funcall f))) + (program-error program-error program-error program-error + program-error program-error program-error program-error)) (deftest char=.1 (is-ordered-by +code-chars+ #'(lambda (c1 c2) (not (char= c1 c2)))) diff --git a/ansi-tests/concatenate.lsp b/ansi-tests/concatenate.lsp index c38e8cdd905718981f5369b0cc2430e0040c17a1..267fda3f26ced0f9408992eace624767e82d81a3 100644 --- a/ansi-tests/concatenate.lsp +++ b/ansi-tests/concatenate.lsp @@ -127,5 +127,5 @@ :caught) (deftest concatenate-error.3 - (catch-type-error (concatenate '(vector * 3) '(a b c d e))) + (classify-error (concatenate '(vector * 3) '(a b c d e))) type-error) diff --git a/ansi-tests/cons-test-02.lsp b/ansi-tests/cons-test-02.lsp index f3f5cf584edb14318e089f9f280fa2d26ad568f2..98314749dcdc00309b72791941c1da24c00aa219 100644 --- a/ansi-tests/cons-test-02.lsp +++ b/ansi-tests/cons-test-02.lsp @@ -113,12 +113,10 @@ ;; Check that a null key arg is ignored. (deftest sublis-8 - (handler-case - (check-sublis - '(1 2 a b) - '((1 . 2) (a . b)) - :key nil) - (error (c) c)) + (check-sublis + '(1 2 a b) + '((1 . 2) (a . b)) + :key nil) (2 2 b b)) ;; nsublis @@ -187,12 +185,10 @@ ;; Check that a null key arg is ignored. (deftest nsublis-8 - (handler-case - (check-nsublis - '(1 2 a b) - '((1 . 2) (a . b)) - :key nil) - (error (c) c)) + (check-nsublis + '(1 2 a b) + '((1 . 2) (a . b)) + :key nil) (2 2 b b)) (deftest sublis-shared @@ -275,11 +271,9 @@ ((1 . foo) (foo . 5) (foo 7 foo 9 foo (11 foo)))) (deftest subst-9 - (handler-case - (check-subst 'a 'b - (copy-tree '(a b c d a b)) - :key nil) - (error (c) c)) + (check-subst 'a 'b + (copy-tree '(a b c d a b)) + :key nil) (a a c d a a)) @@ -379,20 +373,16 @@ (40 40 40 40)) (deftest subst-if-6 - (handler-case - (check-subst-if 'a #'(lambda (x) (eql x 'b)) - '((a) (b) (c) (d)) - :key nil) - (error (c) c)) -((a) (a) (c) (d))) + (check-subst-if 'a #'(lambda (x) (eql x 'b)) + '((a) (b) (c) (d)) + :key nil) + ((a) (a) (c) (d))) (deftest subst-if-not-5 - (handler-case - (check-subst-if-not 'a #'(lambda (x) (not (eql x 'b))) - '((a) (b) (c) (d)) - :key nil) - (error (c) c)) -((a) (a) (c) (d))) + (check-subst-if-not 'a #'(lambda (x) (not (eql x 'b))) + '((a) (b) (c) (d)) + :key nil) + ((a) (a) (c) (d))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Check nsubst @@ -458,11 +448,9 @@ ((1 . foo) (foo . 5) (foo 7 foo 9 foo (11 foo)))) (deftest nsubst-9 - (handler-case - (check-nsubst 'a 'b + (check-nsubst 'a 'b (copy-tree '(a b c d a b)) :key nil) - (error (c) c)) (a a c d a a)) @@ -544,17 +532,13 @@ (40 40 40 40)) (deftest nsubst-if-6 - (handler-case - (check-nsubst-if 'a #'(lambda (x) (eql x 'b)) + (check-nsubst-if 'a #'(lambda (x) (eql x 'b)) '((a) (b) (c) (d)) :key nil) - (error (c) c)) -((a) (a) (c) (d))) + ((a) (a) (c) (d))) (deftest nsubst-if-not-5 - (handler-case - (check-nsubst-if-not 'a #'(lambda (x) (not (eql x 'b))) + (check-nsubst-if-not 'a #'(lambda (x) (not (eql x 'b))) '((a) (b) (c) (d)) :key nil) - (error (c) c)) -((a) (a) (c) (d))) + ((a) (a) (c) (d))) diff --git a/ansi-tests/cons-test-04.lsp b/ansi-tests/cons-test-04.lsp index 1777616005b7113e6e323e6f352b2c45d9b8b2b0..02a923afecea7e3c6d19c70cd30b8ba4cb5ea910 100644 --- a/ansi-tests/cons-test-04.lsp +++ b/ansi-tests/cons-test-04.lsp @@ -161,23 +161,19 @@ ;; Check that a NIL :key argument is the same as no key argument at all (deftest pushnew-10 - (handler-case - (let* ((x (list 'a 'b 'c 'd)) - (result (pushnew 'z x :key nil))) - result) - (error (c) c)) + (let* ((x (list 'a 'b 'c 'd)) + (result (pushnew 'z x :key nil))) + result) (z a b c d)) ;; Check that a NIL :key argument is the same as no key argument at all (deftest pushnew-11 - (handler-case - (let* ((x (copy-tree '((a b) 1 "and" c d e))) - (y (pushnew (copy-tree '(a b)) x - :test 'equal :key nil))) - (and - (eqt x y) - x)) - (error (c) c)) + (let* ((x (copy-tree '((a b) 1 "and" c d e))) + (y (pushnew (copy-tree '(a b)) x + :test 'equal :key nil))) + (and + (eqt x y) + x)) ((a b) 1 "and" c d e)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -197,9 +193,7 @@ ;; Check that a NIL :key argument is the same as no key argument at all (deftest adjoin-4 - (handler-case - (adjoin 'a '(a) :key nil) - (error (c) c)) + (adjoin 'a '(a) :key nil) (a)) (deftest adjoin-5 @@ -248,24 +242,18 @@ ;; Test that a :key of NIL is the same as no key at all (deftest adjoin-16 - (handler-case - (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) - :test #'equal :key nil) - (error (c) c)) -(aaa "AAA" "aaa" #\a)) + (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) + :test #'equal :key nil) + (aaa "AAA" "aaa" #\a)) ;; Test that a :key of NIL is the same as no key at all (deftest adjoin-17 - (handler-case - (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) - :test 'equal :key nil) - (error (c) c)) -(aaa "AAA" "aaa" #\a)) + (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) + :test 'equal :key nil) + (aaa "AAA" "aaa" #\a)) ;; Test that a :key of NIL is the same as no key at all (deftest adjoin-18 - (handler-case - (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) - :test-not (complement #'equal) :key nil) - (error (c) c)) -(aaa "AAA" "aaa" #\a)) + (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) + :test-not (complement #'equal) :key nil) + (aaa "AAA" "aaa" #\a)) diff --git a/ansi-tests/cons-test-05.lsp b/ansi-tests/cons-test-05.lsp index 1e43dd2e7607d55fca2ef4848774de4959bea8d5..8a9c3e6de423cd3929c66cab1eaac1ea7f74b80d 100644 --- a/ansi-tests/cons-test-05.lsp +++ b/ansi-tests/cons-test-05.lsp @@ -138,13 +138,11 @@ 0) (deftest nth-2 - (handler-case - (let ((x (loop for i from 1 to 2000 collect i))) - (loop - for i from 0 to 1999 do - (setf (nth i x) (- 1999 i))) - (equal x (loop for i from 1999 downto 0 collect i))) - (error (c) c)) + (let ((x (loop for i from 1 to 2000 collect i))) + (loop + for i from 0 to 1999 do + (setf (nth i x) (- 1999 i))) + (equalt x (loop for i from 1999 downto 0 collect i))) t) ;;; Test side effects, evaluation order in assignment to NTH diff --git a/ansi-tests/cons-test-11.lsp b/ansi-tests/cons-test-11.lsp index a70677cbbc33017b85b0b5ca459c15c4138a52ec..342de710067a3e329ec51e9a500bd728b2840fd9 100644 --- a/ansi-tests/cons-test-11.lsp +++ b/ansi-tests/cons-test-11.lsp @@ -19,18 +19,16 @@ (a b c)) (deftest ldiff-2 - (handler-case - (let* ((x (copy-tree '(a b c d e f))) - (xcopy (make-scaffold-copy x))) - (let ((result (ldiff x 'a))) - (and - (check-scaffold-copy x xcopy) - (zerop - (loop - for a on x and b on result count - (eqt a b))) - result))) - (error (c) c)) + (let* ((x (copy-tree '(a b c d e f))) + (xcopy (make-scaffold-copy x))) + (let ((result (ldiff x 'a))) + (and + (check-scaffold-copy x xcopy) + (zerop + (loop + for a on x and b on result count + (eqt a b))) + result))) (a b c d e f)) ;; Works when the end of the dotted list is a symbol diff --git a/ansi-tests/cons-test-13.lsp b/ansi-tests/cons-test-13.lsp index f98ab48d08d5b8fefbdae13649d0242112bdaeee..8959c5a966f9b7389113b225d92cb7fd59ab1ad8 100644 --- a/ansi-tests/cons-test-13.lsp +++ b/ansi-tests/cons-test-13.lsp @@ -164,14 +164,9 @@ ;; Check that a null key argument is ignored (deftest member-25 - (handler-case - (member 'a '(c d a b e) :key nil) - (error (c) c)) + (member 'a '(c d a b e) :key nil) (a b e)) (deftest member-26 - (handler-case - (member 'z '(a b c d) :key nil) - (error (c) c)) + (member 'z '(a b c d) :key nil) nil) - diff --git a/ansi-tests/cons-test-15.lsp b/ansi-tests/cons-test-15.lsp index bba36a1aed695451bff0cb51f7020cf907aa8343..f7f6eb0f1d87e7e0b3ab5c04cb2a95da9f676ef9 100644 --- a/ansi-tests/cons-test-15.lsp +++ b/ansi-tests/cons-test-15.lsp @@ -65,11 +65,8 @@ (h g f e d c b a)) (deftest mapc-7 - (handler-case - (mapc (gensym) '(a b c)) - (error () 'error)) - error) - + (classify-error (mapc #'identity 1)) + type-error) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; mapcar @@ -135,10 +132,8 @@ ((h g f e d c b a) (a b c d e f g h))) (deftest mapcar-7 - (handler-case - (mapcar (gensym) '(a b c)) - (error () 'error)) - error) + (classify-error (mapcar #'identity 1)) + type-error) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; mapcan @@ -207,174 +202,158 @@ nil) (deftest mapcan-10 - (handler-case - (mapcan (gensym) (copy-list '(a b c))) - (error () 'error)) - error) - -(deftest mapcan-11 - (handler-case - (mapcan 1 (copy-list '(a b c))) - (error () 'error)) - error) - -(deftest mapcan-12 - (handler-case - (mapcan 1.234 (copy-list '(a b c))) - (error () 'error)) - error) - -(deftest mapcan-13 - (handler-case - (mapcan "foo" (copy-list '(a b c))) - (error () 'error)) - error) + (classify-error (mapcan #'identity 1)) + type-error) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; mapl (deftest mapl-1 - (mapl #'list nil) + (mapl #'list nil) nil) (deftest mapl-2 - (let* ((a nil) - (x (copy-list '(a b c))) - (xcopy (make-scaffold-copy x)) - (result - (mapl #'(lambda (y) (push y a)) - x))) - (and - (check-scaffold-copy x xcopy) - (eqt result x) - a)) - ((c) (b c) (a b c))) + (let* ((a nil) + (x (copy-list '(a b c))) + (xcopy (make-scaffold-copy x)) + (result + (mapl #'(lambda (y) (push y a)) + x))) + (and + (check-scaffold-copy x xcopy) + (eqt result x) + a)) + ((c) (b c) (a b c))) (deftest mapl-3 - (let* ((a nil) - (x (copy-list '(a b c d))) - (y (copy-list '(1 2 3 4))) - (xcopy (make-scaffold-copy x)) - (ycopy (make-scaffold-copy y)) - (result - (mapl #'(lambda (xtail ytail) - (setf a - (append (mapcar #'list xtail ytail) - a))) - x y))) - (and - (eqt result x) - (check-scaffold-copy x xcopy) - (check-scaffold-copy y ycopy) - a)) + (let* ((a nil) + (x (copy-list '(a b c d))) + (y (copy-list '(1 2 3 4))) + (xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y)) + (result + (mapl #'(lambda (xtail ytail) + (setf a + (append (mapcar #'list xtail ytail) + a))) + x y))) + (and + (eqt result x) + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + a)) ((d 4) (c 3) (d 4) (b 2) (c 3) (d 4) - (a 1) (b 2) (c 3) (d 4))) + (a 1) (b 2) (c 3) (d 4))) (deftest mapl-4 - (let* ((a nil) - (x (copy-list '(a b c d))) - (y (copy-list '(1 2 3 4 5 6 7 8))) - (xcopy (make-scaffold-copy x)) - (ycopy (make-scaffold-copy y)) - (result - (mapl #'(lambda (xtail ytail) - (setf a - (append (mapcar #'list xtail ytail) - a))) - x y))) - (and - (eqt result x) - (check-scaffold-copy x xcopy) - (check-scaffold-copy y ycopy) - a)) + (let* ((a nil) + (x (copy-list '(a b c d))) + (y (copy-list '(1 2 3 4 5 6 7 8))) + (xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y)) + (result + (mapl #'(lambda (xtail ytail) + (setf a + (append (mapcar #'list xtail ytail) + a))) + x y))) + (and + (eqt result x) + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + a)) ((d 4) (c 3) (d 4) (b 2) (c 3) (d 4) - (a 1) (b 2) (c 3) (d 4))) + (a 1) (b 2) (c 3) (d 4))) (deftest mapl-5 - (let* ((a nil) - (x (copy-list '(a b c d e f g))) - (y (copy-list '(1 2 3 4))) - (xcopy (make-scaffold-copy x)) - (ycopy (make-scaffold-copy y)) - (result - (mapl #'(lambda (xtail ytail) - (setf a - (append (mapcar #'list xtail ytail) - a))) - x y))) - (and - (eqt result x) - (check-scaffold-copy x xcopy) - (check-scaffold-copy y ycopy) - a)) + (let* ((a nil) + (x (copy-list '(a b c d e f g))) + (y (copy-list '(1 2 3 4))) + (xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y)) + (result + (mapl #'(lambda (xtail ytail) + (setf a + (append (mapcar #'list xtail ytail) + a))) + x y))) + (and + (eqt result x) + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + a)) ((d 4) (c 3) (d 4) (b 2) (c 3) (d 4) - (a 1) (b 2) (c 3) (d 4))) + (a 1) (b 2) (c 3) (d 4))) + +(deftest mapl-6 + (classify-error (mapl #'identity 1)) + type-error) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; maplist (deftest maplist-1 - (maplist #'list nil) + (maplist #'list nil) nil) (deftest maplist-2 - (let* ((x (copy-list '(a b c))) - (xcopy (make-scaffold-copy x)) - (result (maplist #'identity x))) - (and (check-scaffold-copy x xcopy) - result)) + (let* ((x (copy-list '(a b c))) + (xcopy (make-scaffold-copy x)) + (result (maplist #'identity x))) + (and (check-scaffold-copy x xcopy) + result)) ((a b c) (b c) (c))) (deftest maplist-3 - (let* ((x (copy-list '(a b c d))) - (y (copy-list '(1 2 3 4))) - (xcopy (make-scaffold-copy x)) - (ycopy (make-scaffold-copy y)) - (result - (maplist #'append x y))) - (and - (check-scaffold-copy x xcopy) - (check-scaffold-copy y ycopy) - result)) + (let* ((x (copy-list '(a b c d))) + (y (copy-list '(1 2 3 4))) + (xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y)) + (result + (maplist #'append x y))) + (and + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + result)) ((a b c d 1 2 3 4) (b c d 2 3 4) (c d 3 4) (d 4))) (deftest maplist-4 - (let* ((x (copy-list '(a b c d))) - (y (copy-list '(1 2 3 4 5))) - (xcopy (make-scaffold-copy x)) - (ycopy (make-scaffold-copy y)) - (result - (maplist #'append x y))) - (and - (check-scaffold-copy x xcopy) - (check-scaffold-copy y ycopy) - result)) + (let* ((x (copy-list '(a b c d))) + (y (copy-list '(1 2 3 4 5))) + (xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y)) + (result + (maplist #'append x y))) + (and + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + result)) ((a b c d 1 2 3 4 5) (b c d 2 3 4 5) (c d 3 4 5) (d 4 5))) (deftest maplist-5 - (let* ((x (copy-list '(a b c d e))) - (y (copy-list '(1 2 3 4))) - (xcopy (make-scaffold-copy x)) - (ycopy (make-scaffold-copy y)) - (result - (maplist #'append x y))) - (and - (check-scaffold-copy x xcopy) - (check-scaffold-copy y ycopy) - result)) + (let* ((x (copy-list '(a b c d e))) + (y (copy-list '(1 2 3 4))) + (xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y)) + (result + (maplist #'append x y))) + (and + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + result)) ((a b c d e 1 2 3 4) (b c d e 2 3 4) (c d e 3 4) (d e 4))) (deftest maplist-6 - (maplist 'append '(a b c) '(1 2 3)) + (maplist 'append '(a b c) '(1 2 3)) ((a b c 1 2 3) (b c 2 3) (c 3))) (deftest maplist-7 @@ -385,57 +364,54 @@ (a c c e e g g)) (deftest maplist-8 - (handler-case - (maplist #'identity 'a) - (error () 'error)) - error) + (classify-error (maplist #'identity 'a)) + type-error) (deftest maplist-9 - (handler-case - (maplist #'identity 1) - (error () 'error)) - error) + (classify-error (maplist #'identity 1)) + type-error) (deftest maplist-10 - (handler-case - (maplist #'identity 1.1323) - (error () 'error)) - error) + (classify-error (maplist #'identity 1.1323)) + type-error) (deftest maplist-11 - (handler-case - (maplist #'identity "abcde") - (error () 'error)) - error) + (classify-error (maplist #'identity "abcde")) + type-error) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; mapcan (deftest mapcon-1 - (mapcon #'(lambda (x) (append '(a) x nil)) nil) + (mapcon #'(lambda (x) (append '(a) x nil)) nil) nil) (deftest mapcon-2 - (let* ((x (copy-list '(1 2 3 4))) - (xcopy (make-scaffold-copy x)) - (result - (mapcon #'(lambda (y) (append '(a) y nil)) x))) - (and - (check-scaffold-copy x xcopy) - result)) + (let* ((x (copy-list '(1 2 3 4))) + (xcopy (make-scaffold-copy x)) + (result + (mapcon #'(lambda (y) (append '(a) y nil)) x))) + (and + (check-scaffold-copy x xcopy) + result)) (a 1 2 3 4 a 2 3 4 a 3 4 a 4)) (deftest mapcon-3 - (let* ((x (copy-list '(4 2 3 2 2))) - (y (copy-list '(a b c d e f g h i j k l))) - (xcopy (make-scaffold-copy x)) - (ycopy (make-scaffold-copy y)) - (result - (mapcon #'(lambda (xt yt) - (subseq yt 0 (car xt))) - x y))) - (and - (check-scaffold-copy x xcopy) - (check-scaffold-copy y ycopy) - result)) + (let* ((x (copy-list '(4 2 3 2 2))) + (y (copy-list '(a b c d e f g h i j k l))) + (xcopy (make-scaffold-copy x)) + (ycopy (make-scaffold-copy y)) + (result + (mapcon #'(lambda (xt yt) + (subseq yt 0 (car xt))) + x y))) + (and + (check-scaffold-copy x xcopy) + (check-scaffold-copy y ycopy) + result)) (a b c d b c c d e d e e f)) + +(deftest mapcon-4 + (classify-error (mapcon #'identity 1)) + type-error) + diff --git a/ansi-tests/cons-test-16.lsp b/ansi-tests/cons-test-16.lsp index f63965056d9ba5938701a6ec454356fd8c6d6e24..1d3fd1d5f9d96b5c481909a567b1e1852ab2f8f2 100644 --- a/ansi-tests/cons-test-16.lsp +++ b/ansi-tests/cons-test-16.lsp @@ -192,15 +192,13 @@ (6 . c)) (deftest assoc-if-2 - (handler-case - (let* ((x (copy-list '((1 . a) (3 . b) (6 . c) (7 . d)))) - (xcopy (make-scaffold-copy x)) - (result (assoc-if #'oddp x :key #'1+))) - (and - (check-scaffold-copy x xcopy) - (eqt result (third x)) - result)) - (program-error (c) c)) + (let* ((x (copy-list '((1 . a) (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (assoc-if #'oddp x :key #'1+))) + (and + (check-scaffold-copy x xcopy) + (eqt result (third x)) + result)) (6 . c)) (deftest assoc-if-3 @@ -231,15 +229,13 @@ (6 . c)) (deftest assoc-if-not-2 - (handler-case - (let* ((x (copy-list '((1 . a) (3 . b) (6 . c) (7 . d)))) - (xcopy (make-scaffold-copy x)) - (result (assoc-if-not #'evenp x :key #'1+))) - (and - (check-scaffold-copy x xcopy) - (eqt result (third x)) - result)) - (program-error (c) c)) + (let* ((x (copy-list '((1 . a) (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (assoc-if-not #'evenp x :key #'1+))) + (and + (check-scaffold-copy x xcopy) + (eqt result (third x)) + result)) (6 . c)) (deftest assoc-if-not-3 diff --git a/ansi-tests/cons-test-17.lsp b/ansi-tests/cons-test-17.lsp index 46181f9328fe40fd7f5bc147a532b78472204b5f..9ad5381fea903d634c9b0986551568a2270dff98 100644 --- a/ansi-tests/cons-test-17.lsp +++ b/ansi-tests/cons-test-17.lsp @@ -205,15 +205,13 @@ (c . 6)) (deftest rassoc-if-2 - (handler-case - (let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d)))) - (xcopy (make-scaffold-copy x)) - (result (rassoc-if #'oddp x :key #'1+))) - (and - (check-scaffold-copy x xcopy) - (eqt result (third x)) - result)) - (program-error (c) c)) + (let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (rassoc-if #'oddp x :key #'1+))) + (and + (check-scaffold-copy x xcopy) + (eqt result (third x)) + result)) (c . 6)) (deftest rassoc-if-3 @@ -245,15 +243,13 @@ (c . 6)) (deftest rassoc-if-not-2 - (handler-case - (let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d)))) - (xcopy (make-scaffold-copy x)) - (result (rassoc-if-not #'evenp x :key #'1+))) - (and - (check-scaffold-copy x xcopy) - (eqt result (third x)) - result)) - (program-error (c) c)) + (let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d)))) + (xcopy (make-scaffold-copy x)) + (result (rassoc-if-not #'evenp x :key #'1+))) + (and + (check-scaffold-copy x xcopy) + (eqt result (third x)) + result)) (c . 6)) (deftest rassoc-if-not-3 diff --git a/ansi-tests/cons-test-19.lsp b/ansi-tests/cons-test-19.lsp index 4d0f8b7c66ad03d4150aba700082e9251e064251..f66e6cd794d735967f24e286b1d35a37276ef55c 100644 --- a/ansi-tests/cons-test-19.lsp +++ b/ansi-tests/cons-test-19.lsp @@ -220,17 +220,15 @@ ;; Test that a nil key argument is ignored (deftest intersection-14 - (handler-case - (let - ((result (intersection (copy-list '(a b c d)) - (copy-list '(e c f b g)) - :key nil))) - (and - (member 'b result) - (member 'c result) - (every #'(lambda (x) (member x '(b c))) result) - t)) - (error (c) c)) + (let + ((result (intersection (copy-list '(a b c d)) + (copy-list '(e c f b g)) + :key nil))) + (and + (member 'b result) + (member 'c result) + (every #'(lambda (x) (member x '(b c))) result) + t)) t) ;; Test that intersection preserves the order of arguments to :test, :test-not @@ -434,18 +432,16 @@ ;; Check that a nil key argument is ignored (deftest nintersection-14 - (handler-case - (let - ((result (nintersection - (copy-list '(a b c d)) - (copy-list '(e c f b g)) - :key nil))) - (and - (member 'b result) - (member 'c result) - (every #'(lambda (x) (member x '(b c))) result) - t)) - (error (c) c)) + (let + ((result (nintersection + (copy-list '(a b c d)) + (copy-list '(e c f b g)) + :key nil))) + (and + (member 'b result) + (member 'c result) + (every #'(lambda (x) (member x '(b c))) result) + t)) t) ;; Test that nintersection preserves the order of arguments to :test, :test-not diff --git a/ansi-tests/cons-test-20.lsp b/ansi-tests/cons-test-20.lsp index 82cdfaec0eb04039b15b8f4478ed43ed323cd3bb..1d273f31d6ff12fd6dd07d22c4d2ce81c624881f 100644 --- a/ansi-tests/cons-test-20.lsp +++ b/ansi-tests/cons-test-20.lsp @@ -190,12 +190,10 @@ t) (deftest union-22 - (handler-case - (let ((x (copy-list '(1 2 3 4 5 6 7))) - (y (copy-list '(10 19 5 3 17 1001 2)))) - (let ((result (union-with-check-and-key x y nil))) - (check-union x y result))) - (error (c) c)) + (let ((x (copy-list '(1 2 3 4 5 6 7))) + (y (copy-list '(10 19 5 3 17 1001 2)))) + (let ((result (union-with-check-and-key x y nil))) + (check-union x y result))) t) (deftest union-23 diff --git a/ansi-tests/cons-test-21.lsp b/ansi-tests/cons-test-21.lsp index b0992132cad8c776ec3be6db66187d90c52faee9..02d98b70146a30ce12964c076075a44f710349c1 100644 --- a/ansi-tests/cons-test-21.lsp +++ b/ansi-tests/cons-test-21.lsp @@ -169,12 +169,10 @@ t) (deftest nunion-22 - (handler-case - (let ((x '(1 2 3 4 5 6 7)) - (y '(10 19 5 3 17 1001 2))) - (let ((result (nunion-with-copy-and-key x y nil))) - (check-union x y result))) - (error (c) c)) + (let ((x '(1 2 3 4 5 6 7)) + (y '(10 19 5 3 17 1001 2))) + (let ((result (nunion-with-copy-and-key x y nil))) + (check-union x y result))) t) (deftest nunion-23 diff --git a/ansi-tests/cons-test-22.lsp b/ansi-tests/cons-test-22.lsp index 2577d545a9222b80ecf9909ec4e9264d5e9c995e..4c17eaab42ee296766ec0a7cd15221a3f39af19b 100644 --- a/ansi-tests/cons-test-22.lsp +++ b/ansi-tests/cons-test-22.lsp @@ -67,10 +67,8 @@ nil) (deftest set-difference-6 - (handler-case - (set-difference-with-check '(a b c d e) '(d a b e) - :key nil) - (error (c) c)) + (set-difference-with-check '(a b c d e) '(d a b e) + :key nil) (c)) (deftest set-difference-7 @@ -243,10 +241,8 @@ nil) (deftest nset-difference-6 - (handler-case - (nset-difference-with-check '(a b c d e) '(d a b e) - :key nil) - (error (c) c)) + (nset-difference-with-check '(a b c d e) '(d a b e) + :key nil) (c)) (deftest nset-difference-7 diff --git a/ansi-tests/cons-test-23.lsp b/ansi-tests/cons-test-23.lsp index 873638c38e43e2c9998318f6a9ee9594179f686a..f34bc6397669348aaa0a2ef2fbbe075e87f3e7e7 100644 --- a/ansi-tests/cons-test-23.lsp +++ b/ansi-tests/cons-test-23.lsp @@ -77,10 +77,8 @@ t) (deftest set-exclusive-or-6 - (handler-case - (set-exclusive-or-with-check '(a b c d e) '(d a b e) - :key nil) - (error (c) c)) + (set-exclusive-or-with-check '(a b c d e) '(d a b e) + :key nil) (c)) (deftest set-exclusive-or-7 @@ -265,10 +263,8 @@ t) (deftest nset-exclusive-or-6 - (handler-case - (nset-exclusive-or-with-check '(a b c d e) '(d a b e) - :key nil) - (error (c) c)) + (nset-exclusive-or-with-check '(a b c d e) '(d a b e) + :key nil) (c)) (deftest nset-exclusive-or-7 diff --git a/ansi-tests/cons-test-24.lsp b/ansi-tests/cons-test-24.lsp index c709b502f08e94b6f607642cbbe8fd1a1c9d7eaf..a0a1617c8f0389426ab957ee7be43fa769f6876c 100644 --- a/ansi-tests/cons-test-24.lsp +++ b/ansi-tests/cons-test-24.lsp @@ -79,15 +79,13 @@ t) (deftest subsetp-10 - (handler-case - (subsetp-with-check (list 'a 'b 'c) - (copy-tree - (list '(z . c) '(a . y) '(b . 100) '(e . f) - '(c . foo))) - :test #'(lambda (e1 e2) - (eqt e1 (car e2))) - :key nil) - (error (c) c)) + (subsetp-with-check (list 'a 'b 'c) + (copy-tree + (list '(z . c) '(a . y) '(b . 100) '(e . f) + '(c . foo))) + :test #'(lambda (e1 e2) + (eqt e1 (car e2))) + :key nil) t) (deftest subsetp-11 diff --git a/ansi-tests/elt.lsp b/ansi-tests/elt.lsp index 5b725180114bef0d4281c942e54d473048fa1e53..f4c421151e6ecdf18372a72d43ed6b12dffb825d 100644 --- a/ansi-tests/elt.lsp +++ b/ansi-tests/elt.lsp @@ -8,10 +8,7 @@ (declaim (optimize (safety 3))) (defun safe-elt (x n) - (handler-case - (elt x n) - (type-error () 'type-error) - (error (c) c))) + (classify-error (elt x n))) ;; elt on lists @@ -50,11 +47,9 @@ ((a b c e) e)) (deftest elt-10 - (handler-case + (classify-error (let ((x (list 'a 'b 'c))) - (setf (elt x 4) 'd)) - (type-error () 'type-error) - (error (c) c)) + (setf (elt x 4) 'd))) type-error) (deftest elt-11 @@ -114,10 +109,8 @@ type-error) (deftest elt-v-1 - (handler-case - (elt (make-array '(0)) 0) - (type-error () 'type-error) - (error (c) c)) + (classify-error + (elt (make-array '(0)) 0)) type-error) ;; (deftest elt-v-2 (elt (make-array '(1)) 0) nil) ;; actually undefined @@ -159,19 +152,15 @@ (a b c e e)) (deftest elt-v-10 - (handler-case + (classify-error (let ((x (make-array '(3) :initial-contents (list 'a 'b 'c)))) - (setf (elt x 4) 'd)) - (type-error () 'type-error) - (error (c) c)) + (setf (elt x 4) 'd))) type-error) (deftest elt-v-11 - (handler-case + (classify-error (let ((x (make-array '(3) :initial-contents (list 'a 'b 'c)))) - (setf (elt x -100) 'd)) - (type-error () 'type-error) - (error (c) c)) + (setf (elt x -100) 'd))) type-error) (deftest elt-v-12 @@ -195,10 +184,7 @@ (make-array n :adjustable t))) (deftest elt-adj-array-1 - (handler-case - (elt (make-adj-array '(0)) 0) - (type-error () 'type-error) - (error (c) c)) + (classify-error (elt (make-adj-array '(0)) 0)) type-error) ;;; (deftest elt-adj-array-2 (elt (make-adj-array '(1)) 0) nil) ;; actually undefined @@ -246,19 +232,15 @@ (a b c e e)) (deftest elt-adj-array-10 - (handler-case + (classify-error (let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c)))) - (setf (elt x 4) 'd)) - (type-error () 'type-error) - (error (c) c)) + (setf (elt x 4) 'd))) type-error) (deftest elt-adj-array-11 - (handler-case + (classify-error (let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c)))) - (setf (elt x -100) 'd)) - (type-error () 'type-error) - (error (c) c)) + (setf (elt x -100) 'd))) type-error) (deftest elt-adj-array-12 @@ -284,10 +266,7 @@ :displaced-index-offset displacement)) (deftest elt-displaced-array-1 - (handler-case - (elt (make-displaced-array '(0) 100) 0) - (type-error () 'type-error) - (error (c) c)) + (classify-error (elt (make-displaced-array '(0) 100) 0)) type-error) (deftest elt-displaced-array-2 @@ -297,21 +276,3 @@ (deftest elt-displaced-array-3 (elt (make-displaced-array '(5) 100) 4) 104) - -#| -(deftest elt-displaced-array-4 - (handler-case - (make-displaced-array '(100) 100000) - (type-error () 'type-error) - (error (c) c)) - type-error) -|# - -#| -(deftest elt-displaced-array-5 - (handler-case - (make-displaced-array '(100) (- 100000 50)) - (type-error () 'type-error) - (error (c) c)) - type-error) -|# diff --git a/ansi-tests/fill.lsp b/ansi-tests/fill.lsp index ddaa43c459a8f6ef45d5be2d2b5238f14a8075c1..e3898dd1cf8559899098a99c33536184827b46ac 100644 --- a/ansi-tests/fill.lsp +++ b/ansi-tests/fill.lsp @@ -55,30 +55,22 @@ (deftest array-fill-7 (let* ((a (make-array '(5)))) - (handler-case (fill a 'x :start -1) - (type-error (c) 'type-error) - (error (c) c))) + (classify-error (fill a 'x :start -1))) type-error) (deftest array-fill-8 (let* ((a (make-array '(5)))) - (handler-case (fill a 'x :start 'a) - (type-error (c) 'type-error) - (error (c) c))) + (classify-error (fill a 'x :start 'a))) type-error) (deftest array-fill-9 (let* ((a (make-array '(5)))) - (handler-case (fill a 'x :end -1) - (type-error (c) 'type-error) - (error (c) c))) + (classify-error (fill a 'x :end -1))) type-error) (deftest array-fill-10 (let* ((a (make-array '(5)))) - (handler-case (fill a 'x :end 'a) - (type-error (c) 'type-error) - (error (c) c))) + (classify-error (fill a 'x :end 'a))) type-error) ;;; fill on arrays of fixnums @@ -127,30 +119,22 @@ (deftest array-fixnum-fill-7 (let* ((a (make-array '(5) :element-type 'fixnum))) - (handler-case (fill a 10 :start -1) - (type-error (c) 'type-error) - (error (c) c))) + (classify-error (fill a 10 :start -1))) type-error) (deftest array-fixnum-fill-8 (let* ((a (make-array '(5) :element-type 'fixnum))) - (handler-case (fill a 100 :start 'a) - (type-error (c) 'type-error) - (error (c) c))) + (classify-error (fill a 100 :start 'a))) type-error) (deftest array-fixnum-fill-9 (let* ((a (make-array '(5) :element-type 'fixnum))) - (handler-case (fill a -5 :end -1) - (type-error (c) 'type-error) - (error (c) c))) + (classify-error (fill a -5 :end -1))) type-error) (deftest array-fixnum-fill-10 (let* ((a (make-array '(5) :element-type 'fixnum))) - (handler-case (fill a 17 :end 'a) - (type-error (c) 'type-error) - (error (c) c))) + (classify-error (fill a 17 :end 'a))) type-error) ;;; fill on arrays of unsigned eight bit bytes @@ -187,27 +171,19 @@ t (0 0 0 0 0)) (deftest array-unsigned-byte8-fill-7 - (handler-case (array-unsigned-byte-fill-test-fn 8 0 :start -1) - (type-error (c) 'type-error) - (error (c) c)) + (classify-error (array-unsigned-byte-fill-test-fn 8 0 :start -1)) type-error) (deftest array-unsigned-byte8-fill-8 - (handler-case (array-unsigned-byte-fill-test-fn 8 100 :start 'a) - (type-error (c) 'type-error) - (error (c) c)) + (classify-error (array-unsigned-byte-fill-test-fn 8 100 :start 'a)) type-error) (deftest array-unsigned-byte8-fill-9 - (handler-case (array-unsigned-byte-fill-test-fn 8 19 :end -1) - (type-error (c) 'type-error) - (error (c) c)) + (classify-error (array-unsigned-byte-fill-test-fn 8 19 :end -1)) type-error) (deftest array-unsigned-byte8-fill-10 - (handler-case (array-unsigned-byte-fill-test-fn 8 17 :end 'a) - (type-error (c) 'type-error) - (error (c) c)) + (classify-error (array-unsigned-byte-fill-test-fn 8 17 :end 'a)) type-error) diff --git a/ansi-tests/find-if-not.lsp b/ansi-tests/find-if-not.lsp index eba61ed666939703644c4a4bfbc031f1f668534d..ea7fdf6f2b9bdc91c4b4a891c93df8dee4eff676 100644 --- a/ansi-tests/find-if-not.lsp +++ b/ansi-tests/find-if-not.lsp @@ -487,29 +487,17 @@ ;;; Error tests (deftest find-if-not-error.1 - (handler-case (find-if-not #'null 'b) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (find-if-not #'null 'b)) + type-error) (deftest find-if-not-error.2 - (handler-case (find-if-not #'identity 10) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (find-if-not #'identity 10)) + type-error) (deftest find-if-not-error.3 - (handler-case (find-if-not '1+ 1.4) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (find-if-not '1+ 1.4)) + type-error) (deftest find-if-not-error.4 - (locally (declare (optimize (safety 3))) - (handler-case (find-if-not 'identity '(a b c . d)) - (type-error () :type-error))) - :type-error) - - - - + (classify-error (find-if-not 'identity '(a b c . d))) + type-error) diff --git a/ansi-tests/find-if.lsp b/ansi-tests/find-if.lsp index 1fd54a17caeaabe9d1e8aac93970bec85bb1041d..ec0eb413d41754f9855f102fae75ec199578ff97 100644 --- a/ansi-tests/find-if.lsp +++ b/ansi-tests/find-if.lsp @@ -487,27 +487,17 @@ ;;; Error tests (deftest find-if-error.1 - (handler-case (find-if #'null 'b) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (find-if #'null 'b)) + type-error) (deftest find-if-error.2 - (handler-case (find-if #'identity 10) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (find-if #'identity 10)) + type-error) (deftest find-if-error.3 - (handler-case (find-if '1+ 1.4) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (find-if '1+ 1.4)) + type-error) (deftest find-if-error.4 - (locally (declare (optimize (safety 3))) - (handler-case (find-if 'null '(a b c . d)) - (type-error () :type-error))) - :type-error) - - + (classify-error (find-if 'null '(a b c . d))) + type-error) diff --git a/ansi-tests/find.lsp b/ansi-tests/find.lsp index bf1b615c5e8b6288ab61afac289ccd18110dd84a..90070e173d84ba961dde4dc4b6cac374c20fbd74 100644 --- a/ansi-tests/find.lsp +++ b/ansi-tests/find.lsp @@ -701,26 +701,18 @@ ;;; Error tests (deftest find-error.1 - (handler-case (find 'a 'b) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (find 'a 'b)) + type-error) (deftest find-error.2 - (handler-case (find 'a 10) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (find 'a 10)) + type-error) (deftest find-error.3 - (handler-case (find 'a 1.4) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (find 'a 1.4)) + type-error) (deftest find-error.4 - (locally (declare (optimize (safety 3))) - (handler-case (find 'e '(a b c . d)) - (type-error () :type-error) - (error (c) c))) - :type-error) + (classify-error (find 'e '(a b c . d))) + type-error) + diff --git a/ansi-tests/iteration.lsp b/ansi-tests/iteration.lsp index 9e13fb98f0f46df843a20666c52ca6cd278865ae..6b21b88d36b0e8bdf10c6c99d8dab26b6c0f1630 100644 --- a/ansi-tests/iteration.lsp +++ b/ansi-tests/iteration.lsp @@ -48,3 +48,48 @@ (when (> i 10) (return i))) 11) +;;; Zero iterations +(deftest do.6 + (do ((i 0 (+ i 10))) + ((> i -1) i) + (return 'bad)) + 0) + +;;; Tests of go tags +(deftest do.7 + (let ((x nil)) + (do ((i 0 (1+ i))) + ((>= i 10) x) + (go around) + small + (push 'a x) + (go done) + big + (push 'b x) + (go done) + around + (if (> i 4) (go big) (go small)) + done)) + (b b b b b a a a a a)) + +;;; No increment form +(deftest do.8 + (do ((i 0 (1+ i)) + (x nil)) + ((>= i 10) x) + (push 'a x)) + (a a a a a a a a a a)) + +;;; No do locals +(deftest do.9 + (let ((i 0)) + (do () + ((>= i 10) i) + (incf i))) + 10) + + + + + + diff --git a/ansi-tests/let.lsp b/ansi-tests/let.lsp index a8166ee425c6b859371a1908459029b33228d754..b6fe7a2af98a5389c02974beccc8f89ffb55c8aa 100644 --- a/ansi-tests/let.lsp +++ b/ansi-tests/let.lsp @@ -87,6 +87,20 @@ ;;; x)) ;;; 11) +;;; Tests of large number of LET variables +(deftest let.14 + (let* ((n 1000) + (vars (mapcar #'gensym (make-list n :initial-element "G"))) + (expr `(let ,(let ((i 0)) + (mapcar #'(lambda (v) (list v (incf i))) vars)) + ,(let ((sumexpr 0)) + (dolist (v vars) + (setq sumexpr `(+ ,v ,sumexpr))) + sumexpr))) + (val (eval expr))) + (or (eqlt val (/ (* n (1+ n)) 2)) (list val))) + t) + ;;; Tests for LET* (deftest let*.1 @@ -162,3 +176,17 @@ ;;; (declare (special x)) ;;; x)) ;;; 2) + +;;; Tests of large number of LET* variables +(deftest let*.14 + (let* ((n 1000) + (vars (mapcar #'gensym (make-list n :initial-element "G"))) + (expr `(let* ,(let ((i 0)) + (mapcar #'(lambda (v) (list v (incf i))) vars)) + ,(let ((sumexpr 0)) + (dolist (v vars) + (setq sumexpr `(+ ,v ,sumexpr))) + sumexpr))) + (val (eval expr))) + (or (eqlt val (/ (* n (1+ n)) 2)) (list val))) + t) diff --git a/ansi-tests/make-sequence.lsp b/ansi-tests/make-sequence.lsp index fff9751679ca91c9ad01a5006229c5da12c100ee..938bb592c6fe2606345f9afa3b5ca69d9c3eaafc 100644 --- a/ansi-tests/make-sequence.lsp +++ b/ansi-tests/make-sequence.lsp @@ -168,36 +168,29 @@ ;;; Tests for errors (deftest make-sequence-error.1 - (handler-case (make-sequence 'symbol 10) - (type-error () :caught)) - :caught) + (classify-error (make-sequence 'symbol 10)) + type-error) (deftest make-sequence-error.2 - (handler-case (make-sequence 'null 1) - (type-error () :caught)) - :caught) + (classify-error (make-sequence 'null 1)) + type-error) (deftest make-sequence-error.3 - (handler-case (make-sequence '(vector * 4) 3) - (type-error () :caught)) - :caught) + (classify-error (make-sequence '(vector * 4) 3)) + type-error) (deftest make-sequence-error.4 - (handler-case (make-sequence '(vector * 2) 3) - (type-error () :caught)) - :caught) + (classify-error (make-sequence '(vector * 2) 3)) + type-error) (deftest make-sequence-error.5 - (handler-case (make-sequence '(string 4) 3) - (type-error () :caught)) - :caught) + (classify-error (make-sequence '(string 4) 3)) + type-error) (deftest make-sequence-error.6 - (handler-case (make-sequence '(simple-string 2) 3) - (type-error () :caught)) - :caught) + (classify-error (make-sequence '(simple-string 2) 3)) + type-error) (deftest make-sequence-error.7 - (handler-case (make-sequence 'cons 0) - (type-error () :caught)) - :caught) + (classify-error (make-sequence 'cons 0)) + type-error) diff --git a/ansi-tests/map-into.lsp b/ansi-tests/map-into.lsp index 4a5a634f64d8dc845c6add7026147b69faa53f69..1174f561e717e6482dddffad8f4e37e437cad306 100644 --- a/ansi-tests/map-into.lsp +++ b/ansi-tests/map-into.lsp @@ -157,24 +157,13 @@ "1234") (deftest map-into-error.1 - (handler-case (map-into 'a #'(lambda () nil)) - (type-error (c) 'type-error) - (error (c) c)) + (classify-error (map-into 'a #'(lambda () nil))) type-error) (deftest map-into-error.2 - (handler-case (map-into nil #'identity 'a) - (type-error (c) 'type-error) - (error (c) c)) + (classify-error (map-into nil #'identity 'a)) type-error) (deftest map-into-error.3 - (handler-case (map-into (copy-seq '(a b c)) #'cons '(d e f) 100) - (type-error (c) 'type-error) - (error (c) c)) + (classify-error (map-into (copy-seq '(a b c)) #'cons '(d e f) 100)) type-error) - - - - - diff --git a/ansi-tests/map.lsp b/ansi-tests/map.lsp index 65082afeb32debff96c593000d0ee11007ef3fce..b941a70640fb7259549428c2b3d6a2fe07d3fa92 100644 --- a/ansi-tests/map.lsp +++ b/ansi-tests/map.lsp @@ -169,17 +169,9 @@ :caught) (deftest map-error.2 - (handler-case (map '(vector * 8) #'identity '(a b c)) - (type-error () :caught)) - :caught) + (classify-error (map '(vector * 8) #'identity '(a b c))) + type-error) (deftest map-error.3 - (handler-case (map 'list #'identity '(a b . c)) - (type-error () :caught)) - :caught) - - - - - - + (classify-error (map 'list #'identity '(a b . c))) + type-error) diff --git a/ansi-tests/merge.lsp b/ansi-tests/merge.lsp index dacd27035b2d6b4ace2cbf7e6d842259652084f6..ee7d21b9516a226d81d87f0af9fccbf61d36cbce 100644 --- a/ansi-tests/merge.lsp +++ b/ansi-tests/merge.lsp @@ -414,29 +414,24 @@ :caught) (deftest merge-error.2 - (handler-case (merge '(vector * 3) (list 1 2 3) (list 4 5 6) #'<) - (type-error () :caught)) - :caught) + (classify-error (merge '(vector * 3) (list 1 2 3) (list 4 5 6) #'<)) + type-error) (deftest merge-error.3 - (handler-case (merge '(bit-vector 3) (list 0 0 0) (list 1 1 1) #'<) - (type-error () :caught)) - :caught) + (classify-error (merge '(bit-vector 3) (list 0 0 0) (list 1 1 1) #'<)) + type-error) (deftest merge-error.4 - (handler-case (merge '(vector * 7) (list 1 2 3) (list 4 5 6) #'<) - (type-error () :caught)) - :caught) + (classify-error (merge '(vector * 7) (list 1 2 3) (list 4 5 6) #'<)) + type-error) (deftest merge-error.5 - (handler-case (merge '(bit-vector 7) (list 0 0 0) (list 1 1 1) #'<) - (type-error () :caught)) - :caught) + (classify-error (merge '(bit-vector 7) (list 0 0 0) (list 1 1 1) #'<)) + type-error) (deftest merge-error.6 - (handler-case (merge 'null (list 1 2 3) (list 4 5 6) #'<) - (type-error () :caught)) - :caught) + (classify-error (merge 'null (list 1 2 3) (list 4 5 6) #'<)) + type-error) diff --git a/ansi-tests/position-if-not.lsp b/ansi-tests/position-if-not.lsp index 9b24fcbca1b71ca65f8776a76d5103d677b24779..1d0aa132bb0db27485de5aa09c73deb3dee7168e 100644 --- a/ansi-tests/position-if-not.lsp +++ b/ansi-tests/position-if-not.lsp @@ -414,26 +414,18 @@ ;;; Error tests (deftest position-if-not-error.1 - (handler-case (position-if-not #'identity 'b) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (position-if-not #'identity 'b)) + type-error) (deftest position-if-not-error.2 - (handler-case (position-if-not #'identity 10) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (position-if-not #'identity 10)) + type-error) (deftest position-if-not-error.3 - (handler-case (position-if-not 'null 1.4) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (position-if-not 'null 1.4)) + type-error) (deftest position-if-not-error.4 - (locally (declare (optimize (safety 3))) - (handler-case (position-if-not 'identity '(a b c . d)) - (type-error () :type-error) - (error (c) c))) - :type-error) + (classify-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 f3eafbc3ab8e844b005de57e88693c9a4f6cd592..6eebde87edc9a15dd46f3b2f00870b827a1ba0f6 100644 --- a/ansi-tests/position-if.lsp +++ b/ansi-tests/position-if.lsp @@ -414,26 +414,17 @@ ;;; Error tests (deftest position-if-error.1 - (handler-case (position-if #'identity 'b) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (position-if #'identity 'b)) + type-error) (deftest position-if-error.2 - (handler-case (position-if #'identity 10) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (position-if #'identity 10)) + type-error) (deftest position-if-error.3 - (handler-case (position-if 'null 1.4) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (position-if 'null 1.4)) + type-error) (deftest position-if-error.4 - (locally (declare (optimize (safety 3))) - (handler-case (position-if 'null '(a b c . d)) - (type-error () :type-error) - (error (c) c))) - :type-error) + (classify-error (position-if 'null '(a b c . d))) + type-error) diff --git a/ansi-tests/position.lsp b/ansi-tests/position.lsp index 623e288375f9cc467a24a42b6d6d86d3119e5cb0..858e720edaf643b1c9257cb97648f8fc96101697 100644 --- a/ansi-tests/position.lsp +++ b/ansi-tests/position.lsp @@ -567,29 +567,21 @@ ;;; Error tests (deftest position-error.1 - (handler-case (position 'a 'b) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (position 'a 'b)) + type-error) (deftest position-error.2 - (handler-case (position 'a 10) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (position 'a 10)) + type-error) (deftest position-error.3 - (handler-case (position 'a 1.4) - (type-error () :type-error) - (error (c) c)) - :type-error) + (classify-error (position 'a 1.4)) + type-error) (deftest position-error.4 - (locally (declare (optimize (safety 3))) - (handler-case (position 'e '(a b c . d)) - (type-error () :type-error) - (error (c) c))) - :type-error) + (classify-error (position 'e '(a b c . d))) + type-error) + diff --git a/ansi-tests/reduce.lsp b/ansi-tests/reduce.lsp index 043b8a026c98d7da9d11514edad7c89c3c16af2d..0b66a1bee4ee01c8d4ebce78b94651bd93614e70 100644 --- a/ansi-tests/reduce.lsp +++ b/ansi-tests/reduce.lsp @@ -132,9 +132,7 @@ ;;;;;;;; (deftest reduce-error.1 - (handler-case (reduce 'cons 'a) - (type-error (c) 'type-error) - (error (c) c)) + (classify-error (reduce 'cons 'a)) type-error) ;;;;;;;; diff --git a/ansi-tests/types-and-class.lsp b/ansi-tests/types-and-class.lsp index d18d8f50cecb28b627da146ad2d2c04c1694b8c1..f7105eb996c9277146d4677aacfd755f5adc270c 100644 --- a/ansi-tests/types-and-class.lsp +++ b/ansi-tests/types-and-class.lsp @@ -11,15 +11,11 @@ (declaim (optimize (safety 3))) (deftest boolean-type-1 - (handler-case - (not (not (typep nil 'boolean))) - (error (c) c)) + (notnot (typep nil 'boolean)) t) (deftest boolean-type-2 - (handler-case - (not (not (typep t 'boolean))) - (error (c) c)) + (notnot (typep t 'boolean)) t) (defun is-t-or-nil (e)