From e771f3109dfd2203a4eb8e249d67219c0de36911 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Thu, 12 Jun 2003 02:34:06 +0000 Subject: [PATCH] Added tests for UNBOUND-SLOT condition and its accessors. --- ansi-tests/load-objects.lsp | 1 + ansi-tests/unbound-slot.lsp | 36 ++++++++++++++++++++++++++++++++++++ 2 files changed, 37 insertions(+) create mode 100644 ansi-tests/unbound-slot.lsp diff --git a/ansi-tests/load-objects.lsp b/ansi-tests/load-objects.lsp index 904fa563..1b1b89fe 100644 --- a/ansi-tests/load-objects.lsp +++ b/ansi-tests/load-objects.lsp @@ -48,3 +48,4 @@ (load "compute-applicable-methods.lsp") (load "find-method.lsp") (load "add-method.lsp") +(load "unbound-slot.lsp") diff --git a/ansi-tests/unbound-slot.lsp b/ansi-tests/unbound-slot.lsp new file mode 100644 index 00000000..36045c6b --- /dev/null +++ b/ansi-tests/unbound-slot.lsp @@ -0,0 +1,36 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Wed Jun 4 20:14:26 2003 +;;;; Contains: Tests for UNBOUND-SLOT, UNBOUND-SLOT-INSTANCE + +(in-package :cl-test) + +(defclass ubs-class-01 () + ((a :initarg :a))) + +(deftest unbound-slot.1 + (let ((obj (make-instance 'ubs-class-01))) + (handler-case + (slot-value obj 'a) + (unbound-slot (c) + (values + (typep* c 'cell-error) + (eqt (unbound-slot-instance c) obj) + (cell-error-name c))))) + t t a) + +(defclass ubs-class-02 () + ((b :allocation :class))) + +(deftest unbound-slot.2 + (let ((obj (make-instance 'ubs-class-02))) + (handler-case + (slot-value obj 'b) + (unbound-slot (c) + (values + (typep* c 'cell-error) + (eqt (unbound-slot-instance c) obj) + (cell-error-name c))))) + t t b) + + -- GitLab