From a48cda76be7bd722e9dbc5a1391f799308d44192 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sat, 17 Jan 2004 21:27:09 +0000 Subject: [PATCH] Changed classify-error forms to signals-error forms. --- ansi-tests/ansi-aux.lsp | 16 ++--- ansi-tests/oddp.lsp | 26 ++++--- ansi-tests/oneminus.lsp | 16 +++-- ansi-tests/open-stream-p.lsp | 11 ++- ansi-tests/or.lsp | 17 ++--- ansi-tests/output-stream-p.lsp | 14 ++-- ansi-tests/packages-01.lsp | 8 +-- ansi-tests/packages-02.lsp | 8 +-- ansi-tests/packages-03.lsp | 60 ++++++++++------ ansi-tests/packages-04.lsp | 8 +-- ansi-tests/packages-05.lsp | 11 ++- ansi-tests/packages-06.lsp | 15 ++-- ansi-tests/packages-07.lsp | 8 +-- ansi-tests/packages-08.lsp | 10 +-- ansi-tests/packages-09.lsp | 31 +++++---- ansi-tests/packages-10.lsp | 2 - ansi-tests/packages-11.lsp | 16 ++--- ansi-tests/packages-12.lsp | 8 +-- ansi-tests/packages-14.lsp | 8 +-- ansi-tests/packages-15.lsp | 9 +-- ansi-tests/packages-16.lsp | 111 ++++++++++++++++-------------- ansi-tests/packages-18.lsp | 20 +++--- ansi-tests/packages-19.lsp | 25 ++++--- ansi-tests/pairlis.lsp | 25 +++---- ansi-tests/parse-integer.lsp | 64 ++++++++--------- ansi-tests/pathname-device.lsp | 4 +- ansi-tests/pathname-directory.lsp | 4 +- ansi-tests/pathname-host.lsp | 10 +-- ansi-tests/pathname-name.lsp | 4 +- ansi-tests/pathname-type.lsp | 4 +- ansi-tests/pathname-version.lsp | 9 +-- ansi-tests/pathname.lsp | 8 +-- ansi-tests/pathnamep.lsp | 13 ++-- ansi-tests/phase.lsp | 10 +-- ansi-tests/plusp.lsp | 18 +++-- ansi-tests/position-if-not.lsp | 60 ++++++++-------- ansi-tests/position-if.lsp | 62 ++++++++--------- ansi-tests/position.lsp | 61 ++++++++-------- ansi-tests/probe-file.lsp | 16 ++--- ansi-tests/psetq.lsp | 17 +++-- ansi-tests/pushnew.lsp | 21 +++--- 41 files changed, 447 insertions(+), 421 deletions(-) diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index 3af8bc8c..78076aa1 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -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) diff --git a/ansi-tests/oddp.lsp b/ansi-tests/oddp.lsp index 070c4ba1..ee5770ea 100644 --- a/ansi-tests/oddp.lsp +++ b/ansi-tests/oddp.lsp @@ -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 diff --git a/ansi-tests/oneminus.lsp b/ansi-tests/oneminus.lsp index 217c0651..1b786ed5 100644 --- a/ansi-tests/oneminus.lsp +++ b/ansi-tests/oneminus.lsp @@ -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) diff --git a/ansi-tests/open-stream-p.lsp b/ansi-tests/open-stream-p.lsp index 7922db4f..c5a688b3 100644 --- a/ansi-tests/open-stream-p.lsp +++ b/ansi-tests/open-stream-p.lsp @@ -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) diff --git a/ansi-tests/or.lsp b/ansi-tests/or.lsp index d9d965b8..9a3ce48a 100644 --- a/ansi-tests/or.lsp +++ b/ansi-tests/or.lsp @@ -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) diff --git a/ansi-tests/output-stream-p.lsp b/ansi-tests/output-stream-p.lsp index e01e6b30..662f59ef 100644 --- a/ansi-tests/output-stream-p.lsp +++ b/ansi-tests/output-stream-p.lsp @@ -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) - - - diff --git a/ansi-tests/packages-01.lsp b/ansi-tests/packages-01.lsp index f811c79b..a4fb4bbc 100644 --- a/ansi-tests/packages-01.lsp +++ b/ansi-tests/packages-01.lsp @@ -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) diff --git a/ansi-tests/packages-02.lsp b/ansi-tests/packages-02.lsp index 3139da7c..7e927f3c 100644 --- a/ansi-tests/packages-02.lsp +++ b/ansi-tests/packages-02.lsp @@ -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) diff --git a/ansi-tests/packages-03.lsp b/ansi-tests/packages-03.lsp index 86d3972b..b89b2623 100644 --- a/ansi-tests/packages-03.lsp +++ b/ansi-tests/packages-03.lsp @@ -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) diff --git a/ansi-tests/packages-04.lsp b/ansi-tests/packages-04.lsp index 5f5e6b52..b4929a45 100644 --- a/ansi-tests/packages-04.lsp +++ b/ansi-tests/packages-04.lsp @@ -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) diff --git a/ansi-tests/packages-05.lsp b/ansi-tests/packages-05.lsp index 6085e34d..3f434c3f 100644 --- a/ansi-tests/packages-05.lsp +++ b/ansi-tests/packages-05.lsp @@ -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) diff --git a/ansi-tests/packages-06.lsp b/ansi-tests/packages-06.lsp index a1580c6a..50ff97d8 100644 --- a/ansi-tests/packages-06.lsp +++ b/ansi-tests/packages-06.lsp @@ -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) diff --git a/ansi-tests/packages-07.lsp b/ansi-tests/packages-07.lsp index 9d3c0cfa..76504814 100644 --- a/ansi-tests/packages-07.lsp +++ b/ansi-tests/packages-07.lsp @@ -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) diff --git a/ansi-tests/packages-08.lsp b/ansi-tests/packages-08.lsp index 8a237a8d..1c4927d6 100644 --- a/ansi-tests/packages-08.lsp +++ b/ansi-tests/packages-08.lsp @@ -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) diff --git a/ansi-tests/packages-09.lsp b/ansi-tests/packages-09.lsp index 67a86ba1..5d185499 100644 --- a/ansi-tests/packages-09.lsp +++ b/ansi-tests/packages-09.lsp @@ -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) diff --git a/ansi-tests/packages-10.lsp b/ansi-tests/packages-10.lsp index 306b5333..1e8686d2 100644 --- a/ansi-tests/packages-10.lsp +++ b/ansi-tests/packages-10.lsp @@ -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 diff --git a/ansi-tests/packages-11.lsp b/ansi-tests/packages-11.lsp index 71e2cd39..cb70203a 100644 --- a/ansi-tests/packages-11.lsp +++ b/ansi-tests/packages-11.lsp @@ -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) diff --git a/ansi-tests/packages-12.lsp b/ansi-tests/packages-12.lsp index b1614cae..3809c5f0 100644 --- a/ansi-tests/packages-12.lsp +++ b/ansi-tests/packages-12.lsp @@ -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) diff --git a/ansi-tests/packages-14.lsp b/ansi-tests/packages-14.lsp index fe3a9b2a..33c27830 100644 --- a/ansi-tests/packages-14.lsp +++ b/ansi-tests/packages-14.lsp @@ -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) diff --git a/ansi-tests/packages-15.lsp b/ansi-tests/packages-15.lsp index c4d24a7f..c4ce7da4 100644 --- a/ansi-tests/packages-15.lsp +++ b/ansi-tests/packages-15.lsp @@ -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) + diff --git a/ansi-tests/packages-16.lsp b/ansi-tests/packages-16.lsp index 209cb0fc..0f95a8c8 100644 --- a/ansi-tests/packages-16.lsp +++ b/ansi-tests/packages-16.lsp @@ -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 diff --git a/ansi-tests/packages-18.lsp b/ansi-tests/packages-18.lsp index 2fd03b2b..a9626867 100644 --- a/ansi-tests/packages-18.lsp +++ b/ansi-tests/packages-18.lsp @@ -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) + diff --git a/ansi-tests/packages-19.lsp b/ansi-tests/packages-19.lsp index be4b3b72..90d3eccc 100644 --- a/ansi-tests/packages-19.lsp +++ b/ansi-tests/packages-19.lsp @@ -36,26 +36,25 @@ ;;; Other error tests (deftest package-shadowing-symbols.error.1 - (classify-error (package-shadowing-symbols)) - program-error) + (signals-error (package-shadowing-symbols) program-error) + t) (deftest package-shadowing-symbols.error.2 - (classify-error (package-shadowing-symbols "CL" nil)) - program-error) + (signals-error (package-shadowing-symbols "CL" nil) program-error) + t) (deftest package-use-list.error.1 - (classify-error (package-use-list)) - program-error) + (signals-error (package-use-list) program-error) + t) (deftest package-use-list.error.2 - (classify-error (package-use-list "CL" nil)) - program-error) + (signals-error (package-use-list "CL" nil) program-error) + t) (deftest package-used-by-list.error.1 - (classify-error (package-used-by-list)) - program-error) + (signals-error (package-used-by-list) program-error) + t) (deftest package-used-by-list.error.2 - (classify-error (package-used-by-list "CL" nil)) - program-error) - + (signals-error (package-used-by-list "CL" nil) program-error) + t) diff --git a/ansi-tests/pairlis.lsp b/ansi-tests/pairlis.lsp index a16f4b70..15e3813b 100644 --- a/ansi-tests/pairlis.lsp +++ b/ansi-tests/pairlis.lsp @@ -62,25 +62,26 @@ t) (deftest pairlis.error.1 - (classify-error (pairlis)) - program-error) + (signals-error (pairlis) program-error) + t) (deftest pairlis.error.2 - (classify-error (pairlis nil)) - program-error) + (signals-error (pairlis nil) program-error) + t) (deftest pairlis.error.3 - (classify-error (pairlis nil nil nil nil)) - program-error) + (signals-error (pairlis nil nil nil nil) program-error) + t) (deftest pairlis.error.4 - (classify-error (pairlis 'a '(1))) - type-error) + (signals-error (pairlis 'a '(1)) type-error) + t) (deftest pairlis.error.5 - (classify-error (pairlis '(a) 'b)) - type-error) + (signals-error (pairlis '(a) 'b) type-error) + t) (deftest pairlis.error.6 - (classify-error (pairlis '(a . b) '(c . d))) - type-error) + (signals-error (pairlis '(a . b) '(c . d)) type-error) + t) + diff --git a/ansi-tests/parse-integer.lsp b/ansi-tests/parse-integer.lsp index 927ba776..d115348e 100644 --- a/ansi-tests/parse-integer.lsp +++ b/ansi-tests/parse-integer.lsp @@ -6,72 +6,72 @@ (in-package :cl-test) (deftest parse-integer.error.1 - (classify-error (parse-integer)) - program-error) + (signals-error (parse-integer) program-error) + t) (deftest parse-integer.error.2 - (classify-error (parse-integer "123" :bogus)) - program-error) + (signals-error (parse-integer "123" :bogus) program-error) + t) (deftest parse-integer.error.3 - (classify-error (parse-integer "123" :bogus 'foo)) - program-error) + (signals-error (parse-integer "123" :bogus 'foo) program-error) + t) (deftest parse-integer.error.4 - (classify-error (parse-integer "")) - parse-error) + (signals-error (parse-integer "") parse-error) + t) (deftest parse-integer.error.5 (loop for x across +standard-chars+ unless (or (digit-char-p x) - (eq (eval `(classify-error (parse-integer ,(string x)))) - 'parse-error)) + (eval `(signals-error (parse-integer ,(string x)) + parse-error))) collect x) nil) (deftest parse-integer.error.5a - (classify-error (parse-integer "")) - parse-error) + (signals-error (parse-integer "") parse-error) + t) (deftest parse-integer.error.6 - (classify-error (parse-integer "1234a")) - parse-error) + (signals-error (parse-integer "1234a") parse-error) + t) (deftest parse-integer.error.7 - (classify-error (parse-integer "-")) - parse-error) + (signals-error (parse-integer "-") parse-error) + t) (deftest parse-integer.error.8 - (classify-error (parse-integer "+")) - parse-error) + (signals-error (parse-integer "+") parse-error) + t) (deftest parse-integer.error.9 - (classify-error (parse-integer "--10")) - parse-error) + (signals-error (parse-integer "--10") parse-error) + t) (deftest parse-integer.error.10 - (classify-error (parse-integer "++10")) - parse-error) + (signals-error (parse-integer "++10") parse-error) + t) (deftest parse-integer.error.11 - (classify-error (parse-integer "10.")) - parse-error) + (signals-error (parse-integer "10.") parse-error) + t) (deftest parse-integer.error.12 - (classify-error (parse-integer "#O123")) - parse-error) + (signals-error (parse-integer "#O123") parse-error) + t) (deftest parse-integer.error.13 - (classify-error (parse-integer "#B0100")) - parse-error) + (signals-error (parse-integer "#B0100") parse-error) + t) (deftest parse-integer.error.14 - (classify-error (parse-integer "#X0100")) - parse-error) + (signals-error (parse-integer "#X0100") parse-error) + t) (deftest parse-integer.error.15 - (classify-error (parse-integer "#3R0100")) - parse-error) + (signals-error (parse-integer "#3R0100") parse-error) + t) ;;; diff --git a/ansi-tests/pathname-device.lsp b/ansi-tests/pathname-device.lsp index 70388391..f53f882d 100644 --- a/ansi-tests/pathname-device.lsp +++ b/ansi-tests/pathname-device.lsp @@ -60,8 +60,8 @@ t) (deftest pathname-device.error.1 - (classify-error (pathname-device)) - program-error) + (signals-error (pathname-device) program-error) + t) (deftest pathname-device.error.2 (loop for x in *mini-universe* diff --git a/ansi-tests/pathname-directory.lsp b/ansi-tests/pathname-directory.lsp index d5145b2b..475b1bd3 100644 --- a/ansi-tests/pathname-directory.lsp +++ b/ansi-tests/pathname-directory.lsp @@ -75,8 +75,8 @@ nil) (deftest pathname-directory.error.1 - (classify-error (pathname-directory)) - program-error) + (signals-error (pathname-directory) program-error) + t) (deftest pathname-directory.error.2 (loop for x in *mini-universe* diff --git a/ansi-tests/pathname-host.lsp b/ansi-tests/pathname-host.lsp index e2380570..7be00d13 100644 --- a/ansi-tests/pathname-host.lsp +++ b/ansi-tests/pathname-host.lsp @@ -47,8 +47,8 @@ nil) (deftest pathname-host.error.1 - (classify-error (pathname-host)) - program-error) + (signals-error (pathname-host) program-error) + t) (deftest pathname-host.error.2 (loop for x in *mini-universe* @@ -60,5 +60,7 @@ nil) (deftest pathname-host.error.3 - (classify-error (pathname-host *default-pathname-defaults* '#:bogus t)) - program-error) + (signals-error (pathname-host *default-pathname-defaults* '#:bogus t) + program-error) + t) + diff --git a/ansi-tests/pathname-name.lsp b/ansi-tests/pathname-name.lsp index 24363e28..e19d9c15 100644 --- a/ansi-tests/pathname-name.lsp +++ b/ansi-tests/pathname-name.lsp @@ -61,8 +61,8 @@ nil) (deftest pathname-name.error.1 - (classify-error (pathname-name)) - program-error) + (signals-error (pathname-name) program-error) + t) (deftest pathname-name.error.2 (loop for x in *mini-universe* diff --git a/ansi-tests/pathname-type.lsp b/ansi-tests/pathname-type.lsp index 1d02292f..14ec0636 100644 --- a/ansi-tests/pathname-type.lsp +++ b/ansi-tests/pathname-type.lsp @@ -61,8 +61,8 @@ nil) (deftest pathname-type.error.1 - (classify-error (pathname-type)) - program-error) + (signals-error (pathname-type) program-error) + t) (deftest pathname-type.error.2 (loop for x in *mini-universe* diff --git a/ansi-tests/pathname-version.lsp b/ansi-tests/pathname-version.lsp index bac0beee..437ae9cd 100644 --- a/ansi-tests/pathname-version.lsp +++ b/ansi-tests/pathname-version.lsp @@ -20,12 +20,13 @@ nil) (deftest pathname-version.error.1 - (classify-error (pathname-version)) - program-error) + (signals-error (pathname-version) program-error) + t) (deftest pathname-version.error.2 - (classify-error (pathname-version *default-pathname-defaults* nil)) - program-error) + (signals-error (pathname-version *default-pathname-defaults* nil) + program-error) + t) (deftest pathname-version.error.3 (loop for x in *mini-universe* diff --git a/ansi-tests/pathname.lsp b/ansi-tests/pathname.lsp index aa9db1bc..f5d64b92 100644 --- a/ansi-tests/pathname.lsp +++ b/ansi-tests/pathname.lsp @@ -34,9 +34,9 @@ ;;; Error tests (deftest pathname.error.1 - (classify-error (pathname)) - program-error) + (signals-error (pathname) program-error) + t) (deftest pathname.error.2 - (classify-error (pathname (first *pathnames*) nil)) - program-error) \ No newline at end of file + (signals-error (pathname (first *pathnames*) nil) program-error) + t) diff --git a/ansi-tests/pathnamep.lsp b/ansi-tests/pathnamep.lsp index a0d315fb..9c6cf01f 100644 --- a/ansi-tests/pathnamep.lsp +++ b/ansi-tests/pathnamep.lsp @@ -24,13 +24,14 @@ t) (deftest pathnamep.error.1 - (classify-error (pathnamep)) - program-error) + (signals-error (pathnamep) program-error) + t) (deftest pathnamep.error.2 - (classify-error (pathnamep nil nil)) - program-error) + (signals-error (pathnamep nil nil) program-error) + t) (deftest pathnamep.error.3 - (classify-error (pathnamep *default-pathname-defaults* nil)) - program-error) + (signals-error (pathnamep *default-pathname-defaults* nil) + program-error) + t) diff --git a/ansi-tests/phase.lsp b/ansi-tests/phase.lsp index 1e3ec54f..21fa1a1b 100644 --- a/ansi-tests/phase.lsp +++ b/ansi-tests/phase.lsp @@ -6,17 +6,17 @@ (in-package :cl-test) (deftest phase.error.1 - (classify-error (phase)) - program-error) + (signals-error (phase) program-error) + t) (deftest phase.error.2 - (classify-error (phase 0 0)) - program-error) + (signals-error (phase 0 0) program-error) + t) (deftest phase.error.3 (loop for x in *mini-universe* unless (or (numberp x) - (eq (eval `(classify-error (phase ',x))) 'type-error)) + (eval `(signals-error (phase ',x) type-error))) collect x) nil) diff --git a/ansi-tests/plusp.lsp b/ansi-tests/plusp.lsp index 69da69e5..9aef592c 100644 --- a/ansi-tests/plusp.lsp +++ b/ansi-tests/plusp.lsp @@ -5,25 +5,29 @@ (in-package :cl-test) +;;; Error tests + (deftest plusp.error.1 - (classify-error (plusp)) - program-error) + (signals-error (plusp) program-error) + t) (deftest plusp.error.2 - (classify-error (plusp 0 0)) - program-error) + (signals-error (plusp 0 0) program-error) + t) (deftest plusp.error.3 - (classify-error (plusp 0 nil)) - program-error) + (signals-error (plusp 0 nil) program-error) + t) (deftest plusp.error.4 (loop for x in *mini-universe* unless (realp x) - unless (eql (classify-error** `(plusp ',x)) 'type-error) + unless (eval `(signals-error (plusp ',x) type-error)) collect x) nil) +;;; Non-error tests + (deftest plusp.1 (plusp 0) nil) diff --git a/ansi-tests/position-if-not.lsp b/ansi-tests/position-if-not.lsp index 00b1d7de..8251cad2 100644 --- a/ansi-tests/position-if-not.lsp +++ b/ansi-tests/position-if-not.lsp @@ -515,61 +515,61 @@ ;;; Error tests (deftest position-if-not.error.1 - (classify-error (position-if-not #'identity 'b)) - type-error) + (signals-error (position-if-not #'identity 'b) type-error) + t) (deftest position-if-not.error.2 - (classify-error (position-if-not #'identity 10)) - type-error) + (signals-error (position-if-not #'identity 10) type-error) + t) (deftest position-if-not.error.3 - (classify-error (position-if-not 'null 1.4)) - type-error) + (signals-error (position-if-not 'null 1.4) type-error) + t) (deftest position-if-not.error.4 - (classify-error (position-if-not 'identity '(a b c . d))) - type-error) + (signals-error (position-if-not 'identity '(a b c . d)) type-error) + t) (deftest position-if-not.error.5 - (classify-error (position-if-not)) - program-error) + (signals-error (position-if-not) program-error) + t) (deftest position-if-not.error.6 - (classify-error (position-if-not #'null)) - program-error) + (signals-error (position-if-not #'null) program-error) + t) (deftest position-if-not.error.7 - (classify-error (position-if-not #'null nil :key)) - program-error) + (signals-error (position-if-not #'null nil :key) program-error) + t) (deftest position-if-not.error.8 - (classify-error (position-if-not #'null nil 'bad t)) - program-error) + (signals-error (position-if-not #'null nil 'bad t) program-error) + t) (deftest position-if-not.error.9 - (classify-error (position-if-not #'null nil 'bad t :allow-other-keys nil)) - program-error) + (signals-error (position-if-not #'null nil 'bad t :allow-other-keys nil) program-error) + t) (deftest position-if-not.error.10 - (classify-error (position-if-not #'null nil 1 2)) - program-error) + (signals-error (position-if-not #'null nil 1 2) program-error) + t) (deftest position-if-not.error.11 - (classify-error (locally (position-if-not #'identity 'b) t)) - type-error) + (signals-error (locally (position-if-not #'identity 'b) t) type-error) + t) (deftest position-if-not.error.12 - (classify-error (position-if-not #'cons '(a b c d))) - program-error) + (signals-error (position-if-not #'cons '(a b c d)) program-error) + t) (deftest position-if-not.error.13 - (classify-error (position-if-not #'car '(a b c d))) - type-error) + (signals-error (position-if-not #'car '(a b c d)) type-error) + t) (deftest position-if-not.error.14 - (classify-error (position-if-not #'identity '(a b c d) :key #'cdr)) - type-error) + (signals-error (position-if-not #'identity '(a b c d) :key #'cdr) type-error) + t) (deftest position-if-not.error.15 - (classify-error (position-if-not #'identity '(a b c d) :key #'cons)) - program-error) + (signals-error (position-if-not #'identity '(a b c d) :key #'cons) program-error) + t) diff --git a/ansi-tests/position-if.lsp b/ansi-tests/position-if.lsp index cad0748d..1f3d4c2a 100644 --- a/ansi-tests/position-if.lsp +++ b/ansi-tests/position-if.lsp @@ -512,63 +512,61 @@ ;;; Error tests (deftest position-if.error.1 - (classify-error (position-if #'identity 'b)) - type-error) + (signals-error (position-if #'identity 'b) type-error) + t) (deftest position-if.error.2 - (classify-error (position-if #'identity 10)) - type-error) + (signals-error (position-if #'identity 10) type-error) + t) (deftest position-if.error.3 - (classify-error (position-if 'null 1.4)) - type-error) + (signals-error (position-if 'null 1.4) type-error) + t) (deftest position-if.error.4 - (classify-error (position-if 'null '(a b c . d))) - type-error) + (signals-error (position-if 'null '(a b c . d)) type-error) + t) (deftest position-if.error.5 - (classify-error (position-if)) - program-error) + (signals-error (position-if) program-error) + t) (deftest position-if.error.6 - (classify-error (position-if #'null)) - program-error) + (signals-error (position-if #'null) program-error) + t) (deftest position-if.error.7 - (classify-error (position-if #'null nil :key)) - program-error) + (signals-error (position-if #'null nil :key) program-error) + t) (deftest position-if.error.8 - (classify-error (position-if #'null nil 'bad t)) - program-error) + (signals-error (position-if #'null nil 'bad t) program-error) + t) (deftest position-if.error.9 - (classify-error (position-if #'null nil 'bad t :allow-other-keys nil)) - program-error) + (signals-error (position-if #'null nil 'bad t :allow-other-keys nil) program-error) + t) (deftest position-if.error.10 - (classify-error (position-if #'null nil 1 2)) - program-error) + (signals-error (position-if #'null nil 1 2) program-error) + t) (deftest position-if.error.11 - (classify-error (locally (position-if #'identity 'b) t)) - type-error) + (signals-error (locally (position-if #'identity 'b) t) type-error) + t) (deftest position-if.error.12 - (classify-error (position-if #'cons '(a b c d))) - program-error) + (signals-error (position-if #'cons '(a b c d)) program-error) + t) (deftest position-if.error.13 - (classify-error (position-if #'car '(a b c d))) - type-error) + (signals-error (position-if #'car '(a b c d)) type-error) + t) (deftest position-if.error.14 - (classify-error (position-if #'identity '(a b c d) :key #'cdr)) - type-error) + (signals-error (position-if #'identity '(a b c d) :key #'cdr) type-error) + t) (deftest position-if.error.15 - (classify-error (position-if #'identity '(a b c d) :key #'cons)) - program-error) - - + (signals-error (position-if #'identity '(a b c d) :key #'cons) program-error) + t) diff --git a/ansi-tests/position.lsp b/ansi-tests/position.lsp index aa5da8e5..24c4ce47 100644 --- a/ansi-tests/position.lsp +++ b/ansi-tests/position.lsp @@ -768,62 +768,61 @@ ;;; Error tests (deftest position.error.1 - (classify-error (position 'a 'b)) - type-error) + (signals-error (position 'a 'b) type-error) + t) (deftest position.error.2 - (classify-error (position 'a 10)) - type-error) + (signals-error (position 'a 10) type-error) + t) (deftest position.error.3 - (classify-error (position 'a 1.4)) - type-error) + (signals-error (position 'a 1.4) type-error) + t) (deftest position.error.4 - (classify-error (position 'e '(a b c . d))) - type-error) + (signals-error (position 'e '(a b c . d)) type-error) + t) (deftest position.error.5 - (classify-error (position)) - program-error) + (signals-error (position) program-error) + t) (deftest position.error.6 - (classify-error (position 'a)) - program-error) + (signals-error (position 'a) program-error) + t) (deftest position.error.7 - (classify-error (position 'a nil :key)) - program-error) + (signals-error (position 'a nil :key) program-error) + t) (deftest position.error.8 - (classify-error (position 'a nil 'bad t)) - program-error) + (signals-error (position 'a nil 'bad t) program-error) + t) (deftest position.error.9 - (classify-error (position 'a nil 'bad t :allow-other-keys nil)) - program-error) + (signals-error (position 'a nil 'bad t :allow-other-keys nil) program-error) + t) (deftest position.error.10 - (classify-error (position 'a nil 1 2)) - program-error) + (signals-error (position 'a nil 1 2) program-error) + t) (deftest position.error.11 - (classify-error (locally (position 'a 'b) t)) - type-error) + (signals-error (locally (position 'a 'b) t) type-error) + t) (deftest position.error.12 - (classify-error (position 'b '(a b c d) :test #'identity)) - program-error) + (signals-error (position 'b '(a b c d) :test #'identity) program-error) + t) (deftest position.error.13 - (classify-error (position 'b '(a b c d) :test-not #'not)) - program-error) + (signals-error (position 'b '(a b c d) :test-not #'not) program-error) + t) (deftest position.error.14 - (classify-error (position 'b '(a b c d) :key #'cdr)) - type-error) + (signals-error (position 'b '(a b c d) :key #'cdr) type-error) + t) (deftest position.error.15 - (classify-error (position 'b '(a b c d) :key #'cons)) - program-error) - + (signals-error (position 'b '(a b c d) :key #'cons) program-error) + t) diff --git a/ansi-tests/probe-file.lsp b/ansi-tests/probe-file.lsp index c9cad205..1eb5e8ec 100644 --- a/ansi-tests/probe-file.lsp +++ b/ansi-tests/probe-file.lsp @@ -30,17 +30,17 @@ t) (deftest probe-file.error.1 - (classify-error (probe-file)) - program-error) + (signals-error (probe-file) program-error) + t) (deftest probe-file.error.2 - (classify-error (probe-file #p"probe-file.lsp" nil)) - program-error) + (signals-error (probe-file #p"probe-file.lsp" nil) program-error) + t) (deftest probe-file.error.3 - (classify-error (probe-file (make-pathname :name :wild))) - file-error) + (signals-error (probe-file (make-pathname :name :wild)) file-error) + t) (deftest probe-file.error.4 - (classify-error (probe-file "CLTEST:*.FOO")) - file-error) + (signals-error (probe-file "CLTEST:*.FOO") file-error) + t) diff --git a/ansi-tests/psetq.lsp b/ansi-tests/psetq.lsp index 214380b4..3efed974 100644 --- a/ansi-tests/psetq.lsp +++ b/ansi-tests/psetq.lsp @@ -81,16 +81,15 @@ (deftest psetq.error.1 - (classify-error (funcall (macro-function 'psetq))) - program-error) + (signals-error (funcall (macro-function 'psetq)) program-error) + t) (deftest psetq.error.2 - (classify-error (funcall (macro-function 'psetq) - '(psetq))) - program-error) + (signals-error (funcall (macro-function 'psetq) '(psetq)) + program-error) + t) (deftest psetq.error.3 - (classify-error (funcall (macro-function 'psetq) - '(psetq) - nil nil)) - program-error) + (signals-error (funcall (macro-function 'psetq) '(psetq) nil nil) + program-error) + t) diff --git a/ansi-tests/pushnew.lsp b/ansi-tests/pushnew.lsp index 5dab7061..f65d0413 100644 --- a/ansi-tests/pushnew.lsp +++ b/ansi-tests/pushnew.lsp @@ -214,21 +214,24 @@ 4) (deftest pushnew.error.1 - (classify-error + (signals-error (let ((x '(a b))) - (pushnew 'c x :test #'identity))) - program-error) + (pushnew 'c x :test #'identity)) + program-error) + t) (deftest pushnew.error.2 - (classify-error + (signals-error (let ((x '(a b))) - (pushnew 'c x :test-not #'identity))) - program-error) + (pushnew 'c x :test-not #'identity)) + program-error) + t) (deftest pushnew.error.3 - (classify-error + (signals-error (let ((x '(a b))) - (pushnew 'c x :key #'cons))) - program-error) + (pushnew 'c x :key #'cons)) + program-error) + t) (def-macro-test pushnew.error.4 (pushnew x y)) -- GitLab