/[gcl]/gcl/ansi-tests/make-load-form-saving-slots.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/make-load-form-saving-slots.lsp

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

revision 1.1 by pfdietz, Sat May 17 18:20:10 2003 UTC revision 1.2 by pfdietz, Sat May 17 21:57:26 2003 UTC
# Line 33  Line 33 
33         (eqt (class-of obj) (class-of newobj)))))         (eqt (class-of obj) (class-of newobj)))))
34    2 t)    2 t)
35    
   
36  (defclass mlfss-02 () ((a :initarg :a) (b :initarg :b) (c :initarg :c)))  (defclass mlfss-02 () ((a :initarg :a) (b :initarg :b) (c :initarg :c)))
37    
38  (deftest make-load-form-saving-slots.3  (deftest make-load-form-saving-slots.3
# Line 75  Line 74 
74          (slot-value newobj 'a))))          (slot-value newobj 'a))))
75    2 t (t nil nil) #(x y z))    2 t (t nil nil) #(x y z))
76    
77    (deftest make-load-form-saving-slots.6
78      (let* ((obj (make-instance 'mlfss-02))
79             (forms (multiple-value-list
80                     (make-load-form-saving-slots obj :allow-other-keys nil))))
81         (let ((newobj (eval (first forms))))
82           (eval (subst newobj obj (second forms)))
83           (values
84            (length forms)
85            (eqt (class-of obj) (class-of newobj))
86            (map-slot-boundp* newobj '(a b c)))))
87      2 t (nil nil nil))
88    
89    ;;; If :slot-names is missing, all initialized slots are retained
90    (deftest make-load-form-saving-slots.7
91      (let* ((obj (make-instance 'mlfss-02 :a (list 'x) :c 6/5))
92             (forms (multiple-value-list
93                     (make-load-form-saving-slots obj))))
94         (let ((newobj (eval (first forms))))
95           (eval (subst newobj obj (second forms)))
96           (values
97            (length forms)
98            (eqt (class-of obj) (class-of newobj))
99            (map-slot-boundp* newobj '(a b c))
100            (map-slot-value newobj '(a c)))))
101      2 t (t nil t) ((x) 6/5))
102    
103    ;;; If :slot-names is present, all initialized slots in the list are retained
104    (deftest make-load-form-saving-slots.8
105      (let* ((obj (make-instance 'mlfss-02 :a (list 'x) :c 6/5))
106             (forms (multiple-value-list
107                     (make-load-form-saving-slots obj :slot-names '(c)))))
108         (let ((newobj (eval (first forms))))
109           (eval (subst newobj obj (second forms)))
110           (values
111            (length forms)
112            (eqt (class-of obj) (class-of newobj))
113            (map-slot-boundp* newobj '(a b c))
114            (slot-value newobj 'c))))
115      2 t (nil nil t) 6/5)
116    
117    ;; It takes an :environment parameter
118    (deftest make-load-form-saving-slots.9
119      (let* ((obj (make-instance 'mlfss-02 :a 7 :c 64 :b 100))
120             (forms (multiple-value-list
121                     (make-load-form-saving-slots obj :environment nil))))
122         (let ((newobj (eval (first forms))))
123           (eval (subst newobj obj (second forms)))
124           (values
125            (length forms)
126            (eqt (class-of obj) (class-of newobj))
127            (map-slot-boundp* newobj '(a b c))
128            (map-slot-value newobj '(a b c)))))
129      2 t (t t t) (7 100 64))
130    
131    
132    ;;; General error tests
133    
134    (deftest make-load-form-saving-slots.error.1
135      (classify-error (make-load-form-saving-slots))
136      program-error)
137    
138    (deftest make-load-form-saving-slots.error.2
139      (classify-error (make-load-form-saving-slots (make-instance 'mlfss-02)
140                                                   :slot-names))
141      program-error)
142    
143    (deftest make-load-form-saving-slots.error.3
144      (classify-error (make-load-form-saving-slots (make-instance 'mlfss-02)
145                                                   (gensym) t))
146      program-error)

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

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