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

Changed classify-error forms to signals-error forms.

parent d30e0cfd
No related branches found
No related tags found
No related merge requests found
Showing
with 418 additions and 344 deletions
...@@ -9,140 +9,162 @@ ...@@ -9,140 +9,162 @@
;;; tests could be reduced in size. ;;; tests could be reduced in size.
(deftest defclass.error.1 (deftest defclass.error.1
(classify-error (signals-error
(defclass erroneous-class.1 () (defclass erroneous-class.1 ()
(a b c d b e))) (a b c d b e))
program-error) program-error)
t)
(deftest defclass.error.2 (deftest defclass.error.2
(classify-error (signals-error
(defclass erroneous-class.2 () (defclass erroneous-class.2 ()
((s1 :initarg :foo)) ((s1 :initarg :foo))
(:default-initargs :foo 1 :foo 2))) (:default-initargs :foo 1 :foo 2))
program-error) program-error)
t)
(deftest defclass.error.3 (deftest defclass.error.3
(classify-error (signals-error
(defclass erroneous-class.3 () (defclass erroneous-class.3 ()
((s1 :initform 0 :initform 2)))) ((s1 :initform 0 :initform 2)))
program-error) program-error)
t)
(deftest defclass.error.4 (deftest defclass.error.4
(classify-error (signals-error
(defclass erroneous-class.4 () (defclass erroneous-class.4 ()
((s1 :initform 0 :initform 0)))) ((s1 :initform 0 :initform 0)))
program-error) program-error)
t)
(deftest defclass.error.5 (deftest defclass.error.5
(classify-error (signals-error
(defclass erroneous-class.5 () (defclass erroneous-class.5 ()
((s1 :type fixnum :type character)))) ((s1 :type fixnum :type character)))
program-error) program-error)
t)
(deftest defclass.error.6 (deftest defclass.error.6
(classify-error (signals-error
(defclass erroneous-class.6 () (defclass erroneous-class.6 ()
((s1 :type t :type t)))) ((s1 :type t :type t)))
program-error) program-error)
t)
(deftest defclass.error.7 (deftest defclass.error.7
(classify-error (signals-error
(defclass erroneous-class.7 () (defclass erroneous-class.7 ()
((s1 :documentation "foo" :documentation "bar")))) ((s1 :documentation "foo" :documentation "bar")))
program-error) program-error)
t)
(deftest defclass.error.8 (deftest defclass.error.8
(classify-error (signals-error
(defclass erroneous-class.8 () (defclass erroneous-class.8 ()
((s1 :documentation #1="foo" :documentation #1#)))) ((s1 :documentation #1="foo" :documentation #1#)))
program-error) program-error)
t)
(deftest defclass.error.9 (deftest defclass.error.9
(classify-error (signals-error
(defclass erroneous-class.9 () (defclass erroneous-class.9 ()
((s1 :allocation :class :allocation :instance)))) ((s1 :allocation :class :allocation :instance)))
program-error) program-error)
t)
(deftest defclass.error.10 (deftest defclass.error.10
(classify-error (signals-error
(defclass erroneous-class.10 () (defclass erroneous-class.10 ()
((s1 :allocation :class :allocation :class)))) ((s1 :allocation :class :allocation :class)))
program-error) program-error)
t)
(deftest defclass.error.11 (deftest defclass.error.11
(classify-error (signals-error
(defclass erroneous-class.11 () (defclass erroneous-class.11 ()
((s1 :allocation :instance :allocation :instance)))) ((s1 :allocation :instance :allocation :instance)))
program-error) program-error)
t)
(deftest defclass.error.12 (deftest defclass.error.12
(classify-error (signals-error
(defclass erroneous-class.12 () (defclass erroneous-class.12 ()
((s1 #.(gensym) nil)))) ((s1 #.(gensym) nil)))
program-error) program-error)
t)
(deftest defclass.error.13 (deftest defclass.error.13
(classify-error (signals-error
(defclass erroneous-class.13 () (defclass erroneous-class.13 ()
(a b c) (a b c)
(#.(gensym)))) (#.(gensym)))
program-error) program-error)
t)
(deftest defclass.error.14 (deftest defclass.error.14
(classify-error (signals-error
(defclass defclass-error-14 nil (defclass defclass-error-14 nil
(foo foo))) (foo foo))
program-error) program-error)
t)
(deftest defclass.error.15 (deftest defclass.error.15
(classify-error (signals-error
(defclass defclass-error-15 nil (defclass defclass-error-15 nil
(foo (foo)))) (foo (foo)))
program-error) program-error)
t)
(deftest defclass.error.16 (deftest defclass.error.16
(classify-error (signals-error
(defclass defclass-error-16 nil (defclass defclass-error-16 nil
((foo :initarg f1)) ((foo :initarg f1))
(:default-initargs :f1 10 :f1 20))) (:default-initargs :f1 10 :f1 20))
program-error) program-error)
t)
(deftest defclass.error.17 (deftest defclass.error.17
(classify-error (signals-error
(defclass defclass-error-17 nil (defclass defclass-error-17 nil
((foo :initform 10 :initform 20 :reader defclass-error-4/foo)))) ((foo :initform 10 :initform 20 :reader defclass-error-4/foo)))
program-error) program-error)
t)
(deftest defclass.error.18 (deftest defclass.error.18
(classify-error (signals-error
(defclass defclass-error-18 nil (defclass defclass-error-18 nil
((foo :initform 10 :initform 10 :reader defclass-error-5/foo)))) ((foo :initform 10 :initform 10 :reader defclass-error-5/foo)))
program-error) program-error)
t)
(deftest defclass.error.19 (deftest defclass.error.19
(classify-error (signals-error
(defclass defclass-error-19 nil (defclass defclass-error-19 nil
((foo :initarg f1 :type t :type t :reader defclass-error-6/foo)))) ((foo :initarg f1 :type t :type t :reader defclass-error-6/foo)))
program-error) program-error)
t)
(deftest defclass.error.20 (deftest defclass.error.20
(classify-error (signals-error
(defclass defclass-error-20 nil (defclass defclass-error-20 nil
((foo :initarg f1 :documentation "x" :reader defclass-error-7/foo ((foo :initarg f1 :documentation "x" :reader defclass-error-7/foo
:documentation "x")))) :documentation "x")))
program-error) program-error)
t)
(deftest defclass.error.21 (deftest defclass.error.21
(classify-error (signals-error
(defclass defclass-error-21 () (defclass defclass-error-21 ()
((foo #:unknown-slot-option nil)))) ((foo #:unknown-slot-option nil)))
program-error) program-error)
t)
(deftest defclass.error.22 (deftest defclass.error.22
(let ((option (gentemp "UNKNOWN-OPTION" (symbol-package :foo)))) (let ((option (gentemp "UNKNOWN-OPTION" (symbol-package :foo))))
(eval (eval
`(classify-error `(signals-error
(defclass defclass-error-22 () (defclass defclass-error-22 ()
(foo bar) (foo bar)
(,option nil))))) (,option nil))
program-error) program-error)))
t)
...@@ -119,18 +119,9 @@ ...@@ -119,18 +119,9 @@
(return 3)) (return 3))
(unless (typep (eval `(defclass ,c2 (,c4 ,c5) nil)) 'class) (unless (typep (eval `(defclass ,c2 (,c4 ,c5) nil)) 'class)
(return 4)) (return 4))
(let ((error-symbol (handler-case
(classify-error** (eval `(progn
`(progn (defclass ,c3 (,c5 ,c4) nil)
(defclass ,c3 (,c5 ,c4) nil) (make-instance ',c1)))
(make-instance ',c1))))) (error () :good))))
(and (symbolp error-symbol) :good)
(subtypep error-symbol 'error)
'good))))
good)
...@@ -31,31 +31,34 @@ ...@@ -31,31 +31,34 @@
test-constant-3) test-constant-3)
;;; (deftest defconstant.error.1 ;;; (deftest defconstant.error.1
;;; (classify-error (defconstant)) ;;; (signals-error (defconstant) program-error)
;;; program-error) ;;; t)
;;; ;;;
;;; (deftest defconstant.error.2 ;;; (deftest defconstant.error.2
;;; (classify-error (defconstant +ignorable-constant-name+)) ;;; (signals-error (defconstant +ignorable-constant-name+) program-error)
;;; program-error) ;;; t)
;;; ;;;
;;; (deftest defconstant.error.3 ;;; (deftest defconstant.error.3
;;; (classify-error (defconstant +ignorable-constant-name2+ nil ;;; (signals-error (defconstant +ignorable-constant-name2+ nil
;;; "This is a docstring" ;;; "This is a docstring"
;;; "This is an unnecessary extra argument.")) ;;; "This is an unnecessary extra argument.")
;;; program-error) ;;; program-error)
;;; t)
(deftest defconstant.error.1 (deftest defconstant.error.1
(classify-error (funcall (macro-function 'defconstant))) (signals-error (funcall (macro-function 'defconstant))
program-error) program-error)
t)
(deftest defconstant.error.2 (deftest defconstant.error.2
(classify-error (funcall (macro-function 'defconstant) (signals-error (funcall (macro-function 'defconstant)
'(defconstant +nonexistent-constant+ 0))) '(defconstant +nonexistent-constant+ 0))
program-error) program-error)
t)
(deftest defconstant.error.3 (deftest defconstant.error.3
(classify-error (funcall (macro-function 'defconstant) (signals-error (funcall (macro-function 'defconstant)
'(defconstant +nonexistent-constant+ 0) '(defconstant +nonexistent-constant+ 0)
nil nil)) nil nil)
program-error) program-error)
t)
\ No newline at end of file
...@@ -41,20 +41,23 @@ ...@@ -41,20 +41,23 @@
nil) nil)
(deftest defgeneric.error.4 (deftest defgeneric.error.4
(classify-error (defgeneric defgeneric-error-fn.4 (x y) (signals-error (defgeneric defgeneric-error-fn.4 (x y)
(:argument-precedence-order x y x))) (:argument-precedence-order x y x))
program-error) program-error)
t)
(deftest defgeneric.error.5 (deftest defgeneric.error.5
(classify-error (defgeneric defgeneric-error-fn.5 (x) (signals-error (defgeneric defgeneric-error-fn.5 (x)
(:documentation "some documentation") (:documentation "some documentation")
(:documentation "illegally repeated documentation"))) (:documentation "illegally repeated documentation"))
program-error) program-error)
t)
(deftest defgeneric.error.6 (deftest defgeneric.error.6
(classify-error (defgeneric defgeneric-error-fn.6 (x) (signals-error (defgeneric defgeneric-error-fn.6 (x)
(unknown-option nil))) (unknown-option nil))
program-error) program-error)
t)
(deftest defgeneric.error.7 (deftest defgeneric.error.7
(handler-case (handler-case
...@@ -66,9 +69,10 @@ ...@@ -66,9 +69,10 @@
:good) :good)
(deftest defgeneric.error.8 (deftest defgeneric.error.8
(classify-error (defgeneric defgeneric-error-fn.8 (x y) (signals-error (defgeneric defgeneric-error-fn.8 (x y)
(:argument-precedence-order x))) (:argument-precedence-order x))
program-error) program-error)
t)
;;; Non-congruent methods cause defgeneric to signal an error ;;; Non-congruent methods cause defgeneric to signal an error
...@@ -178,20 +182,22 @@ ...@@ -178,20 +182,22 @@
;;; error tests are necessary. See sections 7.6.5 of the CLHS. ;;; error tests are necessary. See sections 7.6.5 of the CLHS.
(deftest defgeneric.error.20 (deftest defgeneric.error.20
(classify-error (signals-error
(let ((fn (defgeneric defgeneric-error-fn.20 (x &key) (let ((fn (defgeneric defgeneric-error-fn.20 (x &key)
(:method ((x number) &key foo) (list x foo)) (:method ((x number) &key foo) (list x foo))
(:method ((x symbol) &key bar) (list x bar))))) (:method ((x symbol) &key bar) (list x bar)))))
(funcall fn 1 :bar 'a))) (funcall fn 1 :bar 'a))
program-error) program-error)
t)
(deftest defgeneric.error.21 (deftest defgeneric.error.21
(classify-error (signals-error
(let ((fn (defgeneric defgeneric-error-fn.21 (x &key) (let ((fn (defgeneric defgeneric-error-fn.21 (x &key)
(:method ((x number) &key foo &allow-other-keys) (list x foo)) (:method ((x number) &key foo &allow-other-keys) (list x foo))
(:method ((x symbol) &key bar) (list x bar))))) (:method ((x symbol) &key bar) (list x bar)))))
(funcall fn 'x :foo 'a))) (funcall fn 'x :foo 'a))
program-error) program-error)
t)
;;; ;;;
...@@ -205,8 +211,6 @@ ...@@ -205,8 +211,6 @@
:good) :good)
;;; Non error cases ;;; Non error cases
(deftest defgeneric.1 (deftest defgeneric.1
......
...@@ -8,16 +8,19 @@ ...@@ -8,16 +8,19 @@
;;; Need to add non-error tests ;;; Need to add non-error tests
(deftest define-compiler-macro.error.1 (deftest define-compiler-macro.error.1
(classify-error (funcall (macro-function 'define-compiler-macro))) (signals-error (funcall (macro-function 'define-compiler-macro))
program-error) program-error)
t)
(deftest define-compiler-macro.error.2 (deftest define-compiler-macro.error.2
(classify-error (funcall (macro-function 'define-compiler-macro) (signals-error (funcall (macro-function 'define-compiler-macro)
'(definee-compiler-macro nonexistent-function ()))) '(definee-compiler-macro nonexistent-function ()))
program-error) program-error)
t)
(deftest define-compiler-macro.error.3 (deftest define-compiler-macro.error.3
(classify-error (funcall (macro-function 'define-compiler-macro) (signals-error (funcall (macro-function 'define-compiler-macro)
'(definee-compiler-macro nonexistent-function ()) '(definee-compiler-macro nonexistent-function ())
nil nil)) nil nil)
program-error) program-error)
t)
...@@ -65,21 +65,22 @@ ...@@ -65,21 +65,22 @@
(3 #(0 0 3 0 0) 3)) (3 #(0 0 3 0 0) 3))
;;; (deftest define-modify-macro.error.1 ;;; (deftest define-modify-macro.error.1
;;; (classify-error (define-modify-macro)) ;;; (signals-error (define-modify-macro) program-error)
;;; program-error) ;;; t)
;;; ;;;
;;; (deftest define-modify-macro.error.2 ;;; (deftest define-modify-macro.error.2
;;; (classify-error (define-modify-macro dfm-error-1)) ;;; (signals-error (define-modify-macro dfm-error-1) program-error)
;;; program-error) ;;; t)
;;; ;;;
;;; (deftest define-modify-macro.error.3 ;;; (deftest define-modify-macro.error.3
;;; (classify-error (define-modify-macro dfm-error-2 ())) ;;; (signals-error (define-modify-macro dfm-error-2 ()) program-error)
;;; program-error) ;;; t)
;;; ;;;
;;; (deftest define-modify-macro.error.4 ;;; (deftest define-modify-macro.error.4
;;; (classify-error (define-modify-macro dfm-error-2 () nil "Documentation" ;;; (signals-error (define-modify-macro dfm-error-2 () nil "Documentation"
;;; "extra illegal argument")) ;;; "extra illegal argument")
;;; program-error) ;;; program-error)
;;; t)
(def-macro-test define-modify-macro.error.1 (def-macro-test define-modify-macro.error.1
(define-modify-macro nonexistent-modify-macro () foo)) (define-modify-macro nonexistent-modify-macro () foo))
...@@ -6,18 +6,21 @@ ...@@ -6,18 +6,21 @@
(in-package :cl-test) (in-package :cl-test)
(deftest define-symbol-macro.error.1 (deftest define-symbol-macro.error.1
(classify-error (funcall (macro-function 'define-symbol-macro))) (signals-error (funcall (macro-function 'define-symbol-macro))
program-error) program-error)
t)
(deftest define-symbol-macro.error.2 (deftest define-symbol-macro.error.2
(classify-error (funcall (macro-function 'define-symbol-macro) (signals-error (funcall (macro-function 'define-symbol-macro)
'(define-symbol-macro '(define-symbol-macro
nonexistent-symbol-macro nil))) nonexistent-symbol-macro nil))
program-error) program-error)
t)
(deftest define-symbol-macro.error.3 (deftest define-symbol-macro.error.3
(classify-error (funcall (macro-function 'define-symbol-macro) (signals-error (funcall (macro-function 'define-symbol-macro)
'(define-symbol-macro '(define-symbol-macro
nonexistent-symbol-macro nil) nonexistent-symbol-macro nil)
nil nil)) nil nil)
program-error) program-error)
t)
...@@ -5,19 +5,23 @@ ...@@ -5,19 +5,23 @@
(in-package :cl-test) (in-package :cl-test)
;;; FIXME
;;; Need to add non-error tests ;;; Need to add non-error tests
(deftest defmacro.error.1 (deftest defmacro.error.1
(classify-error (funcall (macro-function 'defmacro))) (signals-error (funcall (macro-function 'defmacro))
program-error) program-error)
t)
(deftest defmacro.error.2 (deftest defmacro.error.2
(classify-error (funcall (macro-function 'defmacro) (signals-error (funcall (macro-function 'defmacro)
'(defmacro nonexistent-macro ()))) '(defmacro nonexistent-macro ()))
program-error) program-error)
t)
(deftest defmacro.error.3 (deftest defmacro.error.3
(classify-error (funcall (macro-function 'defmacro) (signals-error (funcall (macro-function 'defmacro)
'(defmacro nonexistent-macro ()) '(defmacro nonexistent-macro ())
nil nil)) nil nil)
program-error) program-error)
t)
...@@ -52,31 +52,35 @@ ...@@ -52,31 +52,35 @@
300) 300)
;;; (deftest defparameter.error.1 ;;; (deftest defparameter.error.1
;;; (classify-error (defparameter)) ;;; (signals-error (defparameter) program-error)
;;; program-error) ;;; t)
;;; ;;;
;;; (deftest defparameter.error.2 ;;; (deftest defparameter.error.2
;;; (classify-error (defparameter *ignored-defparameter-name*)) ;;; (signals-error (defparameter *ignored-defparameter-name*)
;;; program-error) ;;; program-error)
;;; t)
;;; ;;;
;;; (deftest defparameter.error.3 ;;; (deftest defparameter.error.3
;;; (classify-error (defparameter *ignored-defparameter-name* nil ;;; (signals-error (defparameter *ignored-defparameter-name* nil
;;; "documentation" ;;; "documentation"
;;; "illegal extra argument")) ;;; "illegal extra argument")
;;; program-error) ;;; program-error)
;;; t)
(deftest defparameter.error.1 (deftest defparameter.error.1
(classify-error (funcall (macro-function 'defparameter))) (signals-error (funcall (macro-function 'defparameter))
program-error) program-error)
t)
(deftest defparameter.error.2 (deftest defparameter.error.2
(classify-error (funcall (macro-function 'defparameter) (signals-error (funcall (macro-function 'defparameter)
'(defparameter *nonexistent-variable* nil))) '(defparameter *nonexistent-variable* nil))
program-error) program-error)
t)
(deftest defparameter.error.3 (deftest defparameter.error.3
(classify-error (funcall (macro-function 'defparameter) (signals-error (funcall (macro-function 'defparameter)
'(defparameter *nonexistent-variable* nil) '(defparameter *nonexistent-variable* nil)
nil nil)) nil nil)
program-error) program-error)
t)
...@@ -5,17 +5,24 @@ ...@@ -5,17 +5,24 @@
(in-package :cl-test) (in-package :cl-test)
;;; FIXME
;;; Need to add non-error tests
(deftest deftype.error.1 (deftest deftype.error.1
(classify-error (funcall (macro-function 'deftype))) (signals-error (funcall (macro-function 'deftype))
program-error) program-error)
t)
(deftest deftype.error.2 (deftest deftype.error.2
(classify-error (funcall (macro-function 'deftype) (signals-error (funcall (macro-function 'deftype)
'(deftype nonexistent-type () nil))) '(deftype nonexistent-type () nil))
program-error) program-error)
t)
(deftest deftype.error.3 (deftest deftype.error.3
(classify-error (funcall (macro-function 'deftype) (signals-error (funcall (macro-function 'deftype)
'(deftype nonexistent-type () nil) '(deftype nonexistent-type () nil)
nil nil)) nil nil)
program-error) program-error)
t)
...@@ -6,19 +6,22 @@ ...@@ -6,19 +6,22 @@
(in-package :cl-test) (in-package :cl-test)
(deftest defun.error.1 (deftest defun.error.1
(classify-error (funcall (macro-function 'defun))) (signals-error (funcall (macro-function 'defun))
program-error) program-error)
t)
(deftest defun.error.2 (deftest defun.error.2
(classify-error (funcall (macro-function 'defun) (signals-error (funcall (macro-function 'defun)
'(defun nonexistent-function ()))) '(defun nonexistent-function ()))
program-error) program-error)
t)
(deftest defun.error.3 (deftest defun.error.3
(classify-error (funcall (macro-function 'defun) (signals-error (funcall (macro-function 'defun)
'(defun nonexistent-function ()) '(defun nonexistent-function ())
nil nil)) nil nil)
program-error) program-error)
t)
;;; Tests for implicit blocks ;;; Tests for implicit blocks
......
...@@ -55,26 +55,29 @@ ...@@ -55,26 +55,29 @@
0) 0)
;;; (deftest defvar.error.1 ;;; (deftest defvar.error.1
;;; (classify-error (defvar)) ;;; (signals-error (defvar) program-error)
;;; program-error) ;;; t)
;;; ;;;
;;; (deftest defvar.error.2 ;;; (deftest defvar.error.2
;;; (classify-error (defvar *ignored-defvar-name* nil "documentation" ;;; (signals-error (defvar *ignored-defvar-name* nil "documentation"
;;; "illegal extra argument")) ;;; "illegal extra argument")
;;; program-error) ;;; program-error)
;;; t)
(deftest defvar.error.1 (deftest defvar.error.1
(classify-error (funcall (macro-function 'defvar))) (signals-error (funcall (macro-function 'defvar))
program-error) program-error)
t)
(deftest defvar.error.2 (deftest defvar.error.2
(classify-error (funcall (macro-function 'defvar) (signals-error (funcall (macro-function 'defvar)
'(defvar *nonexistent-variable* nil))) '(defvar *nonexistent-variable* nil))
program-error) program-error)
t)
(deftest defvar.error.3 (deftest defvar.error.3
(classify-error (funcall (macro-function 'defvar) (signals-error (funcall (macro-function 'defvar)
'(defvar *nonexistent-variable* nil) '(defvar *nonexistent-variable* nil)
nil nil)) nil nil)
program-error) program-error)
t)
...@@ -54,8 +54,8 @@ ...@@ -54,8 +54,8 @@
;;; ;;;
(deftest delete-file.error.1 (deftest delete-file.error.1
(classify-error (delete-file)) (signals-error (delete-file) program-error)
program-error) t)
(deftest delete-file.error.2 (deftest delete-file.error.2
(let ((pn "scratch.txt")) (let ((pn "scratch.txt"))
...@@ -64,18 +64,15 @@ ...@@ -64,18 +64,15 @@
(format s "Contents~%"))) (format s "Contents~%")))
(values (values
(notnot (probe-file pn)) (notnot (probe-file pn))
(classify-error (delete-file "scratch.txt" nil)) (signals-error (delete-file "scratch.txt" nil) program-error)
(notnot (probe-file pn)) (notnot (probe-file pn))
(delete-file pn) (delete-file pn)
(probe-file pn))) (probe-file pn)))
t program-error t t nil) t t t t nil)
(deftest delete-file.error.3 (deftest delete-file.error.3
(let ((pn "nonexistent.txt")) (let ((pn "nonexistent.txt"))
(when (probe-file pn) (delete-file pn)) (when (probe-file pn) (delete-file pn))
(let ((result (classify-error (delete-file "nonexistent.txt")))) (signals-error (delete-file "nonexistent.txt") file-error))
(if (member result '(file-error t))
t
result)))
t) t)
...@@ -5,21 +5,25 @@ ...@@ -5,21 +5,25 @@
(in-package :cl-test) (in-package :cl-test)
;;; Error tests
(deftest deposit-field.error.1 (deftest deposit-field.error.1
(classify-error (deposit-field)) (signals-error (deposit-field) program-error)
program-error) t)
(deftest deposit-field.error.2 (deftest deposit-field.error.2
(classify-error (deposit-field 1)) (signals-error (deposit-field 1) program-error)
program-error) t)
(deftest deposit-field.error.3 (deftest deposit-field.error.3
(classify-error (deposit-field 1 (byte 1 0))) (signals-error (deposit-field 1 (byte 1 0)) program-error)
program-error) t)
(deftest deposit-field.error.4 (deftest deposit-field.error.4
(classify-error (deposit-field 1 (byte 1 0) 0 nil)) (signals-error (deposit-field 1 (byte 1 0) 0 nil) program-error)
program-error) t)
;;; Non-error tests
(deftest deposit-field.1 (deftest deposit-field.1
(loop for pos = (random 32) (loop for pos = (random 32)
......
...@@ -116,42 +116,48 @@ ...@@ -116,42 +116,48 @@
#| #|
(deftest destructuring-bind.error.1 (deftest destructuring-bind.error.1
(classify-error (destructuring-bind (a b c) nil (list a b c))) (signals-error (destructuring-bind (a b c) nil (list a b c))
program-error) program-error)
t)
(deftest destructuring-bind.error.2 (deftest destructuring-bind.error.2
(classify-error (destructuring-bind ((a b c)) nil (list a b c))) (signals-error (destructuring-bind ((a b c)) nil (list a b c))
program-error) program-error)
t)
(deftest destructuring-bind.error.3 (deftest destructuring-bind.error.3
(classify-error (destructuring-bind (a b) 'x (list a b))) (signals-error (destructuring-bind (a b) 'x (list a b))
program-error) program-error)
t)
(deftest destructuring-bind.error.4 (deftest destructuring-bind.error.4
(classify-error (destructuring-bind (a . b) 'x (list a b))) (signals-error (destructuring-bind (a . b) 'x (list a b))
program-error) program-error)
t)
|# |#
;;; (deftest destructuring-bind.error.5 ;;; (deftest destructuring-bind.error.5
;;; (classify-error (destructuring-bind)) ;;; (signals-error (destructuring-bind) program-error)
;;; program-error) ;;; t)
;;; ;;;
;;; (deftest destructuring-bind.error.6 ;;; (deftest destructuring-bind.error.6
;;; (classify-error (destructuring-bind x)) ;;; (signals-error (destructuring-bind x) program-error)
;;; program-error) ;;; t)
(deftest destructuring-bind.error.7 (deftest destructuring-bind.error.7
(classify-error (funcall (macro-function 'destructuring-bind))) (signals-error (funcall (macro-function 'destructuring-bind))
program-error) program-error)
t)
(deftest destructuring-bind.error.8 (deftest destructuring-bind.error.8
(classify-error (funcall (macro-function 'destructuring-bind) (signals-error (funcall (macro-function 'destructuring-bind)
'(destructuring-bind (a . b) '(1 2) nil))) '(destructuring-bind (a . b) '(1 2) nil))
program-error) program-error)
t)
(deftest destructuring-bind.error.9 (deftest destructuring-bind.error.9
(classify-error (funcall (macro-function 'destructuring-bind) (signals-error (funcall (macro-function 'destructuring-bind)
'(destructuring-bind (a . b) '(1 2) nil) '(destructuring-bind (a . b) '(1 2) nil)
nil nil)) nil nil)
program-error) program-error)
t)
...@@ -57,5 +57,5 @@ ...@@ -57,5 +57,5 @@
nil) nil)
(deftest directory.error.1 (deftest directory.error.1
(classify-error (directory)) (signals-error (directory) program-error)
program-error) t)
...@@ -9,8 +9,8 @@ ...@@ -9,8 +9,8 @@
(compile-and-load "division-aux.lsp") (compile-and-load "division-aux.lsp")
(deftest /.error.1 (deftest /.error.1
(classify-error (/)) (signals-error (/) program-error)
program-error) t)
(deftest /.error.2 (deftest /.error.2
(divide-by-zero-test 0)) (divide-by-zero-test 0))
......
...@@ -5,21 +5,25 @@ ...@@ -5,21 +5,25 @@
(in-package :cl-test) (in-package :cl-test)
;;; Error tests
(deftest dpb.error.1 (deftest dpb.error.1
(classify-error (dpb)) (signals-error (dpb) program-error)
program-error) t)
(deftest dpb.error.2 (deftest dpb.error.2
(classify-error (dpb 1)) (signals-error (dpb 1) program-error)
program-error) t)
(deftest dpb.error.3 (deftest dpb.error.3
(classify-error (dpb 1 (byte 1 0))) (signals-error (dpb 1 (byte 1 0)) program-error)
program-error) t)
(deftest dpb.error.4 (deftest dpb.error.4
(classify-error (dpb 1 (byte 1 0) 0 nil)) (signals-error (dpb 1 (byte 1 0) 0 nil) program-error)
program-error) t)
;;; Non-error tests
(deftest dpb.1 (deftest dpb.1
(loop for pos = (random 32) (loop for pos = (random 32)
......
...@@ -10,23 +10,23 @@ ...@@ -10,23 +10,23 @@
2) 2)
(deftest ecase.2 (deftest ecase.2
(classify-error (ecase 1)) (signals-error (ecase 1) type-error)
type-error) t)
(deftest ecase.3 (deftest ecase.3
(classify-error (ecase 1 (a 1) (b 2) (c 3))) (signals-error (ecase 1 (a 1) (b 2) (c 3)) type-error)
type-error) t)
;;; It is legal to use T or OTHERWISE as key designators ;;; It is legal to use T or OTHERWISE as key designators
;;; in ECASE forms. They have no special meaning here. ;;; in ECASE forms. They have no special meaning here.
(deftest ecase.4 (deftest ecase.4
(classify-error (ecase 1 (t nil))) (signals-error (ecase 1 (t nil)) type-error)
type-error) t)
(deftest ecase.5 (deftest ecase.5
(classify-error (ecase 1 (otherwise nil))) (signals-error (ecase 1 (otherwise nil)) type-error)
type-error) t)
(deftest ecase.6 (deftest ecase.6
(ecase 'b ((a z) 1) ((y b w) 2) ((b c) 3)) (ecase 'b ((a z) 1) ((y b w) 2) ((b c) 3))
...@@ -45,8 +45,8 @@ ...@@ -45,8 +45,8 @@
a) a)
(deftest ecase.9 (deftest ecase.9
(classify-error (ecase nil (nil 'a))) (signals-error (ecase nil (nil 'a)) type-error)
type-error) t)
(deftest ecase.10 (deftest ecase.10
(ecase nil ((nil) 'a)) (ecase nil ((nil) 'a))
...@@ -57,8 +57,8 @@ ...@@ -57,8 +57,8 @@
1 2 3) 1 2 3)
(deftest ecase.12 (deftest ecase.12
(classify-error (ecase t (a 10))) (signals-error (ecase t (a 10)) type-error)
type-error) t)
(deftest ecase.13 (deftest ecase.13
(ecase t ((t) 10) (t 20)) (ecase t ((t) 10) (t 20))
...@@ -70,24 +70,26 @@ ...@@ -70,24 +70,26 @@
1) 1)
(deftest ecase.15 (deftest ecase.15
(classify-error (ecase 'otherwise ((t) 10))) (signals-error (ecase 'otherwise ((t) 10)) type-error)
type-error) t)
(deftest ecase.16 (deftest ecase.16
(classify-error (ecase t ((otherwise) 10))) (signals-error (ecase t ((otherwise) 10)) type-error)
type-error) t)
(deftest ecase.17 (deftest ecase.17
(classify-error (ecase 'a (b 0) (c 1) (otherwise 2))) (signals-error (ecase 'a (b 0) (c 1) (otherwise 2))
type-error) type-error)
t)
(deftest ecase.18 (deftest ecase.18
(classify-error (ecase 'a (b 0) (c 1) ((otherwise) 2))) (signals-error (ecase 'a (b 0) (c 1) ((otherwise) 2))
type-error) type-error)
t)
(deftest ecase.19 (deftest ecase.19
(classify-error (ecase 'a (b 0) (c 1) ((t) 2))) (signals-error (ecase 'a (b 0) (c 1) ((t) 2)) type-error)
type-error) t)
(deftest ecase.20 (deftest ecase.20
(ecase #\a (ecase #\a
...@@ -160,16 +162,15 @@ ...@@ -160,16 +162,15 @@
good) good)
(deftest ecase.error.1 (deftest ecase.error.1
(classify-error (funcall (macro-function 'ecase))) (signals-error (funcall (macro-function 'ecase)) program-error)
program-error) t)
(deftest ecase.error.2 (deftest ecase.error.2
(classify-error (funcall (macro-function 'ecase) (signals-error (funcall (macro-function 'ecase) '(ecase t))
'(ecase t))) program-error)
program-error) t)
(deftest ecase.error.3 (deftest ecase.error.3
(classify-error (funcall (macro-function 'ecase) (signals-error (funcall (macro-function 'ecase) '(ecase t) nil nil)
'(ecase t) program-error)
nil nil)) t)
program-error)
...@@ -10,27 +10,27 @@ ...@@ -10,27 +10,27 @@
;; elt on lists ;; elt on lists
(deftest elt.1 (deftest elt.1
(classify-error (elt nil 0)) (signals-error (elt nil 0) type-error)
type-error) t)
(deftest elt.1a (deftest elt.1a
(classify-error (elt nil -10)) (signals-error (elt nil -10) type-error)
type-error) t)
(deftest elt.1b (deftest elt.1b
(classify-error (locally (elt nil 0) t)) (signals-error (locally (elt nil 0) t) type-error)
type-error) t)
(deftest elt.2 (deftest elt.2
(classify-error (elt nil 1000000)) (signals-error (elt nil 1000000) type-error)
type-error) t)
(deftest elt.3 (elt '(a b c d e) 0) a) (deftest elt.3 (elt '(a b c d e) 0) a)
(deftest elt.4 (elt '(a b c d e) 2) c) (deftest elt.4 (elt '(a b c d e) 2) c)
(deftest elt.5 (elt '(a b c d e) 4) e) (deftest elt.5 (elt '(a b c d e) 4) e)
(deftest elt.5a (deftest elt.5a
(classify-error (elt '(a b c d e) -4)) (signals-error (elt '(a b c d e) -4) type-error)
type-error) t)
(deftest elt.6 (deftest elt.6
(let ((x (make-int-list 1000))) (let ((x (make-int-list 1000)))
...@@ -59,10 +59,11 @@ ...@@ -59,10 +59,11 @@
((a b c e) e)) ((a b c e) e))
(deftest elt.10 (deftest elt.10
(classify-error (signals-error
(let ((x (list 'a 'b 'c))) (let ((x (list 'a 'b 'c)))
(setf (elt x 4) 'd))) (setf (elt x 4) 'd))
type-error) type-error)
t)
(deftest elt.11 (deftest elt.11
(let ((x (list 'a 'b 'c 'd 'e))) (let ((x (list 'a 'b 'c 'd 'e)))
...@@ -88,40 +89,46 @@ ...@@ -88,40 +89,46 @@
(79999 foo 80001)) (79999 foo 80001))
(deftest elt.14 (deftest elt.14
(classify-error (signals-error
(let ((x (list 'a 'b 'c))) (let ((x (list 'a 'b 'c)))
(elt x 10))) (elt x 10))
type-error) type-error)
t)
(deftest elt.15 (deftest elt.15
(classify-error (signals-error
(let ((x (list 'a 'b 'c))) (let ((x (list 'a 'b 'c)))
(elt x 'a))) (elt x 'a))
type-error) type-error)
t)
(deftest elt.16 (deftest elt.16
(classify-error (signals-error
(let ((x (list 'a 'b 'c))) (let ((x (list 'a 'b 'c)))
(elt x 10.0))) (elt x 10.0))
type-error) type-error)
t)
(deftest elt.17 (deftest elt.17
(classify-error (signals-error
(let ((x (list 'a 'b 'c))) (let ((x (list 'a 'b 'c)))
(elt x -1))) (elt x -1))
type-error) type-error)
t)
(deftest elt.18 (deftest elt.18
(classify-error (signals-error
(let ((x (list 'a 'b 'c))) (let ((x (list 'a 'b 'c)))
(elt x -100000000000000000))) (elt x -100000000000000000))
type-error) type-error)
t)
(deftest elt.19 (deftest elt.19
(classify-error (signals-error
(let ((x (list 'a 'b 'c))) (let ((x (list 'a 'b 'c)))
(elt x #\w))) (elt x #\w))
type-error) type-error)
t)
(deftest elt.order.1 (deftest elt.order.1
(let ((i 0) x y) (let ((i 0) x y)
...@@ -143,9 +150,8 @@ ...@@ -143,9 +150,8 @@
k (a b c k e) 3 1 2 3) k (a b c k e) 3 1 2 3)
(deftest elt-v.1 (deftest elt-v.1
(classify-error (signals-error (elt (make-array '(0)) 0) type-error)
(elt (make-array '(0)) 0)) t)
type-error)
;; (deftest elt-v.2 (elt (make-array '(1)) 0) nil) ;; actually undefined ;; (deftest elt-v.2 (elt (make-array '(1)) 0) nil) ;; actually undefined
(deftest elt-v.3 (deftest elt-v.3
...@@ -183,16 +189,18 @@ ...@@ -183,16 +189,18 @@
(a b c e e)) (a b c e e))
(deftest elt-v.10 (deftest elt-v.10
(classify-error (signals-error
(let ((x (make-array '(3) :initial-contents (list 'a 'b 'c)))) (let ((x (make-array '(3) :initial-contents (list 'a 'b 'c))))
(setf (elt x 4) 'd))) (setf (elt x 4) 'd))
type-error) type-error)
t)
(deftest elt-v.11 (deftest elt-v.11
(classify-error (signals-error
(let ((x (make-array '(3) :initial-contents (list 'a 'b 'c)))) (let ((x (make-array '(3) :initial-contents (list 'a 'b 'c))))
(setf (elt x -100) 'd))) (setf (elt x -100) 'd))
type-error) type-error)
t)
(deftest elt-v.12 (deftest elt-v.12
(let ((x (make-int-array 100000))) (let ((x (make-int-array 100000)))
...@@ -210,8 +218,8 @@ ...@@ -210,8 +218,8 @@
;;; Adjustable arrays ;;; Adjustable arrays
(deftest elt-adj-array.1 (deftest elt-adj-array.1
(classify-error (elt (make-adj-array '(0)) 0)) (signals-error (elt (make-adj-array '(0)) 0) type-error)
type-error) t)
;;; (deftest elt-adj-array.2 (elt (make-adj-array '(1)) 0) nil) ;; actually undefined ;;; (deftest elt-adj-array.2 (elt (make-adj-array '(1)) 0) nil) ;; actually undefined
...@@ -250,16 +258,18 @@ ...@@ -250,16 +258,18 @@
(a b c e e)) (a b c e e))
(deftest elt-adj-array.10 (deftest elt-adj-array.10
(classify-error (signals-error
(let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c)))) (let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c))))
(setf (elt x 4) 'd))) (setf (elt x 4) 'd))
type-error) type-error)
t)
(deftest elt-adj-array.11 (deftest elt-adj-array.11
(classify-error (signals-error
(let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c)))) (let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c))))
(setf (elt x -100) 'd))) (setf (elt x -100) 'd))
type-error) type-error)
t)
(deftest elt-adj-array.12 (deftest elt-adj-array.12
(let ((x (make-int-array 100000 #'make-adj-array))) (let ((x (make-int-array 100000 #'make-adj-array)))
...@@ -277,8 +287,8 @@ ...@@ -277,8 +287,8 @@
;; displaced arrays ;; displaced arrays
(deftest elt-displaced-array.1 (deftest elt-displaced-array.1
(classify-error (elt (make-displaced-array '(0) 100) 0)) (signals-error (elt (make-displaced-array '(0) 100) 0) type-error)
type-error) t)
(deftest elt-displaced-array.2 (deftest elt-displaced-array.2
(elt (make-displaced-array '(1) 100) 0) (elt (make-displaced-array '(1) 100) 0)
...@@ -305,21 +315,23 @@ ...@@ -305,21 +315,23 @@
0 0 1) 0 0 1)
(deftest elt-fill-pointer.3 (deftest elt-fill-pointer.3
(classify-error (signals-error
(let ((a (make-array '(5) (let ((a (make-array '(5)
:initial-contents '(0 0 1 0 0) :initial-contents '(0 0 1 0 0)
:fill-pointer 3))) :fill-pointer 3)))
(elt a 4))) (elt a 4))
type-error) type-error)
t)
(deftest elt-fill-pointer.4 (deftest elt-fill-pointer.4
(classify-error (signals-error
(let ((a (make-array '(5) (let ((a (make-array '(5)
:initial-contents '(0 0 1 0 0) :initial-contents '(0 0 1 0 0)
:element-type 'bit :element-type 'bit
:fill-pointer 3))) :fill-pointer 3)))
(elt a 4))) (elt a 4))
type-error) type-error)
t)
(deftest elt-fill-pointer.5 (deftest elt-fill-pointer.5
(let ((a (make-array '(5) (let ((a (make-array '(5)
...@@ -330,13 +342,14 @@ ...@@ -330,13 +342,14 @@
#\a #\b #\c) #\a #\b #\c)
(deftest elt-fill-pointer.6 (deftest elt-fill-pointer.6
(classify-error (signals-error
(let ((a (make-array '(5) (let ((a (make-array '(5)
:initial-contents '(#\a #\b #\c #\d #\e) :initial-contents '(#\a #\b #\c #\d #\e)
:element-type 'character :element-type 'character
:fill-pointer 3))) :fill-pointer 3)))
(elt a 4))) (elt a 4))
type-error) type-error)
t)
(deftest elt-fill-pointer.7 (deftest elt-fill-pointer.7
(let ((a (make-array '(5) (let ((a (make-array '(5)
...@@ -347,22 +360,23 @@ ...@@ -347,22 +360,23 @@
#\a #\b #\c) #\a #\b #\c)
(deftest elt-fill-pointer.8 (deftest elt-fill-pointer.8
(classify-error (signals-error
(let ((a (make-array '(5) (let ((a (make-array '(5)
:initial-contents '(#\a #\b #\c #\d #\e) :initial-contents '(#\a #\b #\c #\d #\e)
:element-type 'base-char :element-type 'base-char
:fill-pointer 3))) :fill-pointer 3)))
(elt a 4))) (elt a 4))
type-error) type-error)
t)
(deftest elt.error.1 (deftest elt.error.1
(classify-error (elt)) (signals-error (elt) program-error)
program-error) t)
(deftest elt.error.2 (deftest elt.error.2
(classify-error (elt nil)) (signals-error (elt nil) program-error)
program-error) t)
(deftest elt.error.3 (deftest elt.error.3
(classify-error (elt nil 0 nil)) (signals-error (elt nil 0 nil) program-error)
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