/[gcl]/gcl/ansi-tests/reinitialize-instance.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/reinitialize-instance.lsp

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

revision 1.2 by pfdietz, Tue Apr 29 03:18:29 2003 UTC revision 1.3 by pfdietz, Wed Apr 30 01:33:49 2003 UTC
# Line 69  Line 69 
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    

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

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