Commit d8f454a3 authored by pfdietz's avatar pfdietz

Changed classify-error forms to signals-error forms.

parent bfeebad5
...@@ -74,32 +74,36 @@ ...@@ -74,32 +74,36 @@
;;; Unknown keyword parameter should throw a program-error in safe code ;;; Unknown keyword parameter should throw a program-error in safe code
;;; (section 3.5.1.4) ;;; (section 3.5.1.4)
(deftest labels.12 (deftest labels.12
(classify-error (signals-error
(labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :c 4))) (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :c 4))
program-error) program-error)
t)
;;; Odd # of keyword args should throw a program-error in safe code ;;; Odd # of keyword args should throw a program-error in safe code
;;; (section 3.5.1.6) ;;; (section 3.5.1.6)
(deftest labels.13 (deftest labels.13
(classify-error (signals-error
(labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :a))) (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :a))
program-error) program-error)
t)
;;; Too few arguments (section 3.5.1.2) ;;; Too few arguments (section 3.5.1.2)
(deftest labels.14 (deftest labels.14
(classify-error (labels ((%f (a) a)) (%f))) (signals-error (labels ((%f (a) a)) (%f))
program-error) program-error)
t)
;;; Too many arguments (section 3.5.1.3) ;;; Too many arguments (section 3.5.1.3)
(deftest labels.15 (deftest labels.15
(classify-error (labels ((%f (a) a)) (%f 1 2))) (signals-error (labels ((%f (a) a)) (%f 1 2))
program-error) program-error)
t)
;;; Invalid keyword argument (section 3.5.1.5) ;;; Invalid keyword argument (section 3.5.1.5)
(deftest labels.16 (deftest labels.16
(classify-error (labels ((%f (&key a) a)) (%f '(foo)))) (signals-error (labels ((%f (&key a) a)) (%f '(foo)))
program-error) program-error)
t)
;;; Definition of a (setf ...) function ;;; Definition of a (setf ...) function
...@@ -179,18 +183,18 @@ ...@@ -179,18 +183,18 @@
(deftest labels.24 (deftest labels.24
(loop for s in *cl-non-function-macro-special-operator-symbols* (loop for s in *cl-non-function-macro-special-operator-symbols*
for form = `(classify-error (labels ((,s (x) (foo (1- x))) for form = `(ignore-errors (labels ((,s (x) (foo (1- x)))
(foo (y) (foo (y)
(if (<= y 0) 'a (if (<= y 0) 'a
(,s (1- y))))) (,s (1- y)))))
(,s 10))) (,s 10)))
unless (eq (eval form) 'a) unless (eq (eval form) 'a)
collect s) collect s)
nil) nil)
(deftest labels.25 (deftest labels.25
(loop for s in *cl-non-function-macro-special-operator-symbols* (loop for s in *cl-non-function-macro-special-operator-symbols*
for form = `(classify-error for form = `(ignore-errors
(labels ((,s (x) (foo (1- x))) (labels ((,s (x) (foo (1- x)))
(foo (y) (foo (y)
(if (<= y 0) 'a (if (<= y 0) 'a
...@@ -204,7 +208,7 @@ ...@@ -204,7 +208,7 @@
(deftest labels.26 (deftest labels.26
(loop for s in *cl-non-function-macro-special-operator-symbols* (loop for s in *cl-non-function-macro-special-operator-symbols*
for form = `(classify-error for form = `(ignore-errors
(labels (((setf ,s) (&rest args) (labels (((setf ,s) (&rest args)
(declare (ignore args)) (declare (ignore args))
'a)) 'a))
......
...@@ -262,13 +262,16 @@ ...@@ -262,13 +262,16 @@
10) 10)
(deftest lambda.error.1 (deftest lambda.error.1
(classify-error (funcall (macro-function 'lambda))) (signals-error (funcall (macro-function 'lambda))
program-error) program-error)
t)
(deftest lambda.error.2 (deftest lambda.error.2
(classify-error (funcall (macro-function 'lambda) '(lambda ()))) (signals-error (funcall (macro-function 'lambda) '(lambda ()))
program-error) program-error)
t)
(deftest lambda.error.3 (deftest lambda.error.3
(classify-error (funcall (macro-function 'lambda) '(lambda ()) nil nil)) (signals-error (funcall (macro-function 'lambda) '(lambda ()) nil nil)
program-error) program-error)
t)
...@@ -79,33 +79,35 @@ ...@@ -79,33 +79,35 @@
(d) 1) (d) 1)
(deftest last.error.1 (deftest last.error.1
(classify-error (last (list 'a 'b 'c) -1)) (signals-error (last (list 'a 'b 'c) -1) type-error)
type-error) t)
(deftest last.error.2 (deftest last.error.2
(classify-error (last (list 'a 'b 'c) 'a)) (signals-error (last (list 'a 'b 'c) 'a) type-error)
type-error) t)
(deftest last.error.3 (deftest last.error.3
(classify-error (last (list 'a 'b 'c) 10.0)) (signals-error (last (list 'a 'b 'c) 10.0) type-error)
type-error) t)
(deftest last.error.4 (deftest last.error.4
(classify-error (last (list 'a 'b 'c) -10.0)) (signals-error (last (list 'a 'b 'c) -10.0) type-error)
type-error) t)
(deftest last.error.5 (deftest last.error.5
(classify-error (last (list 'a 'b 'c) #\w)) (signals-error (last (list 'a 'b 'c) #\w) type-error)
type-error) t)
(deftest last.error.6 (deftest last.error.6
(classify-error (last)) (signals-error (last) program-error)
program-error) t)
(deftest last.error.7 (deftest last.error.7
(classify-error (last '(a b c) 2 nil)) (signals-error (last '(a b c) 2 nil) program-error)
program-error) t)
(deftest last.error.8 (deftest last.error.8
(classify-error (locally (last (list 'a 'b 'c) 'a) t)) (signals-error (locally (last (list 'a 'b 'c) 'a) t)
type-error) type-error)
t)
...@@ -11,7 +11,7 @@ ...@@ -11,7 +11,7 @@
(deftest lcm.error.1 (deftest lcm.error.1
(loop for x in *mini-universe* (loop for x in *mini-universe*
unless (or (integerp x) unless (or (integerp x)
(eq (eval `(classify-error (lcm ',x))) 'type-error)) (eval `(signals-error (lcm ',x) type-error)))
collect x) collect x)
nil) nil)
......
...@@ -5,17 +5,21 @@ ...@@ -5,17 +5,21 @@
(in-package :cl-test) (in-package :cl-test)
;;; Error tests
(deftest ldb.error.1 (deftest ldb.error.1
(classify-error (ldb)) (signals-error (ldb) program-error)
program-error) t)
(deftest ldb.error.2 (deftest ldb.error.2
(classify-error (ldb (byte 1 1))) (signals-error (ldb (byte 1 1)) program-error)
program-error) t)
(deftest ldb.error.3 (deftest ldb.error.3
(classify-error (ldb (byte 1 1) -1 0)) (signals-error (ldb (byte 1 1) -1 0) program-error)
program-error) t)
;;; Non-error tests
(deftest ldb.1 (deftest ldb.1
(loop for x = (random-fixnum) (loop for x = (random-fixnum)
......
...@@ -108,38 +108,39 @@ ...@@ -108,38 +108,39 @@
;; Error checking ;; Error checking
(deftest ldiff.error.1 (deftest ldiff.error.1
(classify-error (ldiff 10 'a)) (signals-error (ldiff 10 'a) type-error)
type-error) t)
;; Single atoms are not dotted lists, so the next ;; Single atoms are not dotted lists, so the next
;; case should be a type-error ;; case should be a type-error
(deftest ldiff.error.2 (deftest ldiff.error.2
(classify-error (ldiff 'a 'a)) (signals-error (ldiff 'a 'a) type-error)
type-error) t)
(deftest ldiff.error.3 (deftest ldiff.error.3
(classify-error (ldiff (make-array '(10) :initial-element 'a) '(a))) (signals-error (ldiff (make-array '(10) :initial-element 'a) '(a))
type-error) type-error)
t)
(deftest ldiff.error.4 (deftest ldiff.error.4
(classify-error (ldiff 1.23 t)) (signals-error (ldiff 1.23 t) type-error)
type-error) t)
(deftest ldiff.error.5 (deftest ldiff.error.5
(classify-error (ldiff #\w 'a)) (signals-error (ldiff #\w 'a) type-error)
type-error) t)
(deftest ldiff.error.6 (deftest ldiff.error.6
(classify-error (ldiff)) (signals-error (ldiff) program-error)
program-error) t)
(deftest ldiff.error.7 (deftest ldiff.error.7
(classify-error (ldiff nil)) (signals-error (ldiff nil) program-error)
program-error) t)
(deftest ldiff.error.8 (deftest ldiff.error.8
(classify-error (ldiff nil nil nil)) (signals-error (ldiff nil nil nil) program-error)
program-error) t)
;; Note! The spec is ambiguous on whether this next test ;; Note! The spec is ambiguous on whether this next test
;; is correct. The spec says that ldiff should be prepared ;; is correct. The spec says that ldiff should be prepared
...@@ -159,6 +160,6 @@ ...@@ -159,6 +160,6 @@
(catch-type-error (ldiff x x))))))) (catch-type-error (ldiff x x)))))))
(deftest ldiff-12 (deftest ldiff-12
(ldiff-12-body) (ldiff-12-body)
0) 0)
|# |#
No preview for this file type
...@@ -105,7 +105,7 @@ ...@@ -105,7 +105,7 @@
;;; in LET forms. ;;; in LET forms.
(deftest let.15 (deftest let.15
(loop for s in *cl-non-variable-constant-symbols* (loop for s in *cl-non-variable-constant-symbols*
for form = `(classify-error (let ((,s 17)) ,s)) for form = `(ignore-errors (let ((,s 17)) ,s))
unless (eql (eval form) 17) unless (eql (eval form) 17)
collect s) collect s)
nil) nil)
...@@ -214,7 +214,7 @@ ...@@ -214,7 +214,7 @@
;;; in LET* forms. ;;; in LET* forms.
(deftest let*.15 (deftest let*.15
(loop for s in *cl-non-variable-constant-symbols* (loop for s in *cl-non-variable-constant-symbols*
for form = `(classify-error (let* ((,s 17)) ,s)) for form = `(ignore-errors (let* ((,s 17)) ,s))
unless (eql (eval form) 17) unless (eql (eval form) 17)
collect s) collect s)
nil) nil)
......
...@@ -46,25 +46,25 @@ ...@@ -46,25 +46,25 @@
0) 0)
(deftest list-length.error.2 (deftest list-length.error.2
(classify-error (list-length)) (signals-error (list-length) program-error)
program-error) t)
(deftest list-length.error.3 (deftest list-length.error.3
(classify-error (list-length nil nil)) (signals-error (list-length nil nil) program-error)
program-error) t)
(deftest list-length.error.4 (deftest list-length.error.4
(classify-error (list-length 'a)) (signals-error (list-length 'a) type-error)
type-error) t)
(deftest list-length.error.5 (deftest list-length.error.5
(classify-error (locally (list-length 'a) t)) (signals-error (locally (list-length 'a) t) type-error)
type-error) t)
(deftest list-length-symbol (deftest list-length-symbol
(classify-error (list-length 'a)) (signals-error (list-length 'a) type-error)
type-error) t)
(deftest list-length-dotted-list (deftest list-length-dotted-list
(classify-error (list-length (copy-tree '(a b c d . e)))) (signals-error (list-length (copy-tree '(a b c d . e))) type-error)
type-error) t)
...@@ -39,9 +39,9 @@ ...@@ -39,9 +39,9 @@
nil 1) nil 1)
(deftest listp.error.1 (deftest listp.error.1
(classify-error (listp)) (signals-error (listp) program-error)
program-error) t)
(deftest listp.error.2 (deftest listp.error.2
(classify-error (listp nil nil)) (signals-error (listp nil nil) program-error)
program-error) t)
...@@ -23,9 +23,12 @@ ...@@ -23,9 +23,12 @@
:good) :good)
(deftest load-logical-pathname-translations.error.2 (deftest load-logical-pathname-translations.error.2
(classify-error (load-logical-pathname-translations)) (signals-error (load-logical-pathname-translations)
program-error) program-error)
t)
(deftest load-logical-pathname-translations.error.3 (deftest load-logical-pathname-translations.error.3
(classify-error (load-logical-pathname-translations "CLTESTROOT" nil)) (signals-error (load-logical-pathname-translations "CLTESTROOT" nil)
program-error) program-error)
t)
...@@ -7,20 +7,23 @@ ...@@ -7,20 +7,23 @@
(compile-and-load "numbers-aux.lsp") (compile-and-load "numbers-aux.lsp")
;;; Error tests
(deftest logand.error.1 (deftest logand.error.1
(loop for x in *mini-universe* (loop for x in *mini-universe*
unless (or (integerp x) unless (or (integerp x)
(eq (eval `(classify-error (logand ',x))) 'type-error)) (eval `(signals-error (logand ',x) type-error)))
collect x) collect x)
nil) nil)
(deftest logand.error.2 (deftest logand.error.2
(loop for x in *mini-universe* (loop for x in *mini-universe*
unless (or (integerp x) unless (or (integerp x)
(eq (eval `(classify-error (logand 0 ',x))) 'type-error)) (eval `(signals-error (logand 0 ',x) type-error)))
collect x) collect x)
nil) nil)
;;; Non-error tests
(deftest logand.1 (deftest logand.1
(logand) (logand)
......
...@@ -7,31 +7,35 @@ ...@@ -7,31 +7,35 @@
(compile-and-load "numbers-aux.lsp") (compile-and-load "numbers-aux.lsp")
;;; Error tests
(deftest logandc1.error.1 (deftest logandc1.error.1
(loop for x in *mini-universe* (loop for x in *mini-universe*
unless (or (integerp x) unless (or (integerp x)
(eq (eval `(classify-error (logandc1 ',x 0))) 'type-error)) (eval `(signals-error (logandc1 ',x 0) type-error)))
collect x) collect x)
nil) nil)
(deftest logandc1.error.2 (deftest logandc1.error.2
(loop for x in *mini-universe* (loop for x in *mini-universe*
unless (or (integerp x) unless (or (integerp x)
(eq (eval `(classify-error (logandc1 0 ',x))) 'type-error)) (eval `(signals-error (logandc1 0 ',x) type-error)))
collect x) collect x)
nil) nil)
(deftest logandc1.error.3 (deftest logandc1.error.3
(classify-error (logandc1)) (signals-error (logandc1) program-error)
program-error) t)
(deftest logandc1.error.4 (deftest logandc1.error.4
(classify-error (logandc1 0)) (signals-error (logandc1 0) program-error)
program-error) t)
(deftest logandc1.error.5 (deftest logandc1.error.5
(classify-error (logandc1 1 2 3)) (signals-error (logandc1 1 2 3) program-error)
program-error) t)
;;; Non-error tests
(deftest logandc1.1 (deftest logandc1.1
(logandc1 0 0) (logandc1 0 0)
......
...@@ -7,31 +7,35 @@ ...@@ -7,31 +7,35 @@
(compile-and-load "numbers-aux.lsp") (compile-and-load "numbers-aux.lsp")
;;; Error tests
(deftest logandc2.error.1 (deftest logandc2.error.1
(loop for x in *mini-universe* (loop for x in *mini-universe*
unless (or (integerp x) unless (or (integerp x)
(eq (eval `(classify-error (logandc2 ',x 0))) 'type-error)) (eval `(signals-error (logandc2 ',x 0) type-error)))
collect x) collect x)
nil) nil)
(deftest logandc2.error.2 (deftest logandc2.error.2
(loop for x in *mini-universe* (loop for x in *mini-universe*
unless (or (integerp x) unless (or (integerp x)
(eq (eval `(classify-error (logandc2 0 ',x))) 'type-error)) (eval `(signals-error (logandc2 0 ',x) type-error)))
collect x) collect x)
nil) nil)
(deftest logandc2.error.3 (deftest logandc2.error.3
(classify-error (logandc2)) (signals-error (logandc2) program-error)
program-error) t)
(deftest logandc2.error.4 (deftest logandc2.error.4
(classify-error (logandc2 0)) (signals-error (logandc2 0) program-error)
program-error) t)
(deftest logandc2.error.5 (deftest logandc2.error.5
(classify-error (logandc2 1 2 3)) (signals-error (logandc2 1 2 3) program-error)
program-error) t)
;;; Non-error tests
(deftest logandc2.1 (deftest logandc2.1
(logandc2 0 0) (logandc2 0 0)
......
...@@ -7,29 +7,33 @@ ...@@ -7,29 +7,33 @@
(compile-and-load "numbers-aux.lsp") (compile-and-load "numbers-aux.lsp")
;;; Error tests
(deftest logbitp.error.1 (deftest logbitp.error.1
(classify-error (logbitp)) (signals-error (logbitp) program-error)
program-error) t)
(deftest logbitp.error.2 (deftest logbitp.error.2
(classify-error (logbitp 0)) (signals-error (logbitp 0) program-error)
program-error) t)
(deftest logbitp.error.3 (deftest logbitp.error.3
(classify-error (logbitp 0 0 0)) (signals-error (logbitp 0 0 0) program-error)
program-error) t)
(deftest logbitp.error.4 (deftest logbitp.error.4
(classify-error (logbitp -1 0)) (signals-error (logbitp -1 0) type-error)
type-error) t)
(deftest logbitp.error.5 (deftest logbitp.error.5
(loop for x in *mini-universe* (loop for x in *mini-universe*
unless (or (integerp x) unless (or (integerp x)
(eq (eval `(classify-error (logbitp 0 ',x))) 'type-error)) (eval `(signals-error (logbitp 0 ',x) type-error)))
collect x) collect x)
nil) nil)
;;; Non-error tests
(deftest logbitp.1 (deftest logbitp.1
(loop for x in *integers* (loop for x in *integers*
unless (if (logbitp 0 x) (oddp x) (evenp x)) unless (if (logbitp 0 x) (oddp x) (evenp x))
......