[cl-store-cvs] CVS update: cl-store/ChangeLog cl-store/circularities.lisp cl-store/cl-store.asd cl-store/default-backend.lisp cl-store/package.lisp cl-store/plumbing.lisp cl-store/tests.lisp
Sean Ross
sross at common-lisp.net
Thu Mar 24 08:25:20 UTC 2005
Update of /project/cl-store/cvsroot/cl-store
In directory common-lisp.net:/tmp/cvs-serv21588
Modified Files:
ChangeLog circularities.lisp cl-store.asd default-backend.lisp
package.lisp plumbing.lisp tests.lisp
Log Message:
Changelog 2005-03-24
Date: Thu Mar 24 09:25:17 2005
Author: sross
Index: cl-store/ChangeLog
diff -u cl-store/ChangeLog:1.28 cl-store/ChangeLog:1.29
--- cl-store/ChangeLog:1.28 Wed Mar 23 13:58:43 2005
+++ cl-store/ChangeLog Thu Mar 24 09:25:16 2005
@@ -1,3 +1,12 @@
+2005-03-24 Sean Ross <sross at common-lisp.net>
+ * backends.lisp, circularities.lisp, tests.lisp:
+ Added test gensym.2 which crashed in previous
+ versions (pre 0.5.7). Symbols are now tested
+ for equality when storing.
+ int-sym-or-char-p renamed to int-or-char-p.
+ * plumbing.lisp: Added error to the superclasses
+ of restore-error and store-error.
+
2005-03-23 Sean Ross <sross at common-lisp.net>
* backends.lisp: Fix up for type specifications
for the old-magic-numbers and stream-type slots
Index: cl-store/circularities.lisp
diff -u cl-store/circularities.lisp:1.18 cl-store/circularities.lisp:1.19
--- cl-store/circularities.lisp:1.18 Wed Mar 23 13:58:43 2005
+++ cl-store/circularities.lisp Thu Mar 24 09:25:17 2005
@@ -116,7 +116,7 @@
(deftype not-circ ()
"Type grouping integer, characters and symbols, which we
don't bother to check if they have been stored before"
- '(or integer character symbol))
+ '(or integer character))
(defun needs-checkp (obj)
"Do we need to check if this object has been stored before?"
@@ -131,9 +131,10 @@
(defun get-ref (obj)
(if (needs-checkp obj)
- (aif (seen obj)
- it
- (update-seen obj))
+ (multiple-value-bind (val win) (seen obj)
+ (if (or val win)
+ val
+ (update-seen obj)))
nil))
(defmethod backend-store-object ((backend resolving-backend) (obj t) (place t))
@@ -179,7 +180,7 @@
(cond ((referrerp backend reader)
(incf *restore-counter*)
(new-val (internal-restore-object backend reader place)))
- ((not (int-sym-or-char-p backend reader))
+ ((not (int-or-char-p backend reader))
(handle-normal backend reader place))
(t (new-val (internal-restore-object backend reader place))))))
@@ -189,18 +190,25 @@
(handle-restore place backend)
(call-next-method)))
-(defgeneric int-sym-or-char-p (backend fn)
+; This used to be called int-sym-or-char-p
+; but was renamed to handle eq symbols (gensym's mainly).
+; The basic concept is that we don't bother
+; checking for circularities with integers or
+; characters since these aren't gauraunteed to be eq
+; even if they are the same object.
+; (notes for eq in CLHS).
+(defgeneric int-or-char-p (backend fn)
(:method ((backend backend) (fn symbol))
- "Is function FN registered to restore an integer, character or symbol
- in BACKEND."
- (member fn '(integer character symbol))))
+ "Is function FN registered to restore an integer or character in BACKEND."
+ (member fn '(integer character))))
(defun new-val (val)
"Tries to get a referred value to reduce unnecessary cirularity fixing."
(if (referrer-p val)
- (aif (referred-value val *restored-values*)
- it
- val)
+ (multiple-value-bind (new-val win) (referred-value val *restored-values*)
+ (if (or new-val win)
+ new-val
+ val))
val))
;; EOF
Index: cl-store/cl-store.asd
diff -u cl-store/cl-store.asd:1.26 cl-store/cl-store.asd:1.27
--- cl-store/cl-store.asd:1.26 Wed Mar 23 13:58:43 2005
+++ cl-store/cl-store.asd Thu Mar 24 09:25:17 2005
@@ -40,7 +40,7 @@
:name "CL-STORE"
:author "Sean Ross <sdr at jhb.ucs.co.za>"
:maintainer "Sean Ross <sdr at jhb.ucs.co.za>"
- :version "0.5.4"
+ :version "0.5.8"
:description "Serialization package"
:long-description "Portable CL Package to serialize data types"
:licence "MIT"
Index: cl-store/default-backend.lisp
diff -u cl-store/default-backend.lisp:1.25 cl-store/default-backend.lisp:1.26
--- cl-store/default-backend.lisp:1.25 Wed Mar 23 13:58:43 2005
+++ cl-store/default-backend.lisp Thu Mar 24 09:25:17 2005
@@ -103,8 +103,8 @@
;; so we we have a little optimization for it
;; We need this for circularity stuff.
-(defmethod int-sym-or-char-p ((backend cl-store) (type symbol))
- (find type '(integer character 32-bit-integer symbol)))
+(defmethod int-or-char-p ((backend cl-store) (type symbol))
+ (find type '(integer character 32-bit-integer)))
(defstore-cl-store (obj integer stream)
(if (typep obj 'sb32)
@@ -545,8 +545,8 @@
(store-object (mapcar (if *store-used-packages* #'identity #'package-name)
(package-use-list obj))
stream)
- (store-object (package-shadowing-symbols obj) stream)
(store-object (internal-symbols obj) stream)
+ (store-object (package-shadowing-symbols obj) stream)
(store-object (external-symbols obj) stream))
(defun remove-remaining (times stream)
@@ -578,14 +578,14 @@
acc))
(defun restore-package (package-name stream &key force)
- (when force
+ (when (and force (find-package package-name))
(delete-package package-name))
(let ((package (make-package package-name
:nicknames (restore-object stream)
:use (restore-object stream))))
- (shadow (restore-object stream) package)
(loop for symbol across (restore-object stream) do
(import symbol package))
+ (shadow (restore-object stream) package)
(loop for symbol across (restore-object stream) do
(export symbol package))
package))
Index: cl-store/package.lisp
diff -u cl-store/package.lisp:1.20 cl-store/package.lisp:1.21
--- cl-store/package.lisp:1.20 Fri Feb 18 09:15:49 2005
+++ cl-store/package.lisp Thu Mar 24 09:25:17 2005
@@ -13,7 +13,7 @@
#:restore #:backend-store #:store-backend-code #:store-object
#:backend-store-object #:get-class-details #:get-array-values
#:restore #:backend-restore #:cl-store #:referrerp
- #:check-magic-number #:get-next-reader #:int-sym-or-char-p
+ #:check-magic-number #:get-next-reader #:int-or-char-p
#:restore-object #:backend-restore-object #:serializable-slots
#:defstore-cl-store #:defrestore-cl-store #:register-code
#:output-type-code #:store-referrer #:resolving-object
Index: cl-store/plumbing.lisp
diff -u cl-store/plumbing.lisp:1.13 cl-store/plumbing.lisp:1.14
--- cl-store/plumbing.lisp:1.13 Wed Mar 23 13:58:43 2005
+++ cl-store/plumbing.lisp Thu Mar 24 09:25:17 2005
@@ -45,11 +45,11 @@
(:report cl-store-report)
(:documentation "Root cl-store condition"))
-(define-condition store-error (cl-store-error)
+(define-condition store-error (error cl-store-error)
()
(:documentation "Error thrown when storing an object fails."))
-(define-condition restore-error (cl-store-error)
+(define-condition restore-error (error cl-store-error)
()
(:documentation "Error thrown when restoring an object fails."))
Index: cl-store/tests.lisp
diff -u cl-store/tests.lisp:1.18 cl-store/tests.lisp:1.19
--- cl-store/tests.lisp:1.18 Wed Mar 23 13:58:43 2005
+++ cl-store/tests.lisp Thu Mar 24 09:25:17 2005
@@ -166,6 +166,13 @@
(mismatch "Foobar" (symbol-name new)))))
(nil 6))
+; This failed in cl-store < 0.5.5
+(deftest gensym.2 (let ((x (gensym)))
+ (store (list x x) *test-file*)
+ (let ((new (restore *test-file*)))
+ (eq (car new) (cadr new))))
+ t)
+
;; cons
@@ -205,16 +212,17 @@
(:export bar))
(defun package-restores ()
- (store (find-package :foo) *test-file*)
- (delete-package :foo)
- (restore *test-file*)
- (list (package-name (find-package :foo))
- (mapcar #'package-name (package-use-list :foo))
- (package-nicknames :foo)
- (equalp (remove-duplicates (package-shadowing-symbols :foo))
- (list (find-symbol "FORMAT" "FOO")))
- (equalp (cl-store::external-symbols (find-package :foo))
- (make-array 1 :initial-element (find-symbol "BAR" "FOO")))))
+ (let (( *nuke-existing-packages* t))
+ (store (find-package :foo) *test-file*)
+ (delete-package :foo)
+ (restore *test-file*)
+ (list (package-name (find-package :foo))
+ (mapcar #'package-name (package-use-list :foo))
+ (package-nicknames :foo)
+ (equalp (remove-duplicates (package-shadowing-symbols :foo))
+ (list (find-symbol "FORMAT" "FOO")))
+ (equalp (cl-store::external-symbols (find-package :foo))
+ (make-array 1 :initial-element (find-symbol "BAR" "FOO"))))))
; unfortunately it's difficult to portably test the internal symbols
; in a package so we just assume that it's OK.
More information about the Cl-store-cvs
mailing list