Commit 3b78b935 authored by pfdietz's avatar pfdietz

Moved more of the define-condition tests into the macro.

parent dc08fd54
......@@ -63,5 +63,23 @@
(let ((c (make-condition ',name-symbol)))
(notnot-mv (typep c (find-class ',parent))))
t))
(deftest ,(make-def-cond-name name "HANDLER-CASE-1")
(let ((c (make-condition ',name-symbol)))
(handler-case (signal c)
(,name-symbol (c1) (eqt c c1))))
t)
(deftest ,(make-def-cond-name name "HANDLER-CASE-2")
(let ((c (make-condition ',name-symbol)))
(handler-case (signal c)
(condition (c1) (eqt c c1))))
t)
,@(unless (some #'(lambda (ct) (subtypep ct 'error)) parents)
`((deftest ,(make-def-cond-name name "HANDLER-CASE-3")
(let ((c (make-condition ',name-symbol)))
(handler-case (signal c)
(error () nil)
(,name-symbol (c2) (eqt c c2))))
t)))
)))
......@@ -5,33 +5,9 @@
(in-package :cl-test)
(define-condition-with-tests cond-1 nil nil)
(deftest cond-1.1
(let ((c (make-condition 'cond-1)))
(handler-case (signal c)
(cond-1 (c1) (eqt c c1))))
t)
(deftest cond-1.2
(let ((c (make-condition 'cond-1)))
(handler-case (signal c)
(condition (c1) (eqt c c1))))
t)
(deftest cond-1.3
(let ((c (make-condition 'cond-1)))
(handler-case (signal c)
(error () nil)
(cond-1 () t)))
t)
(deftest cond-1.4
(let ((c (make-condition 'cond-1)))
(and (typep c 'cond-1)
(notnot-mv (typep c (find-class 'cond-1)))))
t)
;;;
(define-condition-with-tests cond-1 nil nil)
(define-condition-with-tests cond-2 (condition) nil)
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