Commit a48cda76 authored by pfdietz's avatar pfdietz
Browse files

Changed classify-error forms to signals-error forms.

parent a909e274
...@@ -1490,14 +1490,14 @@ the condition to go uncaught if it cannot be classified." ...@@ -1490,14 +1490,14 @@ the condition to go uncaught if it cannot be classified."
(assert (symbolp macro-name)) (assert (symbolp macro-name))
`(deftest ,test-name `(deftest ,test-name
(values (values
(eqlt (classify-error (funcall (macro-function ',macro-name))) (signals-error (funcall (macro-function ',macro-name))
'program-error) program-error)
(eqlt (classify-error (funcall (macro-function ',macro-name) (signals-error (funcall (macro-function ',macro-name)
',macro-form)) ',macro-form)
'program-error) program-error)
(eqlt (classify-error (funcall (macro-function ',macro-name) (signals-error (funcall (macro-function ',macro-name)
',macro-form nil nil)) ',macro-form nil nil)
'program-error)) program-error))
t t t))) t t t)))
(defun typep* (element type) (defun typep* (element type)
......
...@@ -7,13 +7,24 @@ ...@@ -7,13 +7,24 @@
(compile-and-load "numbers-aux.lsp") (compile-and-load "numbers-aux.lsp")
;;; Error tests
(deftest oddp.error.1 (deftest oddp.error.1
(classify-error (oddp)) (signals-error (oddp) program-error)
program-error) t)
(deftest oddp.error.2 (deftest oddp.error.2
(classify-error (oddp 0 nil)) (signals-error (oddp 0 nil) program-error)
program-error) t)
(deftest oddp.error.3
(loop for x in *mini-universe*
unless (or (integerp x)
(eval `(signals-error (oddp ',x) type-error)))
collect x)
nil)
;;; Non-error tests
(deftest oddp.1 (deftest oddp.1
(loop for x in *numbers* (loop for x in *numbers*
...@@ -21,13 +32,6 @@ ...@@ -21,13 +32,6 @@
do (oddp x)) do (oddp x))
nil) nil)
(deftest oddp.2
(loop for x in *mini-universe*
unless (or (integerp x)
(eq (classify-error** `(oddp (quote ,x))) 'type-error))
collect x)
nil)
(deftest oddp.3 (deftest oddp.3
(loop for x = (random-fixnum) (loop for x = (random-fixnum)
repeat 10000 repeat 10000
......
...@@ -7,17 +7,21 @@ ...@@ -7,17 +7,21 @@
(compile-and-load "numbers-aux.lsp") (compile-and-load "numbers-aux.lsp")
;;; Error tests
(deftest 1-.error.1 (deftest 1-.error.1
(classify-error (1-)) (signals-error (1-) program-error)
program-error) t)
(deftest 1-.error.2 (deftest 1-.error.2
(classify-error (1- 0 0)) (signals-error (1- 0 0) program-error)
program-error) t)
(deftest 1-.error.3 (deftest 1-.error.3
(classify-error (1- 0 nil nil)) (signals-error (1- 0 nil nil) program-error)
program-error) t)
;;; Non-error tests
(deftest 1-.1 (deftest 1-.1
(loop for x = (random-fixnum) (loop for x = (random-fixnum)
......
...@@ -42,17 +42,16 @@ ...@@ -42,17 +42,16 @@
;;; error tests ;;; error tests
(deftest open-stream-p.error.1 (deftest open-stream-p.error.1
(classify-error (open-stream-p)) (signals-error (open-stream-p) program-error)
program-error) t)
(deftest open-stream-p.error.2 (deftest open-stream-p.error.2
(classify-error (open-stream-p *standard-input* nil)) (signals-error (open-stream-p *standard-input* nil) program-error)
program-error) t)
(deftest open-stream-p.error.3 (deftest open-stream-p.error.3
(loop for x in *mini-universe* (loop for x in *mini-universe*
unless (or (typep x 'stream) unless (or (typep x 'stream)
(eql (eval `(classify-error (open-stream-p ',x))) (eval `(signals-error (open-stream-p ',x) type-error)))
'type-error))
collect x) collect x)
nil) nil)
...@@ -42,18 +42,13 @@ ...@@ -42,18 +42,13 @@
1 nil 2) 1 nil 2)
(deftest or.error.1 (deftest or.error.1
(classify-error (funcall (macro-function 'or))) (signals-error (funcall (macro-function 'or)) program-error)
program-error) t)
(deftest or.error.2 (deftest or.error.2
(classify-error (funcall (macro-function 'or) (signals-error (funcall (macro-function 'or) '(or)) program-error)
'(or))) t)
program-error)
(deftest or.error.3 (deftest or.error.3
(classify-error (funcall (macro-function 'or) (signals-error (funcall (macro-function 'or) '(or) nil nil) program-error)
'(or) nil nil)) t)
program-error)
...@@ -27,20 +27,16 @@ ...@@ -27,20 +27,16 @@
;;; Error tests ;;; Error tests
(deftest output-stream-p.error.1 (deftest output-stream-p.error.1
(classify-error (output-stream-p)) (signals-error (output-stream-p) program-error)
program-error) t)
(deftest output-stream-p.error.2 (deftest output-stream-p.error.2
(classify-error (output-stream-p *standard-output* nil)) (signals-error (output-stream-p *standard-output* nil) program-error)
program-error) t)
(deftest output-stream-p.error.3 (deftest output-stream-p.error.3
(loop for x in *mini-universe* (loop for x in *mini-universe*
unless (or (typep x 'stream) unless (or (typep x 'stream)
(eq (eval `(classify-error (output-stream-p ',x))) (eval `(signals-error (output-stream-p ',x) 'type-error)))
'type-error))
collect x) collect x)
nil) nil)
...@@ -84,9 +84,9 @@ ...@@ -84,9 +84,9 @@
car 2 1 2) car 2 1 2)
(deftest find-symbol.error.1 (deftest find-symbol.error.1
(classify-error (find-symbol)) (signals-error (find-symbol) program-error)
program-error) t)
(deftest find-symbol.error.2 (deftest find-symbol.error.2
(classify-error (find-symbol "CAR" "CL" nil)) (signals-error (find-symbol "CAR" "CL" nil) program-error)
program-error) t)
\ No newline at end of file
...@@ -83,9 +83,9 @@ ...@@ -83,9 +83,9 @@
t) t)
(deftest find-package.error.1 (deftest find-package.error.1
(classify-error (find-package)) (signals-error (find-package) program-error)
program-error) t)
(deftest find-package.error.2 (deftest find-package.error.2
(classify-error (find-package "CL" nil)) (signals-error (find-package "CL" nil) program-error)
program-error) t)
...@@ -41,8 +41,8 @@ ...@@ -41,8 +41,8 @@
t) t)
(deftest list-all-packages.error.1 (deftest list-all-packages.error.1
(classify-error (list-all-packages nil)) (signals-error (list-all-packages nil) program-error)
program-error) t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
...@@ -65,18 +65,30 @@ ...@@ -65,18 +65,30 @@
"A") "A")
(deftest package-name.5 (deftest package-name.5
(notnot-mv (member (classify-error (package-name "NOT-THERE")) (handler-case
'(type-error package-error))) (locally (declare (optimize safety))
(eval '(package-name "NOT-THERE"))
nil)
(type-error () t)
(package-error () t))
t) t)
(deftest package-name.6 (deftest package-name.6
(notnot-mv (member (classify-error (package-name #\*)) (handler-case
'(type-error package-error))) (locally (declare (optimize safety))
(eval '(package-name #\*))
nil)
(type-error () t)
(package-error () t))
t) t)
(deftest package-name.6a (deftest package-name.6a
(notnot-mv (member (classify-error (locally (package-name #\*) t)) (handler-case
'(type-error package-error))) (locally (declare (optimize safety))
(eval '(locally (package-name #\*) t))
nil)
(type-error () t)
(package-error () t))
t) t)
(deftest package-name.7 (deftest package-name.7
...@@ -132,12 +144,12 @@ ...@@ -132,12 +144,12 @@
0) 0)
(deftest package-name.error.1 (deftest package-name.error.1
(classify-error (package-name)) (signals-error (package-name) program-error)
program-error) t)
(deftest package-name.error.2 (deftest package-name.error.2
(classify-error (package-name "CL" nil)) (signals-error (package-name "CL" nil) program-error)
program-error) t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; package-nicknames ;;; package-nicknames
...@@ -184,20 +196,24 @@ ...@@ -184,20 +196,24 @@
t) t)
(deftest package-nicknames.9 (deftest package-nicknames.9
(classify-error (package-nicknames 10)) (signals-error (package-nicknames 10) type-error)
type-error) t)
(deftest package-nicknames.9a (deftest package-nicknames.9a
(classify-error (locally (package-nicknames 10) t)) (signals-error (locally (package-nicknames 10) t) type-error)
type-error) t)
(deftest package-nicknames.10 (deftest package-nicknames.10
(let () (ignore-errors (package-nicknames (find-package "A")))) (let () (ignore-errors (package-nicknames (find-package "A"))))
("Q")) ("Q"))
(deftest package-nicknames.11 (deftest package-nicknames.11
(notnot-mv (member (classify-error (package-nicknames "NOT-A-PACKAGE-NAME")) (handler-case
'(type-error package-error))) (locally (declare (optimize safety))
(eval '(package-nicknames "NOT-A-PACKAGE-NAME"))
nil)
(type-error () t)
(package-error () t))
t) t)
...@@ -214,9 +230,9 @@ ...@@ -214,9 +230,9 @@
0) 0)
(deftest package-nicknames.error.1 (deftest package-nicknames.error.1
(classify-error (package-nicknames)) (signals-error (package-nicknames) program-error)
program-error) t)
(deftest package-nicknames.error.2 (deftest package-nicknames.error.2
(classify-error (package-nicknames "CL" nil)) (signals-error (package-nicknames "CL" nil) program-error)
program-error) t)
...@@ -64,9 +64,9 @@ ...@@ -64,9 +64,9 @@
t) t)
(deftest intern.error.1 (deftest intern.error.1
(classify-error (intern)) (signals-error (intern) program-error)
program-error) t)
(deftest intern.error.2 (deftest intern.error.2
(classify-error (intern "X" "CL" nil)) (signals-error (intern "X" "CL" nil) program-error)
program-error) t)
...@@ -99,12 +99,9 @@ ...@@ -99,12 +99,9 @@
caught) caught)
(deftest export.error.1 (deftest export.error.1
(classify-error (export)) (signals-error (export) program-error)
program-error) t)
(deftest export.error.2 (deftest export.error.2
(classify-error (export 'X "CL-TEST" NIL)) (signals-error (export 'X "CL-TEST" NIL) program-error)
program-error) t)
...@@ -161,16 +161,13 @@ ...@@ -161,16 +161,13 @@
t) t)
(deftest rename-package.error.1 (deftest rename-package.error.1
(classify-error (rename-package)) (signals-error (rename-package) program-error)
program-error) t)
(deftest rename-package.error.2 (deftest rename-package.error.2
(classify-error (rename-package "CL")) (signals-error (rename-package "CL") program-error)
program-error) t)
(deftest rename-package.error.3 (deftest rename-package.error.3
(classify-error (rename-package "A" "XXXXX" NIL NIL)) (signals-error (rename-package "A" "XXXXX" NIL NIL) program-error)
program-error) t)
...@@ -223,9 +223,9 @@ ...@@ -223,9 +223,9 @@
(2 1 2 "X" :internal "Y" :internal 2)) (2 1 2 "X" :internal "Y" :internal 2))
(deftest shadow.error.1 (deftest shadow.error.1
(classify-error (shadow)) (signals-error (shadow) program-error)
program-error) t)
(deftest shadow.error.2 (deftest shadow.error.2
(classify-error (shadow "X" "CL-USER" nil)) (signals-error (shadow "X" "CL-USER" nil) program-error)
program-error) t)
...@@ -136,13 +136,13 @@ ...@@ -136,13 +136,13 @@
t) t)
(deftest delete-package.error.1 (deftest delete-package.error.1
(classify-error (delete-package)) (signals-error (delete-package) program-error)
program-error) t)
(deftest delete-package.error.2 (deftest delete-package.error.2
(progn (progn
(unless (find-package "TEST-DPE2") (unless (find-package "TEST-DPE2")
(make-package "TEST-DPE2" :use nil)) (make-package "TEST-DPE2" :use nil))
(classify-error (delete-package "TEST-DPE2" nil))) (signals-error (delete-package "TEST-DPE2" nil)
program-error) program-error))
t)
...@@ -265,7 +265,7 @@ ...@@ -265,7 +265,7 @@
(deftest make-package.error.1 (deftest make-package.error.1
(handle-non-abort-restart (make-package "A")) (handle-non-abort-restart (make-package "A"))
success) success)
(deftest make-package.error.2 (deftest make-package.error.2
(handle-non-abort-restart (make-package "Q")) (handle-non-abort-restart (make-package "Q"))
...@@ -284,41 +284,42 @@ ...@@ -284,41 +284,42 @@
success) success)
(deftest make-package.error.5 (deftest make-package.error.5
(classify-error (make-package)) (signals-error (make-package) program-error)
program-error) t)
(deftest make-package.error.6 (deftest make-package.error.6
(progn (progn
(safely-delete-package "MPE6") (safely-delete-package "MPE6")
(classify-error (make-package "MPE6" :bad t))) (signals-error (make-package "MPE6" :bad t) program-error))
program-error) t)
(deftest make-package.error.7 (deftest make-package.error.7
(progn (progn
(safely-delete-package "MPE7") (safely-delete-package "MPE7")
(classify-error (make-package "MPE7" :nicknames))) (signals-error (make-package "MPE7" :nicknames) program-error))
program-error) t)
(deftest make-package.error.8 (deftest make-package.error.8
(progn (progn
(safely-delete-package "MPE8") (safely-delete-package "MPE8")
(classify-error (make-package "MPE8" :use))) (signals-error (make-package "MPE8" :use) program-error))
program-error) t)
(deftest make-package.error.9 (deftest make-package.error.9
(progn (progn
(safely-delete-package "MPE9") (safely-delete-package "MPE9")
(classify-error (make-package "MPE9" 'bad t))) (signals-error (make-package "MPE9" 'bad t) program-error))
program-error) t)
(deftest make-package.error.10 (deftest make-package.error.10
(progn (progn
(safely-delete-package "MPE10") (safely-delete-package "MPE10")
(classify-error (make-package "MPE10" 1 2))) (signals-error (make-package "MPE10" 1 2) program-error))
program-error) t)
(deftest make-package.error.11 (deftest make-package.error.11
(progn (progn
(safely-delete-package "MPE11") (safely-delete-package "MPE11")
(classify-error (make-package "MPE11" 'bad t :allow-other-keys nil))) (signals-error (make-package "MPE11" 'bad t :allow-other-keys nil)
program-error) program-error))
t)
...@@ -73,8 +73,6 @@ ...@@ -73,8 +73,6 @@
;;; whether with-package-iterator should signal the error ;;; whether with-package-iterator should signal the error
;;; at macro expansion time or at run time. ;;; at macro expansion time or at run time.
;; ;;
;;; PFD 01-18-03: I should rewrite this to use CLASSIFY-ERROR, which
;;; uses EVAL to avoid that problem.
(deftest with-package-iterator.11 (deftest with-package-iterator.11
(handler-case (macroexpand-1 (handler-case (macroexpand-1
......
...@@ -108,12 +108,13 @@ ...@@ -108,12 +108,13 @@
;; an inaccessible symbol ;; an inaccessible symbol
(deftest unexport.5 (deftest unexport.5
(classify-error (signals-error
(progn (progn
(when (find-package "X") (delete-package "X")) (when (find-package "X") (delete-package "X"))
(unexport 'a (make-package "X" :use nil)) (unexport 'a (make-package "X" :use nil))
nil)) nil)
package-error) package-error)
t)
;; Check that internal symbols are left alone ;; Check that internal symbols are left alone
...@@ -134,10 +135,9 @@ ...@@ -134,10 +135,9 @@
t) t)
(deftest unexport.error.1 (deftest unexport.error.1
(classify-error (unexport)) (signals-error (unexport) program-error)
program-error) t)
(deftest unexport.error.2 (deftest unexport.error.2
(classify-error (unexport 'xyz "CL-TEST" nil)) (signals-error (unexport 'xyz "CL-TEST" nil) program-error)
program-error) t)
...@@ -239,9 +239,9 @@ ...@@ -239,9 +239,9 @@
t)