Commit 94fee32e authored by pfdietz's avatar pfdietz

Very preliminary versions of files to test DEFINE-CONDITION

(not yet loaded).
parent dca345fa
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Mar 9 05:40:13 2003
;;;; Contains: Auxiliary functions for testing DEFINE-CONDITION
(in-package :cl-test)
(defun make-def-cond-name (name &rest suffixes)
(intern (apply #'concatenate 'string (string name) "/"
(mapcar #'string suffixes))
:cl-test))
(defmacro define-condition-with-tests (name-symbol
parents slot-specs &rest options)
"Create a condition and some associated tests."
(assert (symbolp name-symbol))
(dolist (parent parents) (assert (symbolp parent)))
(let ((name (symbol-name name-symbol)))
`(progn
(define-condition ,name-symbol ,parents ,slot-specs ,@options)
,@(loop for parent in (adjoin 'condition parents)
collect
`(deftest ,(make-def-cond-name name "IS-SUBTYPE-OF/" parent)
(subtypep* ',name-symbol ',parent)
t t))
,@(loop for parent in (adjoin 'condition parents)
collect
`(deftest ,(make-def-cond-name name
"IS-NOT-SUPERTYPE-OF/" parent)
(subtypep* ',parent ',name-symbol)
nil t))
,@(loop for parent in (adjoin 'condition parents)
collect
`(deftest ,(make-def-cond-name name "IS-A/" parent)
(let ((c (make-condition ',name-symbol)))
(notnot-mv (typep c ',parent)))
t))
)))
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Mar 8 22:38:53 2003
;;;; Contains: Tests of DEFINE-CONDITION (part 1)
(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)
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