85 |
t t |
t t |
86 |
(t t) |
(t t) |
87 |
2 1) |
2 1) |
88 |
|
|
89 |
|
|
90 |
|
;;; after method |
91 |
|
|
92 |
|
(defclass uifdc-class-02 () ((a :initform 'x :initarg :a) |
93 |
|
(b :initarg :b))) |
94 |
|
|
95 |
|
(defmethod update-instance-for-different-class :after |
96 |
|
((from-obj uifdc-class-01a) |
97 |
|
(to-obj uifdc-class-02) |
98 |
|
&rest initargs &key &allow-other-keys) |
99 |
|
(declare (ignore initargs)) |
100 |
|
(setf (slot-value to-obj 'a) 100) |
101 |
|
to-obj) |
102 |
|
|
103 |
|
(deftest update-instance-for-different-class.5 |
104 |
|
(let* ((obj (make-instance 'uifdc-class-01a)) |
105 |
|
(class (find-class 'uifdc-class-02))) |
106 |
|
(values |
107 |
|
(eqt obj (change-class obj class)) |
108 |
|
(map-slot-boundp* obj '(a b)) |
109 |
|
(slot-value obj 'a))) |
110 |
|
t (t nil) 100) |
111 |
|
|
112 |
|
(deftest update-instance-for-different-class.6 |
113 |
|
(let* ((obj (make-instance 'uifdc-class-01a :a 1)) |
114 |
|
(class (find-class 'uifdc-class-02))) |
115 |
|
(values |
116 |
|
(eqt obj (change-class obj class)) |
117 |
|
(map-slot-boundp* obj '(a b)) |
118 |
|
(slot-value obj 'a))) |
119 |
|
t (t nil) 100) |
120 |
|
|
121 |
|
(deftest update-instance-for-different-class.7 |
122 |
|
(let* ((obj (make-instance 'uifdc-class-01a :b 17)) |
123 |
|
(class (find-class 'uifdc-class-02))) |
124 |
|
(values |
125 |
|
(eqt obj (change-class obj class)) |
126 |
|
(map-slot-boundp* obj '(a b)) |
127 |
|
(slot-value obj 'a) |
128 |
|
(slot-value obj 'b))) |
129 |
|
t (t t) 100 17) |
130 |
|
|
131 |
|
(deftest update-instance-for-different-class.8 |
132 |
|
(let* ((obj (make-instance 'uifdc-class-01a :b 17 :a 4)) |
133 |
|
(class (find-class 'uifdc-class-02))) |
134 |
|
(values |
135 |
|
(eqt obj (change-class obj class)) |
136 |
|
(map-slot-boundp* obj '(a b)) |
137 |
|
(slot-value obj 'a) |
138 |
|
(slot-value obj 'b))) |
139 |
|
t (t t) 100 17) |
140 |
|
|
141 |
|
|
142 |
|
|
143 |
|
|