Commit a48cda76 authored by pfdietz's avatar pfdietz

Changed classify-error forms to signals-error forms.

parent a909e274
......@@ -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)
......@@ -370,19 +370,21 @@
(deftest defpackage.13
(progn
(safely-delete-package "H")
(classify-error
(eval '(defpackage "H" (:use) (:size 10) (:size 20)))))
program-error)
(signals-error
(defpackage "H" (:use) (:size 10) (:size 20))
program-error))
t)
;; Repeated documentation field should cause a program-error
(deftest defpackage.14
(progn
(safely-delete-package "H")
(classify-error
(eval '(defpackage "H" (:use)
(:documentation "foo")
(:documentation "bar")))))
program-error)
(signals-error
(defpackage "H" (:use)
(:documentation "foo")
(:documentation "bar"))
program-error))
t)
;; When a nickname refers to an existing package or nickname,
;; signal a package-error
......@@ -390,18 +392,18 @@
(deftest defpackage.15
(progn
(safely-delete-package "H")
(classify-error
(eval '(defpackage "H" (:use)
(:nicknames "A")))))
package-error)
(signals-error
(defpackage "H" (:use) (:nicknames "A"))
package-error))
t)
(deftest defpackage.16
(progn
(safely-delete-package "H")
(classify-error
(eval '(defpackage "H" (:use)
(:nicknames "Q")))))
package-error)
(signals-error
(defpackage "H" (:use) (:nicknames "Q"))
package-error))
t)
;; Names in :shadow, :shadowing-import-from, :import-from, and :intern
;; must be disjoint, or a package-error is signalled.
......@@ -412,11 +414,12 @@
(safely-delete-package "H")
(safely-delete-package "G")
(eval '(defpackage "G" (:use) (:export "A")))
(classify-error
(eval '(defpackage "H" (:use)
(:shadow "A")
(:shadowing-import-from "G" "A")))))
program-error)
(signals-error
(defpackage "H" (:use)
(:shadow "A")
(:shadowing-import-from "G" "A"))
program-error))
t)
;; :shadow and :import-from
(deftest defpackage.18
......@@ -424,21 +427,23 @@
(safely-delete-package "H")
(safely-delete-package "G")
(eval '(defpackage "G" (:use) (:export "A")))
(classify-error
(eval '(defpackage "H" (:use)
(:shadow "A")
(:import-from "G" "A")))))
program-error)
(signals-error
(defpackage "H" (:use)
(:shadow "A")
(:import-from "G" "A"))
program-error))
t)
;; :shadow and :intern
(deftest defpackage.19
(progn
(safely-delete-package "H")
(classify-error
(eval '(defpackage "H" (:use)
(:shadow "A")
(:intern "A")))))
program-error)
(signals-error
(defpackage "H" (:use)
(:shadow "A")
(:intern "A"))
program-error))
t)
;; :shadowing-import-from and :import-from
(deftest defpackage.20
......@@ -446,11 +451,12 @@
(safely-delete-package "H")
(safely-delete-package "G")
(eval '(defpackage "G" (:use) (:export "A")))
(classify-error
(eval '(defpackage "H" (:use)
(:shadowing-import-from "G" "A")
(:import-from "G" "A")))))
program-error)
(signals-error
(defpackage "H" (:use)
(:shadowing-import-from "G" "A")
(:import-from "G" "A"))
program-error))
t)
;; :shadowing-import-from and :intern
(deftest defpackage.21
......@@ -458,11 +464,12 @@
(safely-delete-package "H")
(safely-delete-package "G")
(eval '(defpackage "G" (:use) (:export "A")))
(classify-error
(eval '(defpackage "H" (:use)
(:shadowing-import-from "G" "A")
(:intern "A")))))
program-error)
(signals-error
(defpackage "H" (:use)
(:shadowing-import-from "G" "A")
(:intern "A"))
program-error))
t)
;; :import-from and :intern
(deftest defpackage.22
......@@ -470,22 +477,24 @@
(safely-delete-package "H")
(safely-delete-package "G")
(eval '(defpackage "G" (:use) (:export "A")))
(classify-error
(eval '(defpackage "H" (:use)
(:import-from "G" "A")
(:intern "A")))))
program-error)
(signals-error
(defpackage "H" (:use)
(:import-from "G" "A")
(:intern "A"))
program-error))
t)
;; Names given to :export and :intern must be disjoint,
;; otherwise signal a program-error
(deftest defpackage.23
(progn
(safely-delete-package "H")
(classify-error
(eval '(defpackage "H" (:use)
(:export "A")
(:intern "A")))))
program-error)
(signals-error
(defpackage "H" (:use)
(:export "A")
(:intern "A"))
program-error))
t)
;; :shadowing-import-from signals a correctable package-error
;; if the symbol is not accessible in the named package
......
......@@ -29,12 +29,12 @@
nil)
(deftest packagep.error.1
(classify-error (packagep))
program-error)
(signals-error (packagep) program-error)
t)
(deftest packagep.error.2
(classify-error (packagep nil nil))
program-error)
(signals-error (packagep nil nil) program-error)
t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; package-error
......@@ -95,12 +95,14 @@
t)
(deftest package-error-package.error.1
(classify-error (package-error-package))
program-error)
(signals-error (package-error-package) program-error)
t)
(deftest package-error-package.error.2
(classify-error
(signals-error
(package-error-package
(make-condition 'package-error :package #\A)
nil))
program-error)
nil)
program-error)
t)