/[gcl]/gcl/ansi-tests/update-instance-for-different-class.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/update-instance-for-different-class.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by pfdietz, Tue May 6 02:34:11 2003 UTC revision 1.4 by pfdietz, Tue May 6 02:48:46 2003 UTC
# Line 85  Line 85 
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    

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26