2
;;;; Author: Paul Dietz
3
;;;; Created: Sun Jun 15 06:03:58 2003
4
;;;; Contains: Tests of SLOT-MISSING
8
(defparameter *slot-missing-class-01-var* nil)
10
(defclass slot-missing-class-01 () (a b c))
12
(defmethod slot-missing ((class t) (obj slot-missing-class-01)
13
(slot-name t) (operation t)
14
&optional (new-value nil new-value-p))
15
(setf *slot-missing-class-01-var*
16
(list slot-name operation new-value (notnot new-value-p))))
18
(deftest slot-missing.1
19
(let ((obj (make-instance 'slot-missing-class-01)))
22
*slot-missing-class-01-var*))
23
(foo slot-value nil nil)
24
(foo slot-value nil nil))
26
(deftest slot-missing.2
27
(let ((obj (make-instance 'slot-missing-class-01)))
29
(setf (slot-value obj 'foo) 'bar)
30
*slot-missing-class-01-var*))
34
(deftest slot-missing.3
35
(let ((obj (make-instance 'slot-missing-class-01)))
37
(eqt obj (slot-makunbound obj 'xyz))
38
*slot-missing-class-01-var*))
40
(xyz slot-makunbound nil nil))
42
(deftest slot-missing.4
43
(let ((obj (make-instance 'slot-missing-class-01)))
45
(notnot (slot-boundp obj 'abc))
46
*slot-missing-class-01-var*))
48
(abc slot-boundp nil nil))
50
(deftest slot-missing.5
51
(let ((obj (make-instance 'slot-missing-class-01)))
53
(d slot-value nil nil))
55
(deftest slot-missing.6
56
(let ((obj (make-instance 'slot-missing-class-01)))
57
(setf (slot-value obj 'd) 'bar))
60
(deftest slot-missing.7
61
(let* ((obj (make-instance 'slot-missing-class-01))
62
(val (slot-makunbound obj 'd)))
68
(defmethod slot-missing ((class t) (obj slot-missing-class-01)
69
(slot-name (eql 'not-there))
70
(operation (eql 'slot-boundp))
72
(declare (ignore new-value))
73
(values nil :ignore-this))
75
(deftest slot-missing.8
76
(let* ((obj (make-instance 'slot-missing-class-01)))
77
(slot-boundp obj 'not-there))