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