diff --git a/ansi-tests/adjustable-array-p.lsp b/ansi-tests/adjustable-array-p.lsp index dfc318593f09b68bdf1ad9bd7e7282e1b25edb9d..c881f66b7c401fa563ec101629d6f433414ea2af 100644 --- a/ansi-tests/adjustable-array-p.lsp +++ b/ansi-tests/adjustable-array-p.lsp @@ -48,3 +48,13 @@ `(adjustable-array-p ',e))))) collect (list e why))) nil) + +(deftest adjustable-array-p.error.5 + (classify-error (locally (adjustable-array-p 10))) + type-error) + +(deftest adjustable-array-p.error.6 + (classify-error (let ((x 10)) + (locally (declare (optimize (safety 3))) + (adjustable-array-p x)))) + type-error) diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index eaf3d1e0c0042ba6236eece1671e54abd922bb98..a77a4023b359304676ff3f6628447b505a057063 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -219,8 +219,8 @@ the condition to go uncaught if it cannot be classified." (defun classify-error** (form) (handler-bind ((warning #'(lambda (c) (declare (ignore c)) (muffle-warning)))) - (classify-error* - (eval `(locally (declare (optimize (safety 3))) ,form)) + (proclaim '(optimize (safety 3))) + (classify-error* (eval form) ))) (defmacro classify-error (form) diff --git a/ansi-tests/array-dimensions.lsp b/ansi-tests/array-dimensions.lsp index 73ceddaa92af454c7110ef79092d3863e4d9e05b..5cdeb558a2735684758863886dadf77017aaacd7 100644 --- a/ansi-tests/array-dimensions.lsp +++ b/ansi-tests/array-dimensions.lsp @@ -58,3 +58,12 @@ `(array-dimensions ',e))))) collect (list e why))) nil) + +(deftest array-dimensions.error.4 + (classify-error (array-dimensions nil)) + type-error) + +(deftest array-dimensions.error.5 + (classify-error (locally (array-dimensions nil))) + type-error) + diff --git a/ansi-tests/array-displacement.lsp b/ansi-tests/array-displacement.lsp index b70f4d7d9dc24c912a64cec75829fc9e089752b8..42ce61c57bf8fc3748eab9da76ab476182297ee2 100644 --- a/ansi-tests/array-displacement.lsp +++ b/ansi-tests/array-displacement.lsp @@ -113,3 +113,12 @@ `(array-displacement ',e))))) collect (list e why))) nil) + +(deftest array-displacement.error.4 + (classify-error (array-displacement nil)) + type-error) + +(deftest array-displacement.error.5 + (classify-error (let ((x nil)) (array-displacement x))) + type-error) + diff --git a/ansi-tests/array-rank.lsp b/ansi-tests/array-rank.lsp index 78af7b952d4271f2be6ff2c016950daded133406..1ca746e86a724b2054ce6af564e211aedad8acce 100644 --- a/ansi-tests/array-rank.lsp +++ b/ansi-tests/array-rank.lsp @@ -35,3 +35,11 @@ 'type-error))) collect e) nil) + +(deftest array-rank.error.4 + (classify-error (array-rank nil)) + type-error) + +(deftest array-rank.error.5 + (classify-error (locally (array-rank nil) t)) + type-error) diff --git a/ansi-tests/array-total-size.lsp b/ansi-tests/array-total-size.lsp index cf55b392f24552e71a9098cbba9a82c35e7c9fa4..0f13681b0246656dc1eed2ebdaf68beb4ac963e7 100644 --- a/ansi-tests/array-total-size.lsp +++ b/ansi-tests/array-total-size.lsp @@ -50,3 +50,7 @@ (deftest array-total-size.error.4 (classify-error (array-total-size 0)) type-error) + +(deftest array-total-size.error.5 + (classify-error (locally (array-total-size 0) t)) + type-error) diff --git a/ansi-tests/boundp.lsp b/ansi-tests/boundp.lsp index 372710ec5a2a1184b6f898f1eebddd850a84bb0a..7a84dec98bf33a83f7a2e67e833bc1bd83e2dfdb 100644 --- a/ansi-tests/boundp.lsp +++ b/ansi-tests/boundp.lsp @@ -25,6 +25,10 @@ (classify-error (boundp "abc")) type-error) +(deftest boundp.error.6 + (classify-error (locally (boundp "abc") t)) + type-error) + ;;; See other tests in cl-symbols.lsp (deftest boundp.1 diff --git a/ansi-tests/cl-symbols.lsp b/ansi-tests/cl-symbols.lsp index 8cf321458d5669228984e997a65df3399a0d605d..692c5df9598f9510af2d664b8aedaf22817dcf52 100644 --- a/ansi-tests/cl-symbols.lsp +++ b/ansi-tests/cl-symbols.lsp @@ -1377,34 +1377,39 @@ ;;; gensym should be implemented so that its only ;;; argument defaults to "G", with NIL causing an error. -(deftest gensym-14 +(deftest gensym.error.1 (classify-error (gensym 'aaa)) type-error) -(deftest gensym-15 +(deftest gensym.error.2 (classify-error (gensym 12.3)) type-error) -(deftest gensym-16 +(deftest gensym.error.3 (classify-error (gensym t)) type-error) -(deftest gensym-17 +(deftest gensym.error.4 (classify-error (gensym nil)) type-error) ;; NIL /= no argument! -(deftest gensym-18 +(deftest gensym.error.5 (classify-error (gensym '(a))) type-error) -(deftest gensym-19 +(deftest gensym.error.6 (classify-error (gensym #\x)) type-error) -(deftest gensym-20 +(deftest gensym.error.7 (classify-error (gensym 10 'foo)) program-error) +(deftest gensym.error.8 + (classify-error (locally (gensym t) t)) + type-error) + + ;;;;;;;;;;;;;;;;;;;; ;;; Tests of CL package constraints from section 11.1.2.1.1 diff --git a/ansi-tests/coerce.lsp b/ansi-tests/coerce.lsp index 8531cb839c57675d606a4d0b4589b4b176e95ff3..3fbe5db8792c1c1e594d03e23a4cdbaadb92bb14 100644 --- a/ansi-tests/coerce.lsp +++ b/ansi-tests/coerce.lsp @@ -164,3 +164,7 @@ (deftest coerce.error.8 (classify-error (coerce 'x t 'foo)) program-error) + +(deftest coerce.error.9 + (classify-error (locally (coerce nil 'cons) t)) + type-error) diff --git a/ansi-tests/concatenate.lsp b/ansi-tests/concatenate.lsp index 9c08f50ce51a352292cc3b66056394cda0ae4df1..1f8a36a1f5a4aa26af1c68b779cd055cf0ae6cda 100644 --- a/ansi-tests/concatenate.lsp +++ b/ansi-tests/concatenate.lsp @@ -188,13 +188,16 @@ (deftest concatenate-error.1 (handler-case - (concatenate 'sequence '(a b c)) + (progn (proclaim '(optimize (safety 3))) + (eval '(concatenate 'sequence '(a b c)))) (error () :caught)) :caught) (deftest concatenate-error.2 - (handler-case (concatenate 'fixnum '(a b c d e)) - (error () :caught)) + (handler-case + (progn (proclaim '(optimize (safety 3))) + (concatenate 'fixnum '(a b c d e))) + (error () :caught)) :caught) (deftest concatenate-error.3 @@ -204,3 +207,7 @@ (deftest concatenate-error.4 (classify-error (concatenate)) program-error) + +(deftest concatenate-error.5 + (classify-error (locally (concatenate '(vector * 3) '(a b c d e)) t)) + type-error) diff --git a/ansi-tests/cons-test-01.lsp b/ansi-tests/cons-test-01.lsp index 151099a306afa9509bac3c31a69e04da9884abe7..98d6e5259c83bd7230775c9943c631c1e3d33276 100644 --- a/ansi-tests/cons-test-01.lsp +++ b/ansi-tests/cons-test-01.lsp @@ -388,6 +388,14 @@ (classify-error (rplaca (cons 'a 'b) (cons 'c 'd) 'garbage)) program-error) +(deftest rplaca.error.5 + (classify-error (rplaca 'a 1)) + type-error) + +(deftest rplaca.error.6 + (classify-error (locally (rplaca 'a 1) t)) + type-error) + ;; rplacd on a fixnum is a type error (deftest rplacd.error.1 (loop for x in *universe* @@ -407,3 +415,10 @@ (classify-error (rplacd (cons 'a 'b) (cons 'c 'd) 'garbage)) program-error) +(deftest rplacd.error.5 + (classify-error (rplacd 'a 1)) + type-error) + +(deftest rplacd.error.6 + (classify-error (locally (rplacd 'a 1) t)) + type-error) diff --git a/ansi-tests/cons-test-03.lsp b/ansi-tests/cons-test-03.lsp index 3d7ba6104b0cc76bc7764cb5fd8627dfa29c450b..e610e35b5c2c9f85740bda2e0bcb054176e3e35c 100644 --- a/ansi-tests/cons-test-03.lsp +++ b/ansi-tests/cons-test-03.lsp @@ -101,6 +101,14 @@ (classify-error (list-length nil nil)) program-error) +(deftest list-length.error.4 + (classify-error (list-length 'a)) + type-error) + +(deftest list-length.error.5 + (classify-error (locally (list-length 'a) t)) + type-error) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; listp @@ -213,13 +221,11 @@ (make-list 5 :initial-element 'a :initial-element 'b) (a a a a a)) -(deftest make-list-type.error.1 +(deftest make-list.error.1 (catch-type-error (make-list -1)) type-error) -;; This next test causes ACL 4.3 (Linux) to loop -#-allegro -(deftest make-list-type.error.2 +(deftest make-list.error.2 (classify-error (make-list 'a)) type-error) @@ -242,3 +248,7 @@ (deftest make-list.error.7 (classify-error (make-list 5 :bad t :allow-other-keys nil)) program-error) + +(deftest make-list.error.8 + (classify-error (locally (make-list 'a) t)) + type-error) diff --git a/ansi-tests/cons-test-06.lsp b/ansi-tests/cons-test-06.lsp index 6c83a12f84597aeb792cdae10f4d475ae8a32778..c0f067e76e760e0d4fe2a5eb41f33d50a1f9c37c 100644 --- a/ansi-tests/cons-test-06.lsp +++ b/ansi-tests/cons-test-06.lsp @@ -42,3 +42,7 @@ (deftest endp.error.5 (classify-error (endp nil nil)) program-error) + +(deftest endp.error.6 + (catch-type-error (locally (endp 1))) + type-error) diff --git a/ansi-tests/cons-test-08.lsp b/ansi-tests/cons-test-08.lsp index 14f7bc09c87880926b1110bbfc621a2383370ade..9c10446c13364def30ad9962928042ab9b56beb8 100644 --- a/ansi-tests/cons-test-08.lsp +++ b/ansi-tests/cons-test-08.lsp @@ -23,6 +23,10 @@ (classify-error (car 'a)) type-error) +(deftest car-symbol-error.2 + (classify-error (locally (car 'a) t)) + type-error) + (deftest cdr-1 (cdr '(a b)) (b)) @@ -35,6 +39,10 @@ (classify-error (cdr 'a)) type-error) +(deftest cdr-symbol-error.2 + (classify-error (locally (cdr 'a) t)) + type-error) + (deftest list-length-4 (list-length (copy-tree '(a b c))) 3) @@ -434,3 +442,5 @@ (deftest cddddr.error.4 (classify-error (cddddr '(a c e . b))) type-error) + +;;; Need to add 'locally' wrapped forms of these diff --git a/ansi-tests/cons-test-09.lsp b/ansi-tests/cons-test-09.lsp index b3647bc547c2139c55f5239150b43d37d5b2eca3..58c01012fe51c5ba79e0bf48e0f9a4438eac8d37 100644 --- a/ansi-tests/cons-test-09.lsp +++ b/ansi-tests/cons-test-09.lsp @@ -47,91 +47,96 @@ nil) (deftest butlast-5 - (catch-type-error (butlast (copy-tree '(a b c . d)) 1)) + (butlast (copy-tree '(a b c . d)) 1) (a b)) -(deftest butlast-6 - (catch-type-error (butlast (copy-tree '(a b c d)) 'a)) +(deftest butlast.error.1 + (classify-error (butlast (copy-tree '(a b c d)) 'a)) type-error) -(deftest butlast-7 - (catch-type-error (butlast 'a 0)) +(deftest butlast.error.2 + (classify-error (butlast 'a 0)) type-error) -(deftest butlast-8 +(deftest butlast.error.3 (classify-error (butlast)) program-error) -(deftest butlast-9 +(deftest butlast.error.4 (classify-error (butlast '(a b c) 3 3)) program-error) +(deftest butlast.error.5 + (classify-error (locally (butlast 'a 0) t)) + type-error) + + +;;; Tests of NBUTLAST + (deftest nbutlast-1 - (let ((x (list 'a 'b 'c 'd 'e))) - (let ((y (cdr x)) - (z (cddr x))) - (let ((result (nbutlast x 2))) - (and (eqt x result) - (eqt (cdr x) y) - (eqt (cddr x) z) - result)))) + (let ((x (list 'a 'b 'c 'd 'e))) + (let ((y (cdr x)) + (z (cddr x))) + (let ((result (nbutlast x 2))) + (and (eqt x result) + (eqt (cdr x) y) + (eqt (cddr x) z) + result)))) (a b c)) (deftest nbutlast-2 - (let ((x (list 'a 'b 'c 'd 'e))) - (let ((result (nbutlast x 5))) - (list x result))) + (let ((x (list 'a 'b 'c 'd 'e))) + (let ((result (nbutlast x 5))) + (list x result))) ((a b c d e) nil)) (deftest nbutlast-3 - (let ((x (list 'a 'b 'c 'd 'e))) - (let ((result (nbutlast x 500))) - (list x result))) + (let ((x (list 'a 'b 'c 'd 'e))) + (let ((result (nbutlast x 500))) + (list x result))) ((a b c d e) nil)) (deftest nbutlast-4 - (let ((x (list* 'a 'b 'c 'd))) - (let ((result (catch-type-error (nbutlast x 1)))) - (and (eqt result x) - result))) + (let ((x (list* 'a 'b 'c 'd))) + (let ((result (nbutlast x 1))) + (and (eqt result x) + result))) (a b)) (deftest nbutlast-5 - (let ((x (list* 'a 'b 'c 'd))) - (let ((result (catch-type-error (nbutlast x 'a)))) - result)) + (classify-error (let ((x (list* 'a 'b 'c 'd))) (nbutlast x 'a))) type-error) (deftest nbutlast-6 - (catch-type-error (nbutlast 'a 10)) + (classify-error (nbutlast 'a 10)) type-error) (deftest nbutlast-7 - (catch-type-error (nbutlast 2 10)) + (classify-error (nbutlast 2 10)) type-error) (deftest nbutlast-8 - (catch-type-error (nbutlast #\w 10)) + (classify-error (nbutlast #\w 10)) type-error) (deftest nbutlast-9 - (catch-type-error (nbutlast (list 'a 'b 'c 'd) -3)) + (classify-error (nbutlast (list 'a 'b 'c 'd) -3)) type-error) (deftest nbutlast-10 - (nbutlast nil) + (nbutlast nil) nil) (deftest nbutlast-11 - (nbutlast (list 'a)) + (nbutlast (list 'a)) nil) (deftest nbutlast-12 - (catch-type-error (nbutlast (list 'a) 20.0)) + (classify-error (nbutlast (list 'a) 20.0)) type-error) (deftest nbutlast-13 - (catch-type-error (nbutlast (list 'a) -100.0)) + (classify-error (nbutlast (list 'a) -100.0)) type-error) (deftest nbutlast-14 @@ -141,3 +146,7 @@ (deftest nbutlast-15 (classify-error (nbutlast (list 'a 'b 'c) 3 3)) program-error) + +(deftest nbutlast-16 + (classify-error (locally (nbutlast 'a 10) t)) + type-error) diff --git a/ansi-tests/cons-test-10.lsp b/ansi-tests/cons-test-10.lsp index 46ee936e7316afb9148081f8c7690067d8af79be..e3caf27f2abf8f210f52c69e1e5f2d4622968726 100644 --- a/ansi-tests/cons-test-10.lsp +++ b/ansi-tests/cons-test-10.lsp @@ -50,30 +50,34 @@ (last (cons 'a 'b) 2) (a . b)) -(deftest last-11 - (catch-type-error (last (list 'a 'b 'c) -1)) +(deftest last.error.1 + (classify-error (last (list 'a 'b 'c) -1)) type-error) -(deftest last-12 - (catch-type-error (last (list 'a 'b 'c) 'a)) +(deftest last.error.2 + (classify-error (last (list 'a 'b 'c) 'a)) type-error) -(deftest last-13 - (catch-type-error (last (list 'a 'b 'c) 10.0)) +(deftest last.error.3 + (classify-error (last (list 'a 'b 'c) 10.0)) type-error) -(deftest last-14 - (catch-type-error (last (list 'a 'b 'c) -10.0)) +(deftest last.error.4 + (classify-error (last (list 'a 'b 'c) -10.0)) type-error) -(deftest last-15 - (catch-type-error (last (list 'a 'b 'c) #\w)) +(deftest last.error.5 + (classify-error (last (list 'a 'b 'c) #\w)) type-error) -(deftest last-16 +(deftest last.error.6 (classify-error (last)) program-error) -(deftest last-17 +(deftest last.error.7 (classify-error (last '(a b c) 2 nil)) program-error) + +(deftest last.error.8 + (classify-error (locally (last (list 'a 'b 'c) 'a) t)) + type-error) diff --git a/ansi-tests/cons-test-11.lsp b/ansi-tests/cons-test-11.lsp index b9d6751a7c51b9567ffacaae69f19c5d6dd74266..6cfea20c1f6f7d761d33b4d4a7f755e05cb8b69d 100644 --- a/ansi-tests/cons-test-11.lsp +++ b/ansi-tests/cons-test-11.lsp @@ -35,7 +35,7 @@ (deftest ldiff-3 (let* ((x (copy-tree '(a b c d e . f))) (xcopy (make-scaffold-copy x))) - (let ((result (catch-type-error (ldiff x 'a)))) + (let ((result (ldiff x 'a))) (and (check-scaffold-copy x xcopy) result))) @@ -46,7 +46,7 @@ (let* ((n 18) (x (list* 'a 'b 'c 18)) (xcopy (make-scaffold-copy x))) - (let ((result (catch-type-error (ldiff x n)))) + (let ((result (ldiff x n))) (and (check-scaffold-copy x xcopy) result))) @@ -58,7 +58,7 @@ (let* ((n 18000000000000) (x (list* 'a 'b 'c (1- 18000000000001))) (xcopy (make-scaffold-copy x))) - (let ((result (catch-type-error (ldiff x n)))) + (let ((result (ldiff x n))) (and (check-scaffold-copy x xcopy) result))) @@ -69,7 +69,7 @@ (let* ((n (copy-seq "abcde")) (x (list* 'a 'b 'c n)) (xcopy (make-scaffold-copy x))) - (let ((result (catch-type-error (ldiff x n)))) + (let ((result (ldiff x n))) (if (equal result (list 'a 'b 'c)) (check-scaffold-copy x xcopy) result))) @@ -81,7 +81,7 @@ (let* ((n (copy-seq "abcde")) (x (list* 'a 'b 'c n)) (xcopy (make-scaffold-copy x))) - (let ((result (catch-type-error (ldiff x (copy-seq n))))) + (let ((result (ldiff x (copy-seq n)))) (if (equal result x) (check-scaffold-copy x xcopy) result))) @@ -104,25 +104,25 @@ ;; Error checking (deftest ldiff.error.1 - (catch-type-error (ldiff 10 'a)) + (classify-error (ldiff 10 'a)) type-error) ;; Single atoms are not dotted lists, so the next ;; case should be a type-error (deftest ldiff.error.2 - (catch-type-error (ldiff 'a 'a)) + (classify-error (ldiff 'a 'a)) type-error) (deftest ldiff.error.3 - (catch-type-error (ldiff (make-array '(10) :initial-element 'a) '(a))) + (classify-error (ldiff (make-array '(10) :initial-element 'a) '(a))) type-error) (deftest ldiff.error.4 - (catch-type-error (ldiff 1.23 t)) + (classify-error (ldiff 1.23 t)) type-error) (deftest ldiff.error.5 - (catch-type-error (ldiff #\w 'a)) + (classify-error (ldiff #\w 'a)) type-error) (deftest ldiff.error.6 @@ -177,22 +177,21 @@ ;; The next four tests test that tailp handles dotted lists. See ;; TAILP-NIL:T in the X3J13 documentation. -(deftest tailp.error.1 - (catch-type-error (notnot-mv (tailp 'e (copy-tree '(a b c d . e))))) +(deftest tailp-2 + (notnot-mv (tailp 'e (copy-tree '(a b c d . e)))) t) -(deftest tailp.error.2 - (catch-type-error (tailp 'z (copy-tree '(a b c d . e)))) +(deftest tailp-3 + (tailp 'z (copy-tree '(a b c d . e))) nil) -(deftest tailp.error.3 - (catch-type-error (notnot-mv (tailp 10203040506070 - (list* 'a 'b (1- 10203040506071))))) +(deftest tailp-4 + (notnot-mv (tailp 10203040506070 + (list* 'a 'b (1- 10203040506071)))) t) -(deftest tailp.error.4 - (let ((x "abcde")) - (catch-type-error (tailp x (list* 'a 'b (copy-seq x))))) +(deftest tailp-5 + (let ((x "abcde")) (tailp x (list* 'a 'b (copy-seq x)))) nil) (deftest tailp.error.5 diff --git a/ansi-tests/cons-test-12.lsp b/ansi-tests/cons-test-12.lsp index 4f8cc4e049d1d31f58eb9cb524aa9d636f1563bd..186572d6881b5d1fea353154e14c3e403582f142 100644 --- a/ansi-tests/cons-test-12.lsp +++ b/ansi-tests/cons-test-12.lsp @@ -11,27 +11,27 @@ ;;; nthcdr (deftest nthcdr.error.1 - (catch-type-error (nthcdr nil (copy-tree '(a b c d)))) + (classify-error (nthcdr nil (copy-tree '(a b c d)))) type-error) (deftest nthcdr.error.2 - (catch-type-error (nthcdr 'a (copy-tree '(a b c d)))) + (classify-error (nthcdr 'a (copy-tree '(a b c d)))) type-error) (deftest nthcdr.error.3 - (catch-type-error (nthcdr 0.1 (copy-tree '(a b c d)))) + (classify-error (nthcdr 0.1 (copy-tree '(a b c d)))) type-error) (deftest nthcdr.error.4 - (catch-type-error (nthcdr #\A (copy-tree '(a b c d)))) + (classify-error (nthcdr #\A (copy-tree '(a b c d)))) type-error) (deftest nthcdr.error.5 - (catch-type-error (nthcdr '(a) (copy-tree '(a b c d)))) + (classify-error (nthcdr '(a) (copy-tree '(a b c d)))) type-error) (deftest nthcdr.error.6 - (catch-type-error (nthcdr -10 (copy-tree '(a b c d)))) + (classify-error (nthcdr -10 (copy-tree '(a b c d)))) type-error) (deftest nthcdr.error.7 @@ -47,27 +47,31 @@ program-error) (deftest nthcdr.error.10 - (catch-type-error (nthcdr 3 (cons 'a 'b))) + (classify-error (nthcdr 3 (cons 'a 'b))) + type-error) + +(deftest nthcdr.error.11 + (classify-error (locally (nthcdr 'a (copy-tree '(a b c d))) t)) type-error) (deftest nthcdr-7 - (nthcdr 0 (copy-tree '(a b c d . e))) + (nthcdr 0 (copy-tree '(a b c d . e))) (a b c d . e)) (deftest nthcdr-8 - (nthcdr 1 (copy-tree '(a b c d))) + (nthcdr 1 (copy-tree '(a b c d))) (b c d)) (deftest nthcdr-9 - (nthcdr 10 nil) + (nthcdr 10 nil) nil) (deftest nthcdr-10 - (nthcdr 4 (list 'a 'b 'c)) + (nthcdr 4 (list 'a 'b 'c)) nil) (deftest nthcdr-11 - (nthcdr 1 (cons 'a 'b)) + (nthcdr 1 (cons 'a 'b)) b) @@ -75,7 +79,7 @@ ;;; rest (deftest rest-1 - (rest (list 'a 'b 'c)) + (rest (list 'a 'b 'c)) (b c)) (deftest rest.error.1 diff --git a/ansi-tests/cons-test-13.lsp b/ansi-tests/cons-test-13.lsp index afe1a3366a4136f7fae8e31853922129406e98c0..384c8d963b4fbb73ff237442d260afb48b0c445e 100644 --- a/ansi-tests/cons-test-13.lsp +++ b/ansi-tests/cons-test-13.lsp @@ -172,31 +172,31 @@ ;;; Error cases (deftest member.error.1 - (catch-type-error (member 'a 'b)) + (classify-error (member 'a 'b)) type-error) (deftest member.error.2 - (catch-type-error (member 'a 1.3)) + (classify-error (member 'a 1.3)) type-error) (deftest member.error.3 - (catch-type-error (member 'a 1)) + (classify-error (member 'a 1)) type-error) (deftest member.error.4 - (catch-type-error (member 'a 0)) + (classify-error (member 'a 0)) type-error) (deftest member.error.5 - (catch-type-error (member 'a "abcde")) + (classify-error (member 'a "abcde")) type-error) (deftest member.error.6 - (catch-type-error (member 'a #\w)) + (classify-error (member 'a #\w)) type-error) (deftest member.error.7 - (catch-type-error (member 'a t)) + (classify-error (member 'a t)) type-error) (deftest member.error.8 @@ -222,3 +222,7 @@ (deftest member.error.13 (classify-error (member nil nil nil)) program-error) + +(deftest member.error.14 + (classify-error (locally (member 'a t) t)) + type-error) diff --git a/ansi-tests/cons-test-14.lsp b/ansi-tests/cons-test-14.lsp index 31b5a987bd98d0e551689fa549cd1d5f0ad89e04..15918e247e65169dc6e0d9ff17f24ea433f5dbc6 100644 --- a/ansi-tests/cons-test-14.lsp +++ b/ansi-tests/cons-test-14.lsp @@ -170,6 +170,11 @@ (classify-error (member-if #'null '(a b c) 1 2)) program-error) +(deftest member-if.error.8 + (classify-error (locally (member-if #'identity 'a) t)) + type-error) + + (deftest member-if-not.error.1 (classify-error (member-if-not #'identity 'a)) type-error) @@ -197,3 +202,7 @@ (deftest member-if-not.error.7 (classify-error (member-if-not #'null '(a b c) 1 2)) program-error) + +(deftest member-if-not.error.8 + (classify-error (locally (member-if-not #'identity 'a) t)) + type-error) diff --git a/ansi-tests/cons-test-15.lsp b/ansi-tests/cons-test-15.lsp index 32dc9d15abdb820457e0d084c4c7d147c764b13d..2708a982c7d93804d3ea1eb72743d4ef6de7e440 100644 --- a/ansi-tests/cons-test-15.lsp +++ b/ansi-tests/cons-test-15.lsp @@ -76,6 +76,10 @@ (classify-error (mapc #'append)) program-error) +(deftest mapc.error.4 + (classify-error (locally (mapc #'identity 1) t)) + type-error) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; mapcar @@ -151,6 +155,10 @@ (classify-error (mapcar #'append)) program-error) +(deftest mapcar.error.4 + (classify-error (locally (mapcar #'identity 1) t)) + type-error) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; mapcan @@ -229,6 +237,10 @@ (classify-error (mapcan #'append)) program-error) +(deftest mapcan.error.4 + (classify-error (locally (mapcan #'identity 1) t)) + type-error) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; mapl @@ -321,6 +333,10 @@ (classify-error (mapl #'append)) program-error) +(deftest mapl.error.4 + (classify-error (locally (mapl #'identity 1) t)) + type-error) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; maplist @@ -419,6 +435,9 @@ (classify-error (maplist #'append)) program-error) +(deftest maplist.error.7 + (classify-error (locally (maplist #'identity 'a) t)) + type-error) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; mapcan @@ -464,4 +483,9 @@ (classify-error (mapcon #'append)) program-error) +(deftest mapcon.error.4 + (classify-error (locally (mapcon #'identity 1) t)) + type-error) + + diff --git a/ansi-tests/copy-seq.lsp b/ansi-tests/copy-seq.lsp index 6c2d4fd9d8a393782658393a1195d0d86e5344bd..51b1afc5e9542e6ca738be9b26eaad1c98015773 100644 --- a/ansi-tests/copy-seq.lsp +++ b/ansi-tests/copy-seq.lsp @@ -175,3 +175,8 @@ (deftest copy-seq.error.5 (classify-error (copy-seq "abc" 2 nil)) program-error) + +(deftest copy-seq.error.6 + (classify-error (locally (copy-seq 10) t)) + type-error) + diff --git a/ansi-tests/count-if-not.lsp b/ansi-tests/count-if-not.lsp index 2459680909d0a69209b3964d2c3bd3d2ea30b217..94ec766a619845d687e5541a489e803b0e258b37 100644 --- a/ansi-tests/count-if-not.lsp +++ b/ansi-tests/count-if-not.lsp @@ -447,15 +447,15 @@ ;;; Error tests (deftest count-if-not.error.1 - (catch-type-error (count-if-not #'identity 1)) + (classify-error (count-if-not #'identity 1)) type-error) (deftest count-if-not.error.2 - (catch-type-error (count-if-not #'identity 'a)) + (classify-error (count-if-not #'identity 'a)) type-error) (deftest count-if-not.error.3 - (catch-type-error (count-if-not #'identity #\a)) + (classify-error (count-if-not #'identity #\a)) type-error) (deftest count-if-not.error.4 @@ -489,3 +489,6 @@ :allow-other-keys t)) program-error) +(deftest count-if-not.error.11 + (classify-error (locally (count-if-not #'identity 1) t)) + type-error) diff --git a/ansi-tests/count-if.lsp b/ansi-tests/count-if.lsp index 85a2f28a235254b27635bf4bf8f152d9e1f79603..a02f8ce491e2cab3e1595665c9bcf958aa7b810d 100644 --- a/ansi-tests/count-if.lsp +++ b/ansi-tests/count-if.lsp @@ -447,15 +447,15 @@ ;;; Error tests (deftest count-if.error.1 - (catch-type-error (count-if #'identity 1)) + (classify-error (count-if #'identity 1)) type-error) (deftest count-if.error.2 - (catch-type-error (count-if #'identity 'a)) + (classify-error (count-if #'identity 'a)) type-error) (deftest count-if.error.3 - (catch-type-error (count-if #'identity #\a)) + (classify-error (count-if #'identity #\a)) type-error) (deftest count-if.error.4 @@ -488,3 +488,7 @@ :allow-other-keys nil :allow-other-keys t)) program-error) + +(deftest count-if.error.11 + (classify-error (locally (count-if #'identity 1) t)) + type-error) diff --git a/ansi-tests/count.lsp b/ansi-tests/count.lsp index a60c1fd0311d2ca47a3888b8d6b8ca2ee8ce7bcd..2bcf4bfcc38a222c7a601ea44528270b88797f1b 100644 --- a/ansi-tests/count.lsp +++ b/ansi-tests/count.lsp @@ -515,15 +515,15 @@ ;;; Error tests (deftest count.error.1 - (catch-type-error (count 'a 1)) + (classify-error (count 'a 1)) type-error) (deftest count.error.2 - (catch-type-error (count 'a 'a)) + (classify-error (count 'a 'a)) type-error) (deftest count.error.3 - (catch-type-error (count 'a #\a)) + (classify-error (count 'a #\a)) type-error) (deftest count.error.4 @@ -556,3 +556,8 @@ :allow-other-keys nil :allow-other-keys t)) program-error) + +(deftest count.error.11 + (classify-error (locally (count 'a 1) t)) + type-error) + diff --git a/ansi-tests/elt.lsp b/ansi-tests/elt.lsp index 9a76c8df13a3736ebf900c9134a8b820585f5133..6e45e11513ebc43a7e7cdd5acb14dd3103a0e80f 100644 --- a/ansi-tests/elt.lsp +++ b/ansi-tests/elt.lsp @@ -17,6 +17,10 @@ (classify-error (elt nil -10)) type-error) +(deftest elt-1b + (classify-error (locally (elt nil 0) t)) + type-error) + (deftest elt-2 (classify-error (elt nil 1000000)) type-error) diff --git a/ansi-tests/every.lsp b/ansi-tests/every.lsp index 7f1f3bb566cd340a1881a88e36a5f71dc6be8c61..b990f26807d17265ece8d9c8c3598a37440ce7cf 100644 --- a/ansi-tests/every.lsp +++ b/ansi-tests/every.lsp @@ -115,3 +115,7 @@ (deftest every.error.9 (classify-error (every #'null)) program-error) + +(deftest every.error.10 + (classify-error (locally (every 1 '(a b c)) t)) + type-error) diff --git a/ansi-tests/fboundp.lsp b/ansi-tests/fboundp.lsp index b348dfd86b48d7e541cba0c7d61a10a385023b9a..da5b49c772eca0d0b1f197a120e534828c19ffd5 100644 --- a/ansi-tests/fboundp.lsp +++ b/ansi-tests/fboundp.lsp @@ -58,3 +58,7 @@ (deftest fboundp.error.5 (classify-error (fboundp 'cons nil)) program-error) + +(deftest fboundp.error.6 + (classify-error (locally (fboundp 1) t)) + type-error) diff --git a/ansi-tests/fdefinition.lsp b/ansi-tests/fdefinition.lsp index bdbf86adf1338fd26a0f16edddfdbc96d30f015f..c49663a7bd9adf424185322f7c5af245cb143a7b 100644 --- a/ansi-tests/fdefinition.lsp +++ b/ansi-tests/fdefinition.lsp @@ -27,6 +27,10 @@ (classify-error (fdefinition (list 'setf (gensym)))) undefined-function) +(deftest fdefinition.error.6 + (classify-error (locally (fdefinition 10) t)) + type-error) + ;;; Non-error cases (deftest fdefinition.1 diff --git a/ansi-tests/fill-pointer.lsp b/ansi-tests/fill-pointer.lsp index aa91c42f95eb21933f4d6fc8e7285953dea54b36..4bde4c2063c90bfc974a6eb4be00d0b4c349ce6c 100644 --- a/ansi-tests/fill-pointer.lsp +++ b/ansi-tests/fill-pointer.lsp @@ -56,3 +56,7 @@ 'type-error))) collect (list e why))) nil) + +(deftest fill-pointer.error.7 + (classify-error (locally (fill-pointer #2a((a b c)(d e f))) t)) + type-error) diff --git a/ansi-tests/fill.lsp b/ansi-tests/fill.lsp index 54e304569a181ef8af85ce98da4fee883e1838fe..6d84c2d2cc5f3740601343005785d7f80932b0fd 100644 --- a/ansi-tests/fill.lsp +++ b/ansi-tests/fill.lsp @@ -42,6 +42,10 @@ :allow-other-keys t)) program-error) +(deftest fill.error.11 + (classify-error (locally (fill 'a 'b) t)) + type-error) + ;;; Fill on arrays (deftest array-fill-1 diff --git a/ansi-tests/find-if-not.lsp b/ansi-tests/find-if-not.lsp index 8322503d095d4a17da599fc0283c830167ce4d58..2e3c2f54d7ee29adc6d81f5388f18d91ef2c309f 100644 --- a/ansi-tests/find-if-not.lsp +++ b/ansi-tests/find-if-not.lsp @@ -551,4 +551,8 @@ (deftest find-if-not.error.10 (classify-error (find-if-not #'null nil :key)) - program-error) \ No newline at end of file + program-error) + +(deftest find-if-not.error.11 + (classify-error (locally (find-if-not #'null 'b) t)) + type-error) diff --git a/ansi-tests/find-if.lsp b/ansi-tests/find-if.lsp index 6754f7b4ae83d9ebcc801db0c3727e82c465be1a..eb7dd4e48d021147d822da9e1783a770b25489c1 100644 --- a/ansi-tests/find-if.lsp +++ b/ansi-tests/find-if.lsp @@ -575,3 +575,7 @@ (deftest find-if.error.10 (classify-error (find-if #'null nil :key)) program-error) + +(deftest find-if.error.11 + (classify-error (locally (find-if #'null 'b) t)) + type-error) diff --git a/ansi-tests/find.lsp b/ansi-tests/find.lsp index 026cc3bfc70a9e568745789830e089d35271764a..ba2eecfac1bada805976ed33d810c282dac44053 100644 --- a/ansi-tests/find.lsp +++ b/ansi-tests/find.lsp @@ -811,3 +811,7 @@ (deftest find.error.10 (classify-error (find 'a nil :key)) program-error) + +(deftest find.error.11 + (classify-error (locally (find 'a 'b) t)) + type-error) diff --git a/ansi-tests/fmakunbound.lsp b/ansi-tests/fmakunbound.lsp index e3b56048bc97535db56b6e503b3b276cc47ea3d7..f6c44f5504496e553a9629059a38a5548cb76a57 100644 --- a/ansi-tests/fmakunbound.lsp +++ b/ansi-tests/fmakunbound.lsp @@ -43,15 +43,15 @@ t nil) (deftest fmakunbound.error.1 - (catch-type-error (fmakunbound 1)) + (classify-error (fmakunbound 1)) type-error) (deftest fmakunbound.error.2 - (catch-type-error (fmakunbound #\a)) + (classify-error (fmakunbound #\a)) type-error) (deftest fmakunbound.error.3 - (catch-type-error (fmakunbound '(x))) + (classify-error (fmakunbound '(x))) type-error) (deftest fmakunbound.error.4 @@ -62,3 +62,6 @@ (classify-error (fmakunbound (gensym) nil)) program-error) +(deftest fmakunbound.error.6 + (classify-error (locally (fmakunbound 1) t)) + type-error) diff --git a/ansi-tests/length.lsp b/ansi-tests/length.lsp index 3706d72d4d7a623a7fc5d4761e9e6e68484a7ee0..79aab2dad52374b917f84fc851513fa657fb29b6 100644 Binary files a/ansi-tests/length.lsp and b/ansi-tests/length.lsp differ diff --git a/ansi-tests/make-sequence.lsp b/ansi-tests/make-sequence.lsp index 4a0249943cd96193111d13132ac948cc855a0097..fe59840214fc05881ceb0f1b28b9631f7c90a886 100644 --- a/ansi-tests/make-sequence.lsp +++ b/ansi-tests/make-sequence.lsp @@ -246,3 +246,6 @@ (classify-error (make-sequence 'list 10 0 0)) program-error) +(deftest make-sequence.error.14 + (classify-error (locally (make-sequence 'symbol 10) t)) + type-error) diff --git a/ansi-tests/map-into.lsp b/ansi-tests/map-into.lsp index 48df0e62982d93c9443dceb26c5d63cec7db173d..ee44fe946a2e64927f5ce86de3dfab20e95e303f 100644 --- a/ansi-tests/map-into.lsp +++ b/ansi-tests/map-into.lsp @@ -366,3 +366,7 @@ (deftest map-into.error.5 (classify-error (map-into (list 'a 'b 'c))) program-error) + +(deftest map-into.error.6 + (classify-error (locally (map-into 'a #'(lambda () nil)) t)) + type-error) diff --git a/ansi-tests/map.lsp b/ansi-tests/map.lsp index 7a3fdda8d60b32d8b3ad52ddd8448c72bc818e49..a8f217d38dbbb1e590800979238fdb205d5bdc1d 100644 --- a/ansi-tests/map.lsp +++ b/ansi-tests/map.lsp @@ -164,7 +164,8 @@ (a b c)) (deftest map.error.1 - (handler-case (map 'symbol #'identity '(a b c)) + (handler-case (progn (proclaim '(optimize (safety 3))) + (eval '(map 'symbol #'identity '(a b c)))) (error () :caught)) :caught) diff --git a/ansi-tests/merge.lsp b/ansi-tests/merge.lsp index d58d396f4f61756b1bbdd6418e74da64a73e4f67..e13ddccb9f8b716a9a8d5b5a89da82f6383b432c 100644 --- a/ansi-tests/merge.lsp +++ b/ansi-tests/merge.lsp @@ -486,10 +486,10 @@ ;;; Tests of error situations (deftest merge.error.1 - (handler-case (eval - '(locally (declare (optimize (safety 3))) - (merge 'symbol (list 1 2 3) (list 4 5 6) #'<))) - (error () :caught)) + (handler-case (eval + '(locally (declare (optimize (safety 3))) + (merge 'symbol (list 1 2 3) (list 4 5 6) #'<))) + (error () :caught)) :caught) (deftest merge.error.2 @@ -545,3 +545,10 @@ (classify-error (merge 'list (list 2 4 6) (list 1 3 5) #'< 1 2)) program-error) +(deftest merge.error.15 + (classify-error (locally (merge '(vector * 3) (list 1 2 3) + (list 4 5 6) #'<) + t)) + type-error) + + diff --git a/ansi-tests/notany.lsp b/ansi-tests/notany.lsp index ab6b1880c0ca911114766b1ba27efa21d75f8292..da98a1af0ad2695fe0c38dd4da1fd5dd199452b0 100644 --- a/ansi-tests/notany.lsp +++ b/ansi-tests/notany.lsp @@ -116,3 +116,7 @@ (deftest notany.error.9 (classify-error (notany #'null)) program-error) + +(deftest notany.error.10 + (classify-error (locally (notany 1 '(a b c)) t)) + type-error) diff --git a/ansi-tests/nreverse.lsp b/ansi-tests/nreverse.lsp index 9abce2f4c15373c8fe9659c96072ec223e7bb22b..1ab09440543e6b61e18c66b7bd1402beb30e9e44 100644 --- a/ansi-tests/nreverse.lsp +++ b/ansi-tests/nreverse.lsp @@ -87,23 +87,23 @@ "edcba") (deftest nreverse.error.1 - (catch-type-error (nreverse 'a)) + (classify-error (nreverse 'a)) type-error) (deftest nreverse.error.2 - (catch-type-error (nreverse #\a)) + (classify-error (nreverse #\a)) type-error) (deftest nreverse.error.3 - (catch-type-error (nreverse 10)) + (classify-error (nreverse 10)) type-error) (deftest nreverse.error.4 - (catch-type-error (nreverse 0.3)) + (classify-error (nreverse 0.3)) type-error) (deftest nreverse.error.5 - (catch-type-error (nreverse 10/3)) + (classify-error (nreverse 10/3)) type-error) (deftest nreverse.error.6 @@ -114,6 +114,6 @@ (classify-error (nreverse nil nil)) program-error) - - - +(deftest nreverse.error.8 + (classify-error (locally (nreverse 'a) t)) + type-error) diff --git a/ansi-tests/packages-03.lsp b/ansi-tests/packages-03.lsp index 0dd7ebaf3ee7831da66c6d1268b861c86d6ed076..71216ac94451f941d609169d74441e54ebe95c4b 100644 --- a/ansi-tests/packages-03.lsp +++ b/ansi-tests/packages-03.lsp @@ -66,12 +66,17 @@ (deftest package-name-5 (notnot-mv (member (classify-error (package-name "NOT-THERE")) - '(type-error package-error))) + '(type-error package-error))) t) (deftest package-name-6 (notnot-mv (member (classify-error (package-name #\*)) - '(type-error package-error))) + '(type-error package-error))) + t) + +(deftest package-name-6a + (notnot-mv (member (classify-error (locally (package-name #\*) t)) + '(type-error package-error))) t) (deftest package-name-7 @@ -177,7 +182,11 @@ t) (deftest package-nicknames-9 - (catch-type-error (package-nicknames 10)) + (classify-error (package-nicknames 10)) + type-error) + +(deftest package-nicknames-9a + (classify-error (locally (package-nicknames 10) t)) type-error) (deftest package-nicknames-10 @@ -186,7 +195,7 @@ (deftest package-nicknames-11 (notnot-mv (member (classify-error (package-nicknames "NOT-A-PACKAGE-NAME")) - '(type-error package-error))) + '(type-error package-error))) t) diff --git a/ansi-tests/position-if-not.lsp b/ansi-tests/position-if-not.lsp index e24e47ee2bb7f24d939068f39975fde76ba9af5c..53a8416d98dc63e7a7bc99ef5cd1b3303984a725 100644 --- a/ansi-tests/position-if-not.lsp +++ b/ansi-tests/position-if-not.lsp @@ -528,5 +528,6 @@ (classify-error (position-if-not #'null nil 1 2)) program-error) - - +(deftest position-if-not.error.11 + (classify-error (locally (position-if-not #'identity 'b) t)) + type-error) diff --git a/ansi-tests/position-if.lsp b/ansi-tests/position-if.lsp index be9855d7ffa27b66d8a8e6f83b37ec78eaddb28b..35477db0cad9cf45e398929bf2126ccd43f21d05 100644 --- a/ansi-tests/position-if.lsp +++ b/ansi-tests/position-if.lsp @@ -525,3 +525,6 @@ (classify-error (position-if #'null nil 1 2)) program-error) +(deftest position-if.error.11 + (classify-error (locally (position-if #'identity 'b) t)) + type-error) diff --git a/ansi-tests/position.lsp b/ansi-tests/position.lsp index 0c446e62cad40de70d56d19245b4d114ffafb9d6..ec35078c6af536b7874b933de4cdee5a62d336ac 100644 --- a/ansi-tests/position.lsp +++ b/ansi-tests/position.lsp @@ -721,4 +721,6 @@ (classify-error (position 'a nil 1 2)) program-error) - +(deftest position.error.11 + (classify-error (locally (position 'a 'b) t)) + type-error) diff --git a/ansi-tests/reduce.lsp b/ansi-tests/reduce.lsp index 818f40b923a9b562721cae8aaa44da56641a04d1..556b6cb82798d00b7f16f655d73063e2ea75142d 100644 --- a/ansi-tests/reduce.lsp +++ b/ansi-tests/reduce.lsp @@ -192,6 +192,10 @@ (classify-error (reduce #'list nil 1 2)) program-error) +(deftest reduce.error.7 + (classify-error (locally (reduce 'cons 'a) t)) + type-error) + ;;;;;;;; (deftest reduce-string.1 @@ -411,3 +415,4 @@ (reduce #'cons '(1 2 3) :from-end t :from-end nil :initial-value nil :initial-value 'a) (1 2 3)) + diff --git a/ansi-tests/reverse.lsp b/ansi-tests/reverse.lsp index 5f2155f3e648dfe844efad4aed57e4a61115637b..10362273ebc6576d465e18d27d350b87ccd2d56b 100644 --- a/ansi-tests/reverse.lsp +++ b/ansi-tests/reverse.lsp @@ -92,23 +92,23 @@ ;;; Error cases (deftest reverse.error.1 - (catch-type-error (reverse 'a)) + (classify-error (reverse 'a)) type-error) (deftest reverse.error.2 - (catch-type-error (reverse #\a)) + (classify-error (reverse #\a)) type-error) (deftest reverse.error.3 - (catch-type-error (reverse 10)) + (classify-error (reverse 10)) type-error) (deftest reverse.error.4 - (catch-type-error (reverse 0.3)) + (classify-error (reverse 0.3)) type-error) (deftest reverse.error.5 - (catch-type-error (reverse 10/3)) + (classify-error (reverse 10/3)) type-error) (deftest reverse.error.6 @@ -119,11 +119,6 @@ (classify-error (reverse nil nil)) program-error) - - - - - - - - +(deftest reverse.error.8 + (classify-error (locally (reverse 'a) t)) + type-error) diff --git a/ansi-tests/some.lsp b/ansi-tests/some.lsp index c0c3b756e718527b5c8f53bea0822a231845037d..70119996206ea1ec43939b1ff19fdbdae503076a 100644 --- a/ansi-tests/some.lsp +++ b/ansi-tests/some.lsp @@ -115,3 +115,6 @@ (classify-error (some #'null)) program-error) +(deftest some.error.10 + (classify-error (locally (some 1 '(a b c)) t)) + type-error) diff --git a/ansi-tests/vector-pop.lsp b/ansi-tests/vector-pop.lsp index 494d6efbc6077e603aa4fd4ded128083d882c3cd..e5d7d9ed4af71034f35f46357b365e36732dce9d 100644 --- a/ansi-tests/vector-pop.lsp +++ b/ansi-tests/vector-pop.lsp @@ -39,4 +39,6 @@ (vector-pop v nil))) program-error) - +(deftest vector-pop.error.5 + (classify-error (locally (vector-pop (vector 1 2 3)) t)) + type-error)