Commit b2caad62 authored by pfdietz's avatar pfdietz
Browse files

Check that the first object is a copy, not the original object.

parent 6e1264d6
......@@ -8,22 +8,29 @@
(defclass uifdc-class-01a () ((a :initarg :a) (b :initarg :b)))
(defclass uifdc-class-01b () (a b))
(declaim (special *uifdc-01-obj*))
(defmethod update-instance-for-different-class
((from-obj uifdc-class-01a)
(to-obj uifdc-class-01b)
&rest initargs &key &allow-other-keys)
(declare (ignore initargs))
(when (slot-boundp from-obj 'a)
(assert (not (eq *uifdc-01-obj* from-obj)))
(assert (eq *uifdc-01-obj* to-obj))
(if (slot-boundp from-obj 'a)
(setf (slot-value to-obj 'b)
(slot-value from-obj 'a)))
(when (slot-boundp from-obj 'b)
(slot-value from-obj 'a))
(slot-makunbound to-obj 'b))
(if (slot-boundp from-obj 'b)
(setf (slot-value to-obj 'a)
(slot-value from-obj 'b)))
(slot-value from-obj 'b))
(slot-makunbound to-obj 'a))
to-obj)
(deftest update-instance-for-different-class.1
(let ((obj (make-instance 'uifdc-class-01a))
(new-class (find-class 'uifdc-class-01b)))
(let* ((obj (make-instance 'uifdc-class-01a))
(new-class (find-class 'uifdc-class-01b))
(*uifdc-01-obj* obj))
(values
(map-slot-boundp* obj '(a b))
(eqt obj (change-class obj new-class))
......@@ -34,38 +41,39 @@
(nil nil))
(deftest update-instance-for-different-class.2
(let ((obj (make-instance 'uifdc-class-01a :a 1))
(new-class (find-class 'uifdc-class-01b)))
(let* ((obj (make-instance 'uifdc-class-01a :a 1))
(new-class (find-class 'uifdc-class-01b))
(*uifdc-01-obj* obj))
(values
(map-slot-boundp* obj '(a b))
(eqt obj (change-class obj new-class))
(typep* obj new-class)
(map-slot-boundp* obj '(a b))
(slot-value obj 'a)
(slot-value obj 'b)))
(t nil)
t t
(t t)
1 1)
(nil t)
1)
(deftest update-instance-for-different-class.3
(let ((obj (make-instance 'uifdc-class-01a :b 1))
(new-class (find-class 'uifdc-class-01b)))
(let* ((obj (make-instance 'uifdc-class-01a :b 1))
(new-class (find-class 'uifdc-class-01b))
(*uifdc-01-obj* obj))
(values
(map-slot-boundp* obj '(a b))
(eqt obj (change-class obj new-class))
(typep* obj new-class)
(map-slot-boundp* obj '(a b))
(slot-value obj 'a)
(slot-value obj 'b)))
(slot-value obj 'a)))
(nil t)
t t
(t t)
1 1)
(t nil)
1)
(deftest update-instance-for-different-class.4
(let ((obj (make-instance 'uifdc-class-01a :a 1 :b 2))
(new-class (find-class 'uifdc-class-01b)))
(let* ((obj (make-instance 'uifdc-class-01a :a 1 :b 2))
(new-class (find-class 'uifdc-class-01b))
(*uifdc-01-obj* obj))
(values
(map-slot-boundp* obj '(a b))
(eqt obj (change-class obj new-class))
......@@ -77,7 +85,3 @@
t t
(t t)
2 1)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment