/[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.2 by pfdietz, Sat May 17 21:57:26 2003 UTC revision 1.3 by pfdietz, Tue May 20 11:40:13 2003 UTC
# Line 128  Line 128 
128          (map-slot-value newobj '(a b c)))))          (map-slot-value newobj '(a b c)))))
129    2 t (t t t) (7 100 64))    2 t (t t t) (7 100 64))
130    
131    (defpackage "CL-TEST-MLFSS-PACKAGE" (:use) (:export "A"))
132    (defstruct mlfss-03 cl-test-mlfss-package:a)
133    
134    (deftest make-load-form-savings-slots.10
135      (let* ((obj (make-mlfss-03 :a 17))
136             (forms (multiple-value-list
137                     (make-load-form-saving-slots obj))))
138        (let ((newobj (eval (first forms))))
139          (eval (subst newobj obj (second forms)))
140          (values
141           (mlfss-03-a obj)
142           (length forms)
143           (eqt (class-of obj) (class-of newobj))
144           (mlfss-03-a newobj))))
145      17 2 t 17)
146    
147    (deftest make-load-form-savings-slots.11
148      (let* ((obj (make-mlfss-03 :a 17))
149             (forms (multiple-value-list
150                     (make-load-form-saving-slots
151                      obj
152                      :slot-names '(cl-test-mlfss-package:a)))))
153        (let ((newobj (eval (first forms))))
154          (eval (subst newobj obj (second forms)))
155          (values
156           (mlfss-03-a obj)
157           (length forms)
158           (eqt (class-of obj) (class-of newobj))
159           (mlfss-03-a newobj))))
160      17 2 t 17)
161    
162    
163    (defstruct mlfss-04 (a 0 :read-only t))
164    
165    (deftest make-load-form-savings-slots.12
166      (let* ((obj (make-mlfss-04 :a 123))
167             (forms (multiple-value-list
168                     (make-load-form-saving-slots obj))))
169        (let ((newobj (eval (first forms))))
170          (eval (subst newobj obj (second forms)))
171          (values
172           (mlfss-04-a obj)
173           (length forms)
174           (eqt (class-of obj) (class-of newobj))
175           (mlfss-04-a newobj))))
176      123 2 t 123)
177    
178    
179  ;;; General error tests  ;;; General error tests
180    

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