Commit bd6c8796 authored by pfdietz's avatar pfdietz

Changed classify-error forms to signals-error forms.

parent d30e0cfd
......@@ -9,140 +9,162 @@
;;; tests could be reduced in size.
(deftest defclass.error.1
(classify-error
(signals-error
(defclass erroneous-class.1 ()
(a b c d b e)))
program-error)
(a b c d b e))
program-error)
t)
(deftest defclass.error.2
(classify-error
(signals-error
(defclass erroneous-class.2 ()
((s1 :initarg :foo))
(:default-initargs :foo 1 :foo 2)))
program-error)
(:default-initargs :foo 1 :foo 2))
program-error)
t)
(deftest defclass.error.3
(classify-error
(signals-error
(defclass erroneous-class.3 ()
((s1 :initform 0 :initform 2))))
program-error)
((s1 :initform 0 :initform 2)))
program-error)
t)
(deftest defclass.error.4
(classify-error
(signals-error
(defclass erroneous-class.4 ()
((s1 :initform 0 :initform 0))))
program-error)
((s1 :initform 0 :initform 0)))
program-error)
t)
(deftest defclass.error.5
(classify-error
(signals-error
(defclass erroneous-class.5 ()
((s1 :type fixnum :type character))))
program-error)
((s1 :type fixnum :type character)))
program-error)
t)
(deftest defclass.error.6
(classify-error
(signals-error
(defclass erroneous-class.6 ()
((s1 :type t :type t))))
program-error)
((s1 :type t :type t)))
program-error)
t)
(deftest defclass.error.7
(classify-error
(signals-error
(defclass erroneous-class.7 ()
((s1 :documentation "foo" :documentation "bar"))))
program-error)
((s1 :documentation "foo" :documentation "bar")))
program-error)
t)
(deftest defclass.error.8
(classify-error
(signals-error
(defclass erroneous-class.8 ()
((s1 :documentation #1="foo" :documentation #1#))))
program-error)
((s1 :documentation #1="foo" :documentation #1#)))
program-error)
t)
(deftest defclass.error.9
(classify-error
(signals-error
(defclass erroneous-class.9 ()
((s1 :allocation :class :allocation :instance))))
program-error)
((s1 :allocation :class :allocation :instance)))
program-error)
t)
(deftest defclass.error.10
(classify-error
(signals-error
(defclass erroneous-class.10 ()
((s1 :allocation :class :allocation :class))))
program-error)
((s1 :allocation :class :allocation :class)))
program-error)
t)
(deftest defclass.error.11
(classify-error
(signals-error
(defclass erroneous-class.11 ()
((s1 :allocation :instance :allocation :instance))))
program-error)
((s1 :allocation :instance :allocation :instance)))
program-error)
t)
(deftest defclass.error.12
(classify-error
(signals-error
(defclass erroneous-class.12 ()
((s1 #.(gensym) nil))))
program-error)
((s1 #.(gensym) nil)))
program-error)
t)
(deftest defclass.error.13
(classify-error
(signals-error
(defclass erroneous-class.13 ()
(a b c)
(#.(gensym))))
program-error)
(#.(gensym)))
program-error)
t)
(deftest defclass.error.14
(classify-error
(signals-error
(defclass defclass-error-14 nil
(foo foo)))
program-error)
(foo foo))
program-error)
t)
(deftest defclass.error.15
(classify-error
(signals-error
(defclass defclass-error-15 nil
(foo (foo))))
program-error)
(foo (foo)))
program-error)
t)
(deftest defclass.error.16
(classify-error
(signals-error
(defclass defclass-error-16 nil
((foo :initarg f1))
(:default-initargs :f1 10 :f1 20)))
program-error)
(:default-initargs :f1 10 :f1 20))
program-error)
t)
(deftest defclass.error.17
(classify-error
(signals-error
(defclass defclass-error-17 nil
((foo :initform 10 :initform 20 :reader defclass-error-4/foo))))
program-error)
((foo :initform 10 :initform 20 :reader defclass-error-4/foo)))
program-error)
t)
(deftest defclass.error.18
(classify-error
(signals-error
(defclass defclass-error-18 nil
((foo :initform 10 :initform 10 :reader defclass-error-5/foo))))
program-error)
((foo :initform 10 :initform 10 :reader defclass-error-5/foo)))
program-error)
t)
(deftest defclass.error.19
(classify-error
(signals-error
(defclass defclass-error-19 nil
((foo :initarg f1 :type t :type t :reader defclass-error-6/foo))))
program-error)
((foo :initarg f1 :type t :type t :reader defclass-error-6/foo)))
program-error)
t)
(deftest defclass.error.20
(classify-error
(signals-error
(defclass defclass-error-20 nil
((foo :initarg f1 :documentation "x" :reader defclass-error-7/foo
:documentation "x"))))
program-error)
:documentation "x")))
program-error)
t)
(deftest defclass.error.21
(classify-error
(signals-error
(defclass defclass-error-21 ()
((foo #:unknown-slot-option nil))))
program-error)
((foo #:unknown-slot-option nil)))
program-error)
t)
(deftest defclass.error.22
(let ((option (gentemp "UNKNOWN-OPTION" (symbol-package :foo))))
(eval
`(classify-error
`(signals-error
(defclass defclass-error-22 ()
(foo bar)
(,option nil)))))
program-error)
(,option nil))
program-error)))
t)
......@@ -119,18 +119,9 @@
(return 3))
(unless (typep (eval `(defclass ,c2 (,c4 ,c5) nil)) 'class)
(return 4))
(let ((error-symbol
(classify-error**
`(progn
(defclass ,c3 (,c5 ,c4) nil)
(make-instance ',c1)))))
(and (symbolp error-symbol)
(subtypep error-symbol 'error)
'good))))
good)
(handler-case
(eval `(progn
(defclass ,c3 (,c5 ,c4) nil)
(make-instance ',c1)))
(error () :good))))
:good)
......@@ -31,31 +31,34 @@
test-constant-3)
;;; (deftest defconstant.error.1
;;; (classify-error (defconstant))
;;; program-error)
;;; (signals-error (defconstant) program-error)
;;; t)
;;;
;;; (deftest defconstant.error.2
;;; (classify-error (defconstant +ignorable-constant-name+))
;;; program-error)
;;; (signals-error (defconstant +ignorable-constant-name+) program-error)
;;; t)
;;;
;;; (deftest defconstant.error.3
;;; (classify-error (defconstant +ignorable-constant-name2+ nil
;;; (signals-error (defconstant +ignorable-constant-name2+ nil
;;; "This is a docstring"
;;; "This is an unnecessary extra argument."))
;;; program-error)
;;; "This is an unnecessary extra argument.")
;;; program-error)
;;; t)
(deftest defconstant.error.1
(classify-error (funcall (macro-function 'defconstant)))
program-error)
(signals-error (funcall (macro-function 'defconstant))
program-error)
t)
(deftest defconstant.error.2
(classify-error (funcall (macro-function 'defconstant)
'(defconstant +nonexistent-constant+ 0)))
program-error)
(signals-error (funcall (macro-function 'defconstant)
'(defconstant +nonexistent-constant+ 0))
program-error)
t)
(deftest defconstant.error.3
(classify-error (funcall (macro-function 'defconstant)
(signals-error (funcall (macro-function 'defconstant)
'(defconstant +nonexistent-constant+ 0)
nil nil))
program-error)
\ No newline at end of file
nil nil)
program-error)
t)
......@@ -41,20 +41,23 @@
nil)
(deftest defgeneric.error.4
(classify-error (defgeneric defgeneric-error-fn.4 (x y)
(:argument-precedence-order x y x)))
program-error)
(signals-error (defgeneric defgeneric-error-fn.4 (x y)
(:argument-precedence-order x y x))
program-error)
t)
(deftest defgeneric.error.5
(classify-error (defgeneric defgeneric-error-fn.5 (x)
(signals-error (defgeneric defgeneric-error-fn.5 (x)
(:documentation "some documentation")
(:documentation "illegally repeated documentation")))
program-error)
(:documentation "illegally repeated documentation"))
program-error)
t)
(deftest defgeneric.error.6
(classify-error (defgeneric defgeneric-error-fn.6 (x)
(unknown-option nil)))
program-error)
(signals-error (defgeneric defgeneric-error-fn.6 (x)
(unknown-option nil))
program-error)
t)
(deftest defgeneric.error.7
(handler-case
......@@ -66,9 +69,10 @@
:good)
(deftest defgeneric.error.8
(classify-error (defgeneric defgeneric-error-fn.8 (x y)
(:argument-precedence-order x)))
program-error)
(signals-error (defgeneric defgeneric-error-fn.8 (x y)
(:argument-precedence-order x))
program-error)
t)
;;; Non-congruent methods cause defgeneric to signal an error
......@@ -178,20 +182,22 @@
;;; error tests are necessary. See sections 7.6.5 of the CLHS.
(deftest defgeneric.error.20
(classify-error
(signals-error
(let ((fn (defgeneric defgeneric-error-fn.20 (x &key)
(:method ((x number) &key foo) (list x foo))
(:method ((x symbol) &key bar) (list x bar)))))
(funcall fn 1 :bar 'a)))
program-error)
(funcall fn 1 :bar 'a))
program-error)
t)
(deftest defgeneric.error.21
(classify-error
(signals-error
(let ((fn (defgeneric defgeneric-error-fn.21 (x &key)
(:method ((x number) &key foo &allow-other-keys) (list x foo))
(:method ((x symbol) &key bar) (list x bar)))))
(funcall fn 'x :foo 'a)))
program-error)
(funcall fn 'x :foo 'a))
program-error)
t)
;;;
......@@ -205,8 +211,6 @@
:good)
;;; Non error cases
(deftest defgeneric.1
......
......@@ -8,16 +8,19 @@
;;; Need to add non-error tests
(deftest define-compiler-macro.error.1
(classify-error (funcall (macro-function 'define-compiler-macro)))
program-error)
(signals-error (funcall (macro-function 'define-compiler-macro))
program-error)
t)
(deftest define-compiler-macro.error.2
(classify-error (funcall (macro-function 'define-compiler-macro)
'(definee-compiler-macro nonexistent-function ())))
program-error)
(signals-error (funcall (macro-function 'define-compiler-macro)
'(definee-compiler-macro nonexistent-function ()))
program-error)
t)
(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 ())
nil nil))
program-error)
nil nil)
program-error)
t)
......@@ -65,21 +65,22 @@
(3 #(0 0 3 0 0) 3))
;;; (deftest define-modify-macro.error.1
;;; (classify-error (define-modify-macro))
;;; program-error)
;;; (signals-error (define-modify-macro) program-error)
;;; t)
;;;
;;; (deftest define-modify-macro.error.2
;;; (classify-error (define-modify-macro dfm-error-1))
;;; program-error)
;;; (signals-error (define-modify-macro dfm-error-1) program-error)
;;; t)
;;;
;;; (deftest define-modify-macro.error.3
;;; (classify-error (define-modify-macro dfm-error-2 ()))
;;; program-error)
;;; (signals-error (define-modify-macro dfm-error-2 ()) program-error)
;;; t)
;;;
;;; (deftest define-modify-macro.error.4
;;; (classify-error (define-modify-macro dfm-error-2 () nil "Documentation"
;;; "extra illegal argument"))
;;; program-error)
;;; (signals-error (define-modify-macro dfm-error-2 () nil "Documentation"
;;; "extra illegal argument")
;;; program-error)
;;; t)
(def-macro-test define-modify-macro.error.1
(define-modify-macro nonexistent-modify-macro () foo))
......@@ -6,18 +6,21 @@
(in-package :cl-test)
(deftest define-symbol-macro.error.1
(classify-error (funcall (macro-function 'define-symbol-macro)))
program-error)
(signals-error (funcall (macro-function 'define-symbol-macro))
program-error)
t)
(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
nonexistent-symbol-macro nil)))
program-error)
nonexistent-symbol-macro nil))
program-error)
t)
(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
nonexistent-symbol-macro nil)
nil nil))
program-error)
nil nil)
program-error)
t)
......@@ -5,19 +5,23 @@
(in-package :cl-test)
;;; FIXME
;;; Need to add non-error tests
(deftest defmacro.error.1
(classify-error (funcall (macro-function 'defmacro)))
program-error)
(signals-error (funcall (macro-function 'defmacro))
program-error)
t)
(deftest defmacro.error.2
(classify-error (funcall (macro-function 'defmacro)
'(defmacro nonexistent-macro ())))
program-error)
(signals-error (funcall (macro-function 'defmacro)
'(defmacro nonexistent-macro ()))
program-error)
t)
(deftest defmacro.error.3
(classify-error (funcall (macro-function 'defmacro)
(signals-error (funcall (macro-function 'defmacro)
'(defmacro nonexistent-macro ())
nil nil))
program-error)
nil nil)
program-error)
t)
......@@ -52,31 +52,35 @@
300)
;;; (deftest defparameter.error.1
;;; (classify-error (defparameter))
;;; program-error)
;;; (signals-error (defparameter) program-error)
;;; t)
;;;
;;; (deftest defparameter.error.2
;;; (classify-error (defparameter *ignored-defparameter-name*))
;;; program-error)
;;; (signals-error (defparameter *ignored-defparameter-name*)
;;; program-error)
;;; t)
;;;
;;; (deftest defparameter.error.3
;;; (classify-error (defparameter *ignored-defparameter-name* nil
;;; (signals-error (defparameter *ignored-defparameter-name* nil
;;; "documentation"
;;; "illegal extra argument"))
;;; program-error)
;;; "illegal extra argument")
;;; program-error)
;;; t)
(deftest defparameter.error.1
(classify-error (funcall (macro-function 'defparameter)))
program-error)
(signals-error (funcall (macro-function 'defparameter))
program-error)
t)
(deftest defparameter.error.2
(classify-error (funcall (macro-function 'defparameter)
'(defparameter *nonexistent-variable* nil)))
program-error)
(signals-error (funcall (macro-function 'defparameter)
'(defparameter *nonexistent-variable* nil))
program-error)
t)
(deftest defparameter.error.3
(classify-error (funcall (macro-function 'defparameter)
(signals-error (funcall (macro-function 'defparameter)
'(defparameter *nonexistent-variable* nil)
nil nil))
program-error)
nil nil)
program-error)
t)
......@@ -5,17 +5,24 @@
(in-package :cl-test)
;;; FIXME
;;; Need to add non-error tests
(deftest deftype.error.1
(classify-error (funcall (macro-function 'deftype)))
program-error)
(signals-error (funcall (macro-function 'deftype))
program-error)
t)
(deftest deftype.error.2
(classify-error (funcall (macro-function 'deftype)
'(deftype nonexistent-type () nil)))
program-error)
(signals-error (funcall (macro-function 'deftype)
'(deftype nonexistent-type () nil))
program-error)
t)
(deftest deftype.error.3
(classify-error (funcall (macro-function 'deftype)
(signals-error (funcall (macro-function 'deftype)
'(deftype nonexistent-type () nil)
nil nil))
program-error)
nil nil)
program-error)
t)
......@@ -6,19 +6,22 @@
(in-package :cl-test)
(deftest defun.error.1
(classify-error (funcall (macro-function 'defun)))
program-error)
(signals-error (funcall (macro-function 'defun))
program-error)
t)
(deftest defun.error.2
(classify-error (funcall (macro-function 'defun)
'(defun nonexistent-function ())))
program-error)
(signals-error (funcall (macro-function 'defun)
'(defun nonexistent-function ()))
program-error)
t)
(deftest defun.error.3
(classify-error (funcall (macro-function 'defun)
(signals-error (funcall (macro-function 'defun)
'(defun nonexistent-function ())
nil nil))
program-error)
nil nil)
program-error)
t)
;;; Tests for implicit blocks
......
......@@ -55,26 +55,29 @@
0)
;;; (deftest defvar.error.1
;;; (classify-error (defvar))
;;; program-error)
;;; (signals-error (defvar) program-error)
;;; t)
;;;
;;; (deftest defvar.error.2
;;; (classify-error (defvar *ignored-defvar-name* nil "documentation"
;;; "illegal extra argument"))
;;; program-error)
;;; (signals-error (defvar *ignored-defvar-name* nil "documentation"
;;; "illegal extra argument")
;;; program-error)
;;; t)
(deftest defvar.error.1
(classify-error (funcall (macro-function 'defvar)))
program-error)
(signals-error (funcall (macro-function 'defvar))
program-error)
t)
(deftest defvar.error.2
(classify-error (funcall (macro-function 'defvar)
'(defvar *nonexistent-variable* nil)))
program-error)
(signals-error (funcall (macro-function 'defvar)
'(defvar *nonexistent-variable* nil))
program-error)
t)
(deftest defvar.error.3
(classify-error (funcall (macro-function 'defvar)
(signals-error (funcall (macro-function 'defvar)
'(defvar *nonexistent-variable* nil)
nil nil))
program-error)
nil nil)
program-error)
t)
......@@ -54,8 +54,8 @@
;;;
(deftest delete-file.error.1
(classify-error (delete-file))
program-error)
(signals-error (delete-file) program-error)
t)
(deftest delete-file.error.2
(let ((pn "scratch.txt"))
......@@ -64,18 +64,15 @@
(format s "Contents~%")))
(values
(notnot (probe-file pn))
(classify-error (delete-file "scratch.txt" nil))
(signals-error (delete-file "scratch.txt" nil) program-error)
(notnot (probe-file pn))
(delete-file pn)
(probe-file pn)))
t program-error t t nil)
t t t t nil)
(deftest delete-file.error.3
(let ((pn "nonexistent.txt"))
(when (probe-file pn) (delete-file pn))
(let ((result (classify-error (delete-file "nonexistent.txt"))))
(if (member result '(file-error t))
t
result)))
(signals-error (delete-file "nonexistent.txt") file-error))
t)
......@@ -5,21 +5,25 @@
(in-package :cl-test)
;;; Error tests
(deftest deposit-field.error.1
(classify-error (deposit-field))
program-error)
(signals-error (deposit-field) program-error)
t)
(deftest deposit-field.error.2
(classify-error (deposit-field 1))
program-error)
(signals-error (deposit-field 1) program-error)
t)
(deftest deposit-field.error.3
(classify-error (deposit-field 1 (byte 1 0)))
program-error)
(signals-error (deposit-field 1 (byte 1 0)) program-error)
t)
(deftest deposit-field.error.4
(classify-error (deposit-field 1 (byte 1 0) 0 nil))
program-error)
(signals-error (deposit-field 1 (byte 1 0) 0 nil) program-error)
t)
;;; Non-error tests
(deftest deposit-field.1
(loop for pos = (random 32)
......
......@@ -116,42 +116,48 @@
#|
(deftest destructuring-bind.error.1
(classify-error (destructuring-bind (a b c) nil (list a b c)))
program-error)
(signals-error (destructuring-bind (a b c) nil (list a b c))
program-error)
t)
(deftest destructuring-bind.error.2
(classify-error (destructuring-bind ((a b c)) nil (list a b c)))
program-error)
(signals-error (destructuring-bind ((a b c)) nil (list a b c))
program-error)
t)
(deftest destructuring-bind.error.3
(classify-error (destructuring-bind (a b) 'x (list a b)))
program-error)
(signals-error (destructuring-bind (a b) 'x (list a b))
program-error)
t)
(deftest destructuring-bind.error.4
(classify-error (destructuring-bind (a . b) 'x (list a b)))
program-error)
(signals-error (destructuring-bind (a . b) 'x (list a b))
program-error)
t)
|#