Skip to content
Snippets Groups Projects
Commit a48cda76 authored by pfdietz's avatar pfdietz
Browse files

Changed classify-error forms to signals-error forms.

parent a909e274
No related branches found
No related tags found
No related merge requests found
Showing
with 155 additions and 147 deletions
......@@ -1490,14 +1490,14 @@ the condition to go uncaught if it cannot be classified."
(assert (symbolp macro-name))
`(deftest ,test-name
(values
(eqlt (classify-error (funcall (macro-function ',macro-name)))
'program-error)
(eqlt (classify-error (funcall (macro-function ',macro-name)
',macro-form))
'program-error)
(eqlt (classify-error (funcall (macro-function ',macro-name)
',macro-form nil nil))
'program-error))
(signals-error (funcall (macro-function ',macro-name))
program-error)
(signals-error (funcall (macro-function ',macro-name)
',macro-form)
program-error)
(signals-error (funcall (macro-function ',macro-name)
',macro-form nil nil)
program-error))
t t t)))
(defun typep* (element type)
......
......@@ -7,13 +7,24 @@
(compile-and-load "numbers-aux.lsp")
;;; Error tests
(deftest oddp.error.1
(classify-error (oddp))
program-error)
(signals-error (oddp) program-error)
t)
(deftest oddp.error.2
(classify-error (oddp 0 nil))
program-error)
(signals-error (oddp 0 nil) 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
(loop for x in *numbers*
......@@ -21,13 +32,6 @@
do (oddp x))
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
(loop for x = (random-fixnum)
repeat 10000
......
......@@ -7,17 +7,21 @@
(compile-and-load "numbers-aux.lsp")
;;; Error tests
(deftest 1-.error.1
(classify-error (1-))
program-error)
(signals-error (1-) program-error)
t)
(deftest 1-.error.2
(classify-error (1- 0 0))
program-error)
(signals-error (1- 0 0) program-error)
t)
(deftest 1-.error.3
(classify-error (1- 0 nil nil))
program-error)
(signals-error (1- 0 nil nil) program-error)
t)
;;; Non-error tests
(deftest 1-.1
(loop for x = (random-fixnum)
......
......@@ -42,17 +42,16 @@
;;; error tests
(deftest open-stream-p.error.1
(classify-error (open-stream-p))
program-error)
(signals-error (open-stream-p) program-error)
t)
(deftest open-stream-p.error.2
(classify-error (open-stream-p *standard-input* nil))
program-error)
(signals-error (open-stream-p *standard-input* nil) program-error)
t)
(deftest open-stream-p.error.3
(loop for x in *mini-universe*
unless (or (typep x 'stream)
(eql (eval `(classify-error (open-stream-p ',x)))
'type-error))
(eval `(signals-error (open-stream-p ',x) type-error)))
collect x)
nil)
......@@ -42,18 +42,13 @@
1 nil 2)
(deftest or.error.1
(classify-error (funcall (macro-function 'or)))
program-error)
(signals-error (funcall (macro-function 'or)) program-error)
t)
(deftest or.error.2
(classify-error (funcall (macro-function 'or)
'(or)))
program-error)
(signals-error (funcall (macro-function 'or) '(or)) program-error)
t)
(deftest or.error.3
(classify-error (funcall (macro-function 'or)
'(or) nil nil))
program-error)
(signals-error (funcall (macro-function 'or) '(or) nil nil) program-error)
t)
......@@ -27,20 +27,16 @@
;;; Error tests
(deftest output-stream-p.error.1
(classify-error (output-stream-p))
program-error)
(signals-error (output-stream-p) program-error)
t)
(deftest output-stream-p.error.2
(classify-error (output-stream-p *standard-output* nil))
program-error)
(signals-error (output-stream-p *standard-output* nil) program-error)
t)
(deftest output-stream-p.error.3
(loop for x in *mini-universe*
unless (or (typep x 'stream)
(eq (eval `(classify-error (output-stream-p ',x)))
'type-error))
(eval `(signals-error (output-stream-p ',x) 'type-error)))
collect x)
nil)
......@@ -84,9 +84,9 @@
car 2 1 2)
(deftest find-symbol.error.1
(classify-error (find-symbol))
program-error)
(signals-error (find-symbol) program-error)
t)
(deftest find-symbol.error.2
(classify-error (find-symbol "CAR" "CL" nil))
program-error)
\ No newline at end of file
(signals-error (find-symbol "CAR" "CL" nil) program-error)
t)
......@@ -83,9 +83,9 @@
t)
(deftest find-package.error.1
(classify-error (find-package))
program-error)
(signals-error (find-package) program-error)
t)
(deftest find-package.error.2
(classify-error (find-package "CL" nil))
program-error)
(signals-error (find-package "CL" nil) program-error)
t)
......@@ -41,8 +41,8 @@
t)
(deftest list-all-packages.error.1
(classify-error (list-all-packages nil))
program-error)
(signals-error (list-all-packages nil) program-error)
t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
......@@ -65,18 +65,30 @@
"A")
(deftest package-name.5
(notnot-mv (member (classify-error (package-name "NOT-THERE"))
'(type-error package-error)))
(handler-case
(locally (declare (optimize safety))
(eval '(package-name "NOT-THERE"))
nil)
(type-error () t)
(package-error () t))
t)
(deftest package-name.6
(notnot-mv (member (classify-error (package-name #\*))
'(type-error package-error)))
(handler-case
(locally (declare (optimize safety))
(eval '(package-name #\*))
nil)
(type-error () t)
(package-error () t))
t)
(deftest package-name.6a
(notnot-mv (member (classify-error (locally (package-name #\*) t))
'(type-error package-error)))
(handler-case
(locally (declare (optimize safety))
(eval '(locally (package-name #\*) t))
nil)
(type-error () t)
(package-error () t))
t)
(deftest package-name.7
......@@ -132,12 +144,12 @@
0)
(deftest package-name.error.1
(classify-error (package-name))
program-error)
(signals-error (package-name) program-error)
t)
(deftest package-name.error.2
(classify-error (package-name "CL" nil))
program-error)
(signals-error (package-name "CL" nil) program-error)
t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; package-nicknames
......@@ -184,20 +196,24 @@
t)
(deftest package-nicknames.9
(classify-error (package-nicknames 10))
type-error)
(signals-error (package-nicknames 10) type-error)
t)
(deftest package-nicknames.9a
(classify-error (locally (package-nicknames 10) t))
type-error)
(signals-error (locally (package-nicknames 10) t) type-error)
t)
(deftest package-nicknames.10
(let () (ignore-errors (package-nicknames (find-package "A"))))
("Q"))
(deftest package-nicknames.11
(notnot-mv (member (classify-error (package-nicknames "NOT-A-PACKAGE-NAME"))
'(type-error package-error)))
(handler-case
(locally (declare (optimize safety))
(eval '(package-nicknames "NOT-A-PACKAGE-NAME"))
nil)
(type-error () t)
(package-error () t))
t)
......@@ -214,9 +230,9 @@
0)
(deftest package-nicknames.error.1
(classify-error (package-nicknames))
program-error)
(signals-error (package-nicknames) program-error)
t)
(deftest package-nicknames.error.2
(classify-error (package-nicknames "CL" nil))
program-error)
(signals-error (package-nicknames "CL" nil) program-error)
t)
......@@ -64,9 +64,9 @@
t)
(deftest intern.error.1
(classify-error (intern))
program-error)
(signals-error (intern) program-error)
t)
(deftest intern.error.2
(classify-error (intern "X" "CL" nil))
program-error)
(signals-error (intern "X" "CL" nil) program-error)
t)
......@@ -99,12 +99,9 @@
caught)
(deftest export.error.1
(classify-error (export))
program-error)
(signals-error (export) program-error)
t)
(deftest export.error.2
(classify-error (export 'X "CL-TEST" NIL))
program-error)
(signals-error (export 'X "CL-TEST" NIL) program-error)
t)
......@@ -161,16 +161,13 @@
t)
(deftest rename-package.error.1
(classify-error (rename-package))
program-error)
(signals-error (rename-package) program-error)
t)
(deftest rename-package.error.2
(classify-error (rename-package "CL"))
program-error)
(signals-error (rename-package "CL") program-error)
t)
(deftest rename-package.error.3
(classify-error (rename-package "A" "XXXXX" NIL NIL))
program-error)
(signals-error (rename-package "A" "XXXXX" NIL NIL) program-error)
t)
......@@ -223,9 +223,9 @@
(2 1 2 "X" :internal "Y" :internal 2))
(deftest shadow.error.1
(classify-error (shadow))
program-error)
(signals-error (shadow) program-error)
t)
(deftest shadow.error.2
(classify-error (shadow "X" "CL-USER" nil))
program-error)
(signals-error (shadow "X" "CL-USER" nil) program-error)
t)
......@@ -136,13 +136,13 @@
t)
(deftest delete-package.error.1
(classify-error (delete-package))
program-error)
(signals-error (delete-package) program-error)
t)
(deftest delete-package.error.2
(progn
(unless (find-package "TEST-DPE2")
(make-package "TEST-DPE2" :use nil))
(classify-error (delete-package "TEST-DPE2" nil)))
program-error)
(signals-error (delete-package "TEST-DPE2" nil)
program-error))
t)
......@@ -265,7 +265,7 @@
(deftest make-package.error.1
(handle-non-abort-restart (make-package "A"))
success)
success)
(deftest make-package.error.2
(handle-non-abort-restart (make-package "Q"))
......@@ -284,41 +284,42 @@
success)
(deftest make-package.error.5
(classify-error (make-package))
program-error)
(signals-error (make-package) program-error)
t)
(deftest make-package.error.6
(progn
(safely-delete-package "MPE6")
(classify-error (make-package "MPE6" :bad t)))
program-error)
(signals-error (make-package "MPE6" :bad t) program-error))
t)
(deftest make-package.error.7
(progn
(safely-delete-package "MPE7")
(classify-error (make-package "MPE7" :nicknames)))
program-error)
(signals-error (make-package "MPE7" :nicknames) program-error))
t)
(deftest make-package.error.8
(progn
(safely-delete-package "MPE8")
(classify-error (make-package "MPE8" :use)))
program-error)
(signals-error (make-package "MPE8" :use) program-error))
t)
(deftest make-package.error.9
(progn
(safely-delete-package "MPE9")
(classify-error (make-package "MPE9" 'bad t)))
program-error)
(signals-error (make-package "MPE9" 'bad t) program-error))
t)
(deftest make-package.error.10
(progn
(safely-delete-package "MPE10")
(classify-error (make-package "MPE10" 1 2)))
program-error)
(signals-error (make-package "MPE10" 1 2) program-error))
t)
(deftest make-package.error.11
(progn
(safely-delete-package "MPE11")
(classify-error (make-package "MPE11" 'bad t :allow-other-keys nil)))
program-error)
(signals-error (make-package "MPE11" 'bad t :allow-other-keys nil)
program-error))
t)
......@@ -73,8 +73,6 @@
;;; whether with-package-iterator should signal the error
;;; 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
(handler-case (macroexpand-1
......
......@@ -108,12 +108,13 @@
;; an inaccessible symbol
(deftest unexport.5
(classify-error
(signals-error
(progn
(when (find-package "X") (delete-package "X"))
(unexport 'a (make-package "X" :use nil))
nil))
package-error)
nil)
package-error)
t)
;; Check that internal symbols are left alone
......@@ -134,10 +135,9 @@
t)
(deftest unexport.error.1
(classify-error (unexport))
program-error)
(signals-error (unexport) program-error)
t)
(deftest unexport.error.2
(classify-error (unexport 'xyz "CL-TEST" nil))
program-error)
(signals-error (unexport 'xyz "CL-TEST" nil) program-error)
t)
......@@ -239,9 +239,9 @@
t)
(deftest unintern.error.1
(classify-error (unintern))
program-error)
(signals-error (unintern) program-error)
t)
(deftest unintern.error.2
(classify-error (unintern '#:x "CL-TEST" nil))
program-error)
(signals-error (unintern '#:x "CL-TEST" nil) program-error)
t)
......@@ -188,8 +188,8 @@
t)
(deftest unuse-package.error.1
(classify-error (unuse-package))
program-error)
(signals-error (unuse-package) program-error)
t)
(deftest unuse-package.error.2
(progn
......@@ -197,5 +197,5 @@
(safely-delete-package "UPE2")
(make-package "UPE2" :use ())
(make-package "UPE2A" :use '("UPE2"))
(classify-error (unuse-package "UPE2" "UPE2A" nil)))
program-error)
(signals-error (unuse-package "UPE2" "UPE2A" nil) program-error))
t)
......@@ -197,8 +197,8 @@
;; Also: need to check that *PACKAGE* is used as a default
(deftest use-package.error.1
(classify-error (use-package))
program-error)
(signals-error (use-package) program-error)
t)
(deftest use-package.error.2
(progn
......@@ -206,5 +206,6 @@
(safely-delete-package "UPE2")
(make-package "UPE2" :use ())
(make-package "UPE2A" :use ())
(classify-error (use-package "UPE2" "UPE2A" nil)))
program-error)
(signals-error (use-package "UPE2" "UPE2A" nil) program-error))
t)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment