From f179fd8ffe0931fab18f78b26282938690dc68ca Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Wed, 29 Jan 2003 02:11:55 +0000 Subject: [PATCH] Fixed up some error tests, adding tests that hide the error form in a LOCALLY to possibly stimulate CMUCL compiler bugs. Converted some uses of the old catch-type-error into classify-error. Added safety proclamations in place of local safety declarations in eval-ed forms. --- ansi-tests/adjustable-array-p.lsp | 10 ++++ ansi-tests/ansi-aux.lsp | 4 +- ansi-tests/array-dimensions.lsp | 9 ++++ ansi-tests/array-displacement.lsp | 9 ++++ ansi-tests/array-rank.lsp | 8 +++ ansi-tests/array-total-size.lsp | 4 ++ ansi-tests/boundp.lsp | 4 ++ ansi-tests/cl-symbols.lsp | 19 ++++--- ansi-tests/coerce.lsp | 4 ++ ansi-tests/concatenate.lsp | 13 +++-- ansi-tests/cons-test-01.lsp | 15 ++++++ ansi-tests/cons-test-03.lsp | 18 +++++-- ansi-tests/cons-test-06.lsp | 4 ++ ansi-tests/cons-test-08.lsp | 10 ++++ ansi-tests/cons-test-09.lsp | 81 +++++++++++++++++------------- ansi-tests/cons-test-10.lsp | 28 ++++++----- ansi-tests/cons-test-11.lsp | 39 +++++++------- ansi-tests/cons-test-12.lsp | 30 ++++++----- ansi-tests/cons-test-13.lsp | 18 ++++--- ansi-tests/cons-test-14.lsp | 9 ++++ ansi-tests/cons-test-15.lsp | 24 +++++++++ ansi-tests/copy-seq.lsp | 5 ++ ansi-tests/count-if-not.lsp | 9 ++-- ansi-tests/count-if.lsp | 10 ++-- ansi-tests/count.lsp | 11 ++-- ansi-tests/elt.lsp | 4 ++ ansi-tests/every.lsp | 4 ++ ansi-tests/fboundp.lsp | 4 ++ ansi-tests/fdefinition.lsp | 4 ++ ansi-tests/fill-pointer.lsp | 4 ++ ansi-tests/fill.lsp | 4 ++ ansi-tests/find-if-not.lsp | 6 ++- ansi-tests/find-if.lsp | 4 ++ ansi-tests/find.lsp | 4 ++ ansi-tests/fmakunbound.lsp | 9 ++-- ansi-tests/length.lsp | Bin 2380 -> 2452 bytes ansi-tests/make-sequence.lsp | 3 ++ ansi-tests/map-into.lsp | 4 ++ ansi-tests/map.lsp | 3 +- ansi-tests/merge.lsp | 15 ++++-- ansi-tests/notany.lsp | 4 ++ ansi-tests/nreverse.lsp | 16 +++--- ansi-tests/packages-03.lsp | 17 +++++-- ansi-tests/position-if-not.lsp | 5 +- ansi-tests/position-if.lsp | 3 ++ ansi-tests/position.lsp | 4 +- ansi-tests/reduce.lsp | 5 ++ ansi-tests/reverse.lsp | 21 +++----- ansi-tests/some.lsp | 3 ++ ansi-tests/vector-pop.lsp | 4 +- 50 files changed, 398 insertions(+), 151 deletions(-) diff --git a/ansi-tests/adjustable-array-p.lsp b/ansi-tests/adjustable-array-p.lsp index dfc31859..c881f66b 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 eaf3d1e0..a77a4023 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 73ceddaa..5cdeb558 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 b70f4d7d..42ce61c5 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 78af7b95..1ca746e8 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 cf55b392..0f13681b 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 372710ec..7a84dec9 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 8cf32145..692c5df9 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 8531cb83..3fbe5db8 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 9c08f50c..1f8a36a1 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 151099a3..98d6e525 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 3d7ba610..e610e35b 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 6c83a12f..c0f067e7 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 14f7bc09..9c10446c 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 b3647bc5..58c01012 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 46ee936e..e3caf27f 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 b9d6751a..6cfea20c 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 4f8cc4e0..186572d6 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 afe1a336..384c8d96 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 31b5a987..15918e24 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 32dc9d15..2708a982 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 6c2d4fd9..51b1afc5 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 24596809..94ec766a 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 85a2f28a..a02f8ce4 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 a60c1fd0..2bcf4bfc 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 9a76c8df..6e45e115 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 7f1f3bb5..b990f268 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 b348dfd8..da5b49c7 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 bdbf86ad..c49663a7 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 aa91c42f..4bde4c20 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 54e30456..6d84c2d2 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 8322503d..2e3c2f54 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 6754f7b4..eb7dd4e4 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 026cc3bf..ba2eecfa 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 e3b56048..f6c44f55 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 GIT binary patch delta 108 zcmX>jG(~vB9M;Kx>|&F*uo{5rKTz6*%@EA*h0@p9R!xp%6En8pQc%!H&PgmT&P=P+ tO)V<QFH+FR$xlwq$*BY~QuESFG8EJkH5E!UHGxV?DhpCKm$P4G1OR-jBJltK delta 82 ycmbOtd`4))99GW6lH?5ClFEYA$%|R-k$5jrc=~J(NOEN;yuEBYH=kfX!w3N5xE{U$ diff --git a/ansi-tests/make-sequence.lsp b/ansi-tests/make-sequence.lsp index 4a024994..fe598402 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 48df0e62..ee44fe94 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 7a3fdda8..a8f217d3 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 d58d396f..e13ddccb 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 ab6b1880..da98a1af 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 9abce2f4..1ab09440 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 0dd7ebaf..71216ac9 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 e24e47ee..53a8416d 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 be9855d7..35477db0 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 0c446e62..ec35078c 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 818f40b9..556b6cb8 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 5f2155f3..10362273 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 c0c3b756..70119996 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 494d6efb..e5d7d9ed 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) -- GitLab