69 |
t a b) |
t a b) |
70 |
|
|
71 |
|
|
72 |
|
;;; Tests of user-defined methods |
73 |
|
|
74 |
|
(defclass reinit-class-01 () |
75 |
|
((a :initarg :a) (b :initarg :b))) |
76 |
|
|
77 |
|
(defmethod reinitialize-instance :after ((instance reinit-class-01) |
78 |
|
&rest initargs |
79 |
|
&key (x nil x-p)) |
80 |
|
(declare (ignore initargs)) |
81 |
|
(when x-p (setf (slot-value instance 'a) x)) |
82 |
|
instance) |
83 |
|
|
84 |
|
(deftest reinitialize-instance.8 |
85 |
|
(let* ((obj (make-instance 'reinit-class-01)) |
86 |
|
(obj2 (reinitialize-instance obj :a 1 :b 3))) |
87 |
|
(values |
88 |
|
(eqt obj obj2) |
89 |
|
(map-slot-value obj2 '(a b)))) |
90 |
|
t (1 3)) |
91 |
|
|
92 |
|
(deftest reinitialize-instance.9 |
93 |
|
(let* ((obj (make-instance 'reinit-class-01 :a 10 :b 20)) |
94 |
|
(obj2 (reinitialize-instance obj :x 3))) |
95 |
|
(values |
96 |
|
(eqt obj obj2) |
97 |
|
(map-slot-value obj2 '(a b)))) |
98 |
|
t (3 20)) |
99 |
|
|
100 |
|
(deftest reinitialize-instance.10 |
101 |
|
(let* ((obj (make-instance 'reinit-class-01 :a 10 :b 20)) |
102 |
|
(obj2 (reinitialize-instance obj :x 3 :x 100))) |
103 |
|
(values |
104 |
|
(eqt obj obj2) |
105 |
|
(map-slot-value obj2 '(a b)))) |
106 |
|
t (3 20)) |
107 |
|
|
108 |
|
;;; Error cases |
109 |
|
|
110 |
|
(deftest reinitialize-instance.error.1 |
111 |
|
(handler-case |
112 |
|
(eval '(reinitialize-instance (make-instance 'class-01) :garbage t)) |
113 |
|
(error () :good)) |
114 |
|
:good) |
115 |
|
|
116 |
|
(deftest reinitialize-instance.error.2 |
117 |
|
(classify-error (reinitialize-instance)) |
118 |
|
program-error) |
119 |
|
|
120 |
|
|
121 |
|
|