Commit 50857330 authored by pfdietz's avatar pfdietz

Changed classify-error forms to signals-error forms.

parent b0ecdaa7
......@@ -48,13 +48,11 @@
t)
(deftest adjustable-array-p.error.4
(let (why)
(loop for e in *mini-universe*
unless (or (typep e 'array)
(eq 'type-error
(setq why (classify-error**
`(adjustable-array-p ',e)))))
collect (list e why)))
(loop for e in *mini-universe*
unless (or (typep e 'array)
(eval `(signals-error (adjustable-array-p ',e)
type-error)))
collect e)
nil)
(deftest adjustable-array-p.error.5
......
......@@ -51,13 +51,11 @@
t)
(deftest array-dimensions.error.3
(let (why)
(loop for e in *mini-universe*
unless (or (typep e 'array)
(eq 'type-error
(setq why (classify-error**
`(array-dimensions ',e)))))
collect (list e why)))
(loop for e in *mini-universe*
unless (or (typep e 'array)
(eval `(signals-error (array-dimensions ',e)
type-error)))
collect e)
nil)
(deftest array-dimensions.error.4
......
......@@ -116,13 +116,11 @@
t)
(deftest array-displacement.error.3
(let (why)
(loop for e in *mini-universe*
unless (or (typep e 'array)
(eq 'type-error
(setq why (classify-error**
`(array-displacement ',e)))))
collect (list e why)))
(loop for e in *mini-universe*
unless (or (typep e 'array)
(eval `(signals-error (array-displacement ',e)
type-error)))
collect e)
nil)
(deftest array-displacement.error.4
......
......@@ -37,9 +37,8 @@
(deftest array-rank.error.3
(loop for e in *mini-universe*
when (and (not (typep e 'array))
(not (eq (classify-error** `(array-rank ',e))
'type-error)))
unless (or (typep e 'array)
(eval `(signals-error (array-rank ',e) type-error)))
collect e)
nil)
......
......@@ -45,13 +45,11 @@
t)
(deftest array-total-size.error.3
(let (why)
(loop for e in *mini-universe*
when (and (not (typep e 'array))
(not (eql (setq why
(classify-error** `(array-total-size ',e)))
'type-error)))
collect (list e why)))
(loop for e in *mini-universe*
unless (or (typep e 'array)
(eval `(signals-error (array-total-size ',e)
type-error)))
collect e)
nil)
(deftest array-total-size.error.4
......
......@@ -6,16 +6,16 @@
(in-package :cl-test)
(deftest ensure-generic-function.1
(subtypep* (classify-error (ensure-generic-function 'car)) 'error)
t t)
(signals-error (ensure-generic-function 'car) error)
t)
(deftest ensure-generic-function.2
(subtypep* (classify-error (ensure-generic-function 'defclass)) 'error)
t t)
(signals-error (ensure-generic-function 'defclass) error)
t)
(deftest ensure-generic-function.3
(subtypep* (classify-error (ensure-generic-function 'tagbody)) 'error)
t t)
(signals-error (ensure-generic-function 'tagbody) error)
t)
(deftest ensure-generic-function.4
(let ((f 'egf-fun-4))
......@@ -51,17 +51,17 @@
(notnot-mv (eval `(defmethod ,f ((a t)(b t)(c t)) (list a b c))))
;; Test of incongruent generic function lambda list when no
;; methods exist
(subtypep*
(classify-error** `(ensure-generic-function ',f :lambda-list '(x y)))
'error)))
(eval
`(signals-error (ensure-generic-function ',f :lambda-list '(x y))
error))))
nil t t t)
;;; Many more tests are needed for other combinations of keyword parameters
(deftest ensure-generic-function.error.1
(classify-error (ensure-generic-function))
program-error)
(signals-error (ensure-generic-function) program-error)
t)
(deftest ensure-generic-function.error.2
(classify-error (ensure-generic-function (gensym) :lambda-list))
program-error)
(signals-error (ensure-generic-function (gensym) :lambda-list) program-error)
t)
......@@ -375,14 +375,14 @@
(deftest flet.49
(loop for s in *cl-non-function-macro-special-operator-symbols*
for form = `(classify-error (flet ((,s () 'a)) (,s)))
for form = `(ignore-errors (flet ((,s () 'a)) (,s)))
unless (eq (eval form) 'a)
collect s)
nil)
(deftest flet.50
(loop for s in *cl-non-function-macro-special-operator-symbols*
for form = `(classify-error (flet ((,s () 'a))
for form = `(ignore-errors (flet ((,s () 'a))
(declare (ftype (function () symbol)
,s))
(,s)))
......@@ -393,7 +393,7 @@
;;; Binding SETF functions of certain COMMON-LISP symbols
(deftest flet.51
(loop for s in *cl-non-function-macro-special-operator-symbols*
for form = `(classify-error
for form = `(ignore-errors
(flet (((setf ,s) (&rest args)
(declare (ignore args))
'a))
......
......@@ -8,16 +8,16 @@
(compile-and-load "numbers-aux.lsp")
(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)
(deftest 1+.1
(loop for x = (random-fixnum)
......
......@@ -63,9 +63,9 @@
;;; Error tests
(deftest simple-vector-p.error.1
(classify-error (simple-vector-p))
program-error)
(signals-error (simple-vector-p) program-error)
t)
(deftest simple-vector-p.error.2
(classify-error (simple-vector-p #(a b) nil))
program-error)
(signals-error (simple-vector-p #(a b) nil) program-error)
t)
......@@ -37,16 +37,16 @@
nil)
(deftest tailp.error.5
(classify-error (tailp))
program-error)
(signals-error (tailp) program-error)
t)
(deftest tailp.error.6
(classify-error (tailp nil))
program-error)
(signals-error (tailp nil) program-error)
t)
(deftest tailp.error.7
(classify-error (tailp nil nil nil))
program-error)
(signals-error (tailp nil nil nil) program-error)
t)
;; Test that tailp does not modify its arguments
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment