From 480c5efdc0e4dbae64c3da1fc01a5f7baa29b448 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Thu, 13 Mar 2003 05:45:25 +0000 Subject: [PATCH] More define-condition tests, and begin including them in the default load. --- ansi-tests/define-condition.lsp | 88 +++++++++++++++++++++++++++++++++ ansi-tests/load-conditions.lsp | 3 ++ 2 files changed, 91 insertions(+) diff --git a/ansi-tests/define-condition.lsp b/ansi-tests/define-condition.lsp index 6aa7857c..ef5c4e9e 100644 --- a/ansi-tests/define-condition.lsp +++ b/ansi-tests/define-condition.lsp @@ -11,3 +11,91 @@ (define-condition-with-tests cond-2 (condition) nil) +(define-condition-with-tests #:cond-3 nil nil) + +(define-condition-with-tests cond-4 nil + ((slot1 :initarg :slot1 :reader cond-4/slot-1) + (slot2 :initarg :slot2 :reader cond-4/slot-2))) + +(deftest cond-4-slots.1 + (let ((c (make-condition 'cond-4 :slot1 'a :slot2 'b))) + (and (typep c 'cond-4) + (eqt (cond-4/slot-1 c) 'a) + (eqt (cond-4/slot-2 c) 'b))) + t) + +(define-condition-with-tests cond-5 nil + ((slot1 :initarg :slot1 :initform 'x :reader cond-5/slot-1) + (slot2 :initarg :slot2 :initform 'y :reader cond-5/slot-2))) + +(deftest cond-5-slots.1 + (let ((c (make-condition 'cond-5 :slot1 'a :slot2 'b))) + (and (typep c 'cond-5) + (eqt (cond-5/slot-1 c) 'a) + (eqt (cond-5/slot-2 c) 'b))) + t) + +(deftest cond-5-slots.2 + (let ((c (make-condition 'cond-5 :slot1 'a))) + (and (typep c 'cond-5) + (eqt (cond-5/slot-1 c) 'a) + (eqt (cond-5/slot-2 c) 'y))) + t) + +(deftest cond-5-slots.3 + (let ((c (make-condition 'cond-5 :slot2 'b))) + (and (typep c 'cond-5) + (eqt (cond-5/slot-1 c) 'x) + (eqt (cond-5/slot-2 c) 'b))) + t) + +(deftest cond-5-slots.4 + (let ((c (make-condition 'cond-5))) + (and (typep c 'cond-5) + (eqt (cond-5/slot-1 c) 'x) + (eqt (cond-5/slot-2 c) 'y))) + t) + +(define-condition-with-tests cond-6 nil + ((slot1 :initarg :slot1 :initarg :both-slots + :initform 'x :reader cond-6/slot-1) + (slot2 :initarg :slot2 :initarg :both-slots + :initform 'y :reader cond-6/slot-2))) + +(deftest cond-6-slots.1 + (let ((c (make-condition 'cond-6 :both-slots 'a))) + (and (typep c 'cond-6) + (eqt (cond-6/slot-1 c) 'a) + (eqt (cond-6/slot-2 c) 'a))) + t) + +(deftest cond-6-slots.2 + (let ((c (make-condition 'cond-6))) + (and (typep c 'cond-6) + (eqt (cond-6/slot-1 c) 'x) + (eqt (cond-6/slot-2 c) 'y))) + t) + +(deftest cond-6-slots.3 + (let ((c (make-condition 'cond-6 :slot1 'a :both-slots 'b))) + (and (typep c 'cond-6) + (eqt (cond-6/slot-1 c) 'a) + (eqt (cond-6/slot-2 c) 'b))) + t) + +(deftest cond-6-slots.4 + (let ((c (make-condition 'cond-6 :slot2 'b :both-slots 'a))) + (and (typep c 'cond-6) + (eqt (cond-6/slot-1 c) 'a) + (eqt (cond-6/slot-2 c) 'b))) + t) + +(deftest cond-6-slots.5 + (let ((c (make-condition 'cond-6 :both-slots 'a :slot1 'c :slot2 'd))) + (and (typep c 'cond-6) + (eqt (cond-6/slot-1 c) 'a) + (eqt (cond-6/slot-2 c) 'a))) + t) + + + diff --git a/ansi-tests/load-conditions.lsp b/ansi-tests/load-conditions.lsp index d8c90610..43c8048f 100644 --- a/ansi-tests/load-conditions.lsp +++ b/ansi-tests/load-conditions.lsp @@ -10,4 +10,7 @@ (load "handler-bind.lsp") (load "handler-case.lsp") (load "ignore-errors.lsp") +(compile-and-load "define-condition-aux.lsp") +(load "define-condition.lsp") + -- GitLab