Commit ad0560cf authored by pfdietz's avatar pfdietz

Begin updating error tests to use SIGNALS-ERROR instead of CLASSIFY-ERROR. ...

Begin updating error tests to use SIGNALS-ERROR instead of CLASSIFY-ERROR.  The latter made unwarranted assumptions about error conditions not being in mutiple standardized condition classes.
parent 0e3e573e
......@@ -42,12 +42,13 @@
good)
(deftest abort.5
(classify-error
(signals-error
(let ((c1 (make-condition 'error))
(c2 (make-condition 'error)))
(with-condition-restarts
c1
(compute-restarts)
;; All conditions are now associated with c1
(abort c2))))
control-error)
(abort c2)))
control-error)
t)
......@@ -8,16 +8,16 @@
(compile-and-load "numbers-aux.lsp")
(deftest abs.error.1
(classify-error (abs))
program-error)
(signals-error (abs) program-error)
t)
(deftest abs.error.2
(classify-error (abs 0 0))
program-error)
(signals-error (abs 0 0) program-error)
t)
(deftest abs.error.3
(classify-error (abs 0 nil nil))
program-error)
(signals-error (abs 0 nil nil) program-error)
t)
(deftest abs.1
(loop for x in *numbers*
......
......@@ -46,17 +46,17 @@
3 1 2 3)
(deftest acons.error.1
(classify-error (acons))
program-error)
(signals-error (acons) program-error)
t)
(deftest acons.error.2
(classify-error (acons 'a))
program-error)
(signals-error (acons 'a) program-error)
t)
(deftest acons.error.3
(classify-error (acons 'a 'b))
program-error)
(signals-error (acons 'a 'b) program-error)
t)
(deftest acons.error.4
(classify-error (acons 'a 'b 'c 'd))
program-error)
(signals-error (acons 'a 'b 'c 'd) program-error)
t)
......@@ -42,22 +42,23 @@
:error)
(deftest add-method.error.4
(classify-error (add-method))
program-error)
(signals-error (add-method) program-error)
t)
(deftest add-method.error.5
(classify-error (add-method #'add-method-gf-01))
program-error)
(signals-error (add-method #'add-method-gf-01) program-error)
t)
(deftest add-method.error.6
(classify-error
(signals-error
(let* ((gf (eval '(defgeneric add-method-gf-07 (x)
(:method ((x t)) 'a))))
(method (find-method #'add-method-gf-07 nil (list (find-class t))))
(gf2 (eval '(defgeneric add-method-gf-08 (x)))))
(remove-method gf method)
(add-method gf2 method nil)))
program-error)
(add-method gf2 method nil))
program-error)
t)
(deftest add-method.error.7
(let* ((gf (eval '(defgeneric add-method-gf-09 (x y)
......
......@@ -156,42 +156,41 @@
(a b c))
(deftest adjoin.error.1
(classify-error (adjoin))
program-error)
(signals-error (adjoin) program-error)
t)
(deftest adjoin.error.2
(classify-error (adjoin 'a))
program-error)
(signals-error (adjoin 'a) program-error)
t)
(deftest adjoin.error.3
(classify-error (adjoin 'a '(b c) :bad t))
program-error)
(signals-error (adjoin 'a '(b c) :bad t) program-error)
t)
(deftest adjoin.error.4
(classify-error (adjoin 'a '(b c) :allow-other-keys nil :bad t))
program-error)
(signals-error (adjoin 'a '(b c) :allow-other-keys nil :bad t) program-error)
t)
(deftest adjoin.error.5
(classify-error (adjoin 'a '(b c) 1 2))
program-error)
(signals-error (adjoin 'a '(b c) 1 2) program-error)
t)
(deftest adjoin.error.6
(classify-error (adjoin 'a '(b c) :test))
program-error)
(signals-error (adjoin 'a '(b c) :test) program-error)
t)
(deftest adjoin.error.7
(classify-error (adjoin 'a '(b c) :test #'identity))
program-error)
(signals-error (adjoin 'a '(b c) :test #'identity) program-error)
t)
(deftest adjoin.error.8
(classify-error (adjoin 'a '(b c) :test-not #'identity))
program-error)
(signals-error (adjoin 'a '(b c) :test-not #'identity) program-error)
t)
(deftest adjoin.error.9
(classify-error (adjoin 'a '(b c) :key #'cons))
program-error)
(signals-error (adjoin 'a '(b c) :key #'cons) program-error)
t)
(deftest adjoin.error.10
(classify-error (adjoin 'a (list* 'b 'c 'd)))
type-error)
(signals-error (adjoin 'a (list* 'b 'c 'd)) type-error)
t)
......@@ -36,16 +36,16 @@
;;; Error tests
(deftest adjustable-array-p.error.1
(classify-error (adjustable-array-p))
program-error)
(signals-error (adjustable-array-p) program-error)
t)
(deftest adjustable-array-p.error.2
(classify-error (adjustable-array-p "aaa" nil))
program-error)
(signals-error (adjustable-array-p "aaa" nil) program-error)
t)
(deftest adjustable-array-p.error.3
(classify-error (adjustable-array-p 10))
type-error)
(signals-error (adjustable-array-p 10) type-error)
t)
(deftest adjustable-array-p.error.4
(let (why)
......@@ -58,11 +58,12 @@
nil)
(deftest adjustable-array-p.error.5
(classify-error (locally (adjustable-array-p 10)))
type-error)
(signals-error (locally (adjustable-array-p 10)) type-error)
t)
(deftest adjustable-array-p.error.6
(classify-error (let ((x 10))
(signals-error (let ((x 10))
(locally (declare (optimize (safety 3)))
(adjustable-array-p x))))
type-error)
(adjustable-array-p x)))
type-error)
t)
......@@ -108,8 +108,8 @@
;;; Error tests
(deftest allocate-instance.error.1
(classify-error (allocate-instance))
program-error)
(signals-error (allocate-instance) program-error)
t)
;;; Duane Rettig made a convincing argument that the next two
;;; tests are bad, since the caller of allocate-instance
......@@ -117,12 +117,14 @@
#|
(deftest allocate-instance.error.2
(classify-error (allocate-instance (find-class 'allocate-instance-class-01)
:b))
program-error)
(signals-error (allocate-instance (find-class 'allocate-instance-class-01)
:b)
program-error)
t)
(deftest allocate-instance.error.3
(classify-error (allocate-instance (find-class 'allocate-instance-class-01)
'(a b c) nil))
program-error)
(signals-error (allocate-instance (find-class 'allocate-instance-class-01)
'(a b c) nil)
program-error)
t)
|#
......@@ -56,15 +56,16 @@
4 4 1 2 3 4)
(deftest and.error.1
(classify-error (funcall (macro-function 'and)))
program-error)
(signals-error (funcall (macro-function 'and))
program-error)
t)
(deftest and.error.2
(classify-error (funcall (macro-function 'and)
'(and)))
program-error)
(signals-error (funcall (macro-function 'and) '(and))
program-error)
t)
(deftest and.error.3
(classify-error (funcall (macro-function 'and)
'(and) nil nil))
program-error)
\ No newline at end of file
(signals-error (funcall (macro-function 'and) '(and) nil nil)
program-error)
t)
......@@ -335,6 +335,18 @@ the condition to go uncaught if it cannot be classified."
(defmacro classify-error (form)
`(classify-error** ',form))
;;; The above is badly designed, since it fails when some signals
;;; may be in more than one class/
(defmacro signals-error (form error-name)
`(handler-bind
((warning #'(lambda (c) (declare (ignore c))
(muffle-warning))))
(proclaim '(optimize (safety 3)))
(handler-case
(apply #'values nil (multiple-value-list (normally ,form)))
(,error-name (c) t))))
;;;
;;; A scaffold is a structure that is used to remember the object
;;; identities of the cons cells in a (noncircular) data structure.
......
......@@ -62,9 +62,11 @@
1 1)
(deftest append.error.1
(classify-error (append '(a . b) '(z)))
type-error)
(signals-error (append '(a . b) '(z))
type-error)
t)
(deftest append.error.2
(classify-error (append '(x y z) '(a . b) '(z)))
type-error)
(signals-error (append '(x y z) '(a . b) '(z))
type-error)
t)
......@@ -8,20 +8,21 @@
;;; Error cases
(deftest apply.error.1
(classify-error (apply))
program-error)
(signals-error (apply) program-error)
t)
(deftest apply.error.2
(classify-error (apply #'cons))
program-error)
(signals-error (apply #'cons) program-error)
t)
(deftest apply.error.3
(classify-error (apply #'cons nil))
program-error)
(signals-error (apply #'cons nil) program-error)
t)
(deftest apply.error.4
(classify-error (apply #'cons (list 1 2 3)))
program-error)
(signals-error (apply #'cons (list 1 2 3))
program-error)
t)
;;; Non-error cases
......
......@@ -136,9 +136,10 @@
;;; To add: aref on displaced arrays, arrays with fill pointers, etc.
(deftest aref.error.1
(classify-error (aref))
program-error)
(signals-error (aref) program-error)
t)
(deftest aref.error.2
(classify-error (funcall #'aref))
program-error)
(signals-error (funcall #'aref) program-error)
t)
......@@ -48,16 +48,14 @@
;;; Error tests
(deftest array-dimension.error.1
(classify-error (array-dimension))
program-error)
(signals-error (array-dimension) program-error)
t)
(deftest array-dimension.error.2
(classify-error (array-dimension #(a b c)))
program-error)
(signals-error (array-dimension #(a b c)) program-error)
t)
(deftest array-dimension.error.3
(classify-error (array-dimension #(a b c) 0 nil))
program-error)
(signals-error (array-dimension #(a b c) 0 nil)
program-error)
t)
......@@ -42,12 +42,13 @@
;;; Error tests
(deftest array-dimensions.error.1
(classify-error (array-dimensions))
program-error)
(signals-error (array-dimensions) program-error)
t)
(deftest array-dimensions.error.2
(classify-error (array-dimensions #(a b c) nil))
program-error)
(signals-error (array-dimensions #(a b c) nil)
program-error)
t)
(deftest array-dimensions.error.3
(let (why)
......@@ -60,10 +61,10 @@
nil)
(deftest array-dimensions.error.4
(classify-error (array-dimensions nil))
type-error)
(signals-error (array-dimensions nil) type-error)
t)
(deftest array-dimensions.error.5
(classify-error (locally (array-dimensions nil)))
type-error)
(signals-error (locally (array-dimensions nil))
type-error)
t)
......@@ -108,12 +108,12 @@
;;; Error tests
(deftest array-displacement.error.1
(classify-error (array-displacement))
program-error)
(signals-error (array-displacement) program-error)
t)
(deftest array-displacement.error.2
(classify-error (array-displacement #(a b c) nil))
program-error)
(signals-error (array-displacement #(a b c) nil) program-error)
t)
(deftest array-displacement.error.3
(let (why)
......@@ -126,10 +126,12 @@
nil)
(deftest array-displacement.error.4
(classify-error (array-displacement nil))
type-error)
(signals-error (array-displacement nil) type-error)
t)
(deftest array-displacement.error.5
(classify-error (let ((x nil)) (array-displacement x)))
type-error)
(signals-error (let ((x nil)) (array-displacement x))
type-error)
t)
......@@ -147,6 +147,5 @@
;;; Error tests
(deftest array-in-bounds-p.error.1
(classify-error (array-in-bounds-p))
program-error)
(signals-error (array-in-bounds-p) program-error)
t)
......@@ -28,12 +28,12 @@
;;; Error tests
(deftest array-rank.error.1
(classify-error (array-rank))
program-error)
(signals-error (array-rank) program-error)
t)
(deftest array-rank.error.2
(classify-error (array-rank #(a b c) nil))
program-error)
(signals-error (array-rank #(a b c) nil) program-error)
t)
(deftest array-rank.error.3
(loop for e in *mini-universe*
......@@ -44,9 +44,10 @@
nil)
(deftest array-rank.error.4
(classify-error (array-rank nil))
type-error)
(signals-error (array-rank nil) type-error)
t)
(deftest array-rank.error.5
(classify-error (locally (array-rank nil) t))
type-error)
(signals-error (locally (array-rank nil) t)
type-error)
t)
......@@ -35,5 +35,6 @@
;;; Error tests
(deftest array-row-major-index.error.1
(classify-error (array-row-major-index))
program-error)
(signals-error (array-row-major-index) program-error)
t)
......@@ -37,12 +37,12 @@
;;; Error tests
(deftest array-total-size.error.1
(classify-error (array-total-size))
program-error)
(signals-error (array-total-size) program-error)
t)
(deftest array-total-size.error.2
(classify-error (array-total-size #(a b c) nil))
program-error)
(signals-error (array-total-size #(a b c) nil) program-error)
t)
(deftest array-total-size.error.3
(let (why)
......@@ -55,9 +55,10 @@
nil)
(deftest array-total-size.error.4
(classify-error (array-total-size 0))
type-error)
(signals-error (array-total-size 0) type-error)
t)
(deftest array-total-size.error.5
(classify-error (locally (array-total-size 0) t))
type-error)
(signals-error (locally (array-total-size 0) t)
type-error)
t)
......@@ -46,12 +46,9 @@
;;; Error tests
(deftest arrayp.error.1
(classify-error (arrayp))
program-error)
(signals-error (arrayp) program-error)
t)
(deftest arrayp.error.2
(classify-error (arrayp #(a b c) nil))
program-error)
(signals-error (arrayp #(a b c) nil) program-error)
t)
......@@ -5,32 +5,36 @@
(in-package :cl-test)
;;; Error tests
(deftest ash.error.1
(classify-error (ash))
program-error)
(signals-error (ash) program-error)
t)
(deftest ash.error.2
(classify-error (ash 1 1 1))
program-error)
(signals-error (ash 1 1 1) program-error)
t)
(deftest ash.error.3
(classify-error (ash 1 1 nil))
program-error)
(signals-error (ash 1 1 nil) program-error)
t)
(deftest ash.error.4
(loop for x in *mini-universe*
unless (or (integerp x)
(eq (eval `(classify-error (ash ',x 0))) 'type-error))
(eval `(signals-error (ash ',x 0) type-error)))
collect x)
nil)
(deftest ash.error.5
(loop for x in *mini-universe*
unless (or (integerp x)
(eq (eval `(classify-error (ash 0 ',x))) 'type-error))
(eval `(signals-error (ash 0 ',x) type-error)))
collect x)
nil)
;;; Non-error tests
(deftest ash.1
(loop for x in *integers*
always (eql (ash x 0) x))
......
......@@ -97,53 +97,63 @@
;;; Error tests
(deftest assoc-if-not.error.1
(classify-error (assoc-if-not))
program-error)
(signals-error (assoc-if-not) program-error)
t)
(deftest assoc-if-not.error.2
(classify-error (assoc-if-not #'null))
program-error)
(signals-error (assoc-if-not #'null) program-error)
t)
(deftest assoc-if-not.error.3
(classify-error (assoc-if-not #'null nil :bad t))
program-error)
(signals-error (assoc-if-not #'null nil :bad t)
program-error)
t)
(deftest assoc-if-not.error.4
(classify-error (assoc-if-not #'null nil :key))
program-error)
(signals-error (assoc-if-not #'null nil :key)
program-error)
t)
(deftest assoc-if-not.error.5
(classify-error (assoc-if-not #'null nil 1 1))
program-error)
(signals-error (assoc-if-not #'null nil 1 1)
program-error)
t)
(deftest assoc-if-not.error.6
(classify-error (assoc-if-not #'null nil :bad t :allow-other-keys nil))
program-error)
(signals-error (assoc-if-not #'null nil :bad t :allow-other-keys nil)
program-error)
t)
(deftest assoc-if-not.error.7
(classify-error (assoc-if-not #'cons '((a b)(c d))))
program-error)
(signals-error (assoc-if-not #'cons '((a b)(c d)))
program-error)
t)
(deftest assoc-if-not.error.8
(classify-error (assoc-if-not #'identity '((a b)(c d)) :key #'cons))
program-error)
(signals-error (assoc-if-not #'identity '((a b)(c d)) :key #'cons)
program-error)
t)
(deftest assoc-if-not.error.9
(classify-error (assoc-if-not #'car '((a b)(c d))))
type-error)
(signals-error (assoc-if-not #'car '((a b)(c d)))
type-error)
t)
(deftest assoc-if-not.error.10
(classify-error (assoc-if-not #'identity '((a b)(c d)) :key #'car))
type-error)
(signals-error (assoc-if-not #'identity '((a b)(c d)) :key #'car)
type-error)
t)
(deftest assoc-if-not.error.11
(classify-error (assoc-if-not #'identity '((a . b) . c)))
type-error)
(signals-error (assoc-if-not #'identity '((a . b) . c))
type-error)
t)
(deftest assoc-if-not.error.12
(classify-error (assoc-if-not #'identity '((a . b) :bad (c . d))))
type-error)
(signals-error (assoc-if-not #'identity '((a . b) :bad (c . d)))
type-error)
t)
(deftest assoc-if-not.error.13
(classify-error (assoc-if-not #'identity 'y))
type-error)
(signals-error (assoc-if-not #'identity 'y) type-error)
t)
......@@ -101,53 +101,63 @@
;;; Error cases
(deftest assoc-if.error.1
(classify-error (assoc-if))
program-error)
(signals-error (assoc-if) program-error)
t)
(deftest assoc-if.error.2
(classify-error (assoc-if #'null))
program-error)
(signals-error (assoc-if #'null) program-error)
t)
(deftest assoc-if.error.3
(classify-error (assoc-if #'null nil :bad t))
program-error)
(signals-error (assoc-if #'null nil :bad t)
program-error)
t)
(deftest assoc-if.error.4
(classify-error (assoc-if #'null nil :key))
program-error)
(signals-error (assoc-if #'null nil :key)
program-error)
t)
(deftest assoc-if.error.5
(classify-error (assoc-if #'null nil 1 1))
program-error)
(signals-error (assoc-if #'null nil 1 1)
program-error)
t)
(deftest assoc-if.error.6
(classify-error (assoc-if #'null nil :bad t :allow-other-keys nil))
program-error)
(signals-error (assoc-if #'null nil :bad t :allow-other-keys nil)
program-error)
t)
(deftest assoc-if.error.7
(classify-error (assoc-if #'cons '((a b)(c d))))
program-error)
(signals-error (assoc-if #'cons '((a b)(c d)))
program-error)
t)
(deftest assoc-if.error.8
(classify-error (assoc-if #'identity '((a b)(c d)) :key #'cons))
program-error)
(signals-error (assoc-if #'identity '((a b)(c d)) :key #'cons)
program-error)
t)
(deftest assoc-if.error.9
(classify-error (assoc-if #'car '((a b)(c d))))
type-error)
(signals-error (assoc-if #'car '((a b)(c d)))
type-error)
t)
(deftest assoc-if.error.10
(classify-error (assoc-if #'identity '((a b)(c d)) :key #'car))
type-error)
(signals-error (assoc-if #'identity '((a b)(c d)) :key #'car)
type-error)
t)
(deftest assoc-if.error.11
(classify-error (assoc-if #'null '((a . b) . c)))
type-error)
(signals-error (assoc-if #'null '((a . b) . c))
type-error)
t)
(deftest assoc-if.error.12
(classify-error (assoc-if #'null '((a . b) :bad (c . d))))
type-error)
(signals-error (assoc-if #'null '((a . b) :bad (c . d)))
type-error)
t)
(deftest assoc-if.error.13
(classify-error (assoc-if #'null 'y))
type-error)
(signals-error (assoc-if #'null 'y) type-error)
t)
......@@ -240,49 +240,56 @@
(deftest assoc.error.1
(classify-error (assoc))
</