[cl-store-cvs] CVS update: cl-store/README cl-store/ChangeLog cl-store/circularities.lisp cl-store/cl-store.asd cl-store/fast-io.lisp cl-store/package.lisp cl-store/store.lisp cl-store/tests.lisp cl-store/fix-clisp.lisp
Sean Ross
sross at common-lisp.net
Tue May 18 14:56:29 UTC 2004
Update of /project/cl-store/cvsroot/cl-store
In directory common-lisp.net:/tmp/cvs-serv6337
Modified Files:
ChangeLog circularities.lisp cl-store.asd fast-io.lisp
package.lisp store.lisp tests.lisp
Added Files:
README
Removed Files:
fix-clisp.lisp
Log Message:
Changelog 2004-05-18
Date: Tue May 18 10:56:27 2004
Author: sross
Index: cl-store/ChangeLog
diff -u cl-store/ChangeLog:1.1.1.1 cl-store/ChangeLog:1.2
--- cl-store/ChangeLog:1.1.1.1 Mon May 17 11:41:19 2004
+++ cl-store/ChangeLog Tue May 18 10:56:27 2004
@@ -1,3 +1,8 @@
+2004-05-18 Sean Ross <sdr at jhb.ucs.co.za>
+ * store.lisp, fix-clisp.lisp, sbcl/sockets.lisp:
+ Added fix for sbcl to use non-blocking IO when working with sockets.
+ Created directory structure and moved fix-clisp
+
2004-05-17 Sean Ross <sdr at jhb.ucs.co.za>
* store.lisp, fast-io.lisp, circularities.lisp, package.lisp,
fix-clisp.lisp, utils.lisp, cl-store.asd, tests.lisp:
Index: cl-store/circularities.lisp
diff -u cl-store/circularities.lisp:1.1.1.1 cl-store/circularities.lisp:1.2
--- cl-store/circularities.lisp:1.1.1.1 Mon May 17 11:41:26 2004
+++ cl-store/circularities.lisp Tue May 18 10:56:27 2004
@@ -116,13 +116,6 @@
((arrayp sequence)
(inner-array)))))
-
-
-
-
-
-
-
;; storing already seen objects
Index: cl-store/cl-store.asd
diff -u cl-store/cl-store.asd:1.1.1.1 cl-store/cl-store.asd:1.2
--- cl-store/cl-store.asd:1.1.1.1 Mon May 17 11:41:19 2004
+++ cl-store/cl-store.asd Tue May 18 10:56:27 2004
@@ -7,20 +7,45 @@
(in-package :cl-store.system)
+(defclass non-required-file (cl-source-file) ()
+ (:documentation
+ "File containing implementation dependent code which may or may not be there."))
+
+(defun lisp-system-shortname ()
+ #+lispworks :lispworks #+cmu :cmucl #+clisp :clisp #+sbcl :sbcl)
+
+(defmethod component-pathname ((component non-required-file))
+ (let ((pathname (call-next-method))
+ (name (string-downcase (lisp-system-shortname))))
+ (merge-pathnames
+ (make-pathname :directory (list :relative name))
+ pathname)))
+
+(defmethod perform ((op compile-op) (component non-required-file))
+ (when (probe-file (component-pathname component))
+ (call-next-method)))
+
+(defmethod perform ((op load-op) (component non-required-file))
+ (when (probe-file (component-pathname component))
+ (call-next-method)))
+
+
(defsystem cl-store
:name "Store"
:author "Sean Ross <sdr at jhb.ucs.co.za>"
:maintainer "Sean Ross <sdr at jhb.ucs.co.za>"
- :version "0.1"
+ :version "0.1.1"
:description "Serialization package"
:long-description "Portable CL Package to serialize data types"
:licence "MIT"
:components ((:file "package")
- #+clisp(:file "fix-clisp" :depends-on "package")
+ (:non-required-file "fix-clisp" :depends-on ("package"))
(:file "fast-io" :depends-on ("package"))
(:file "utils" :depends-on ("fast-io"))
(:file "circularities" :depends-on ("utils"))
- (:file "store" :depends-on ("circularities"))))
+ (:file "store" :depends-on ("circularities"))
+ (:non-required-file "sockets" :depends-on ("store")))
+ :depends-on (#+sbcl :sb-bsd-sockets))
(defmethod perform :after ((o load-op) (c (eql (find-system :cl-store))))
@@ -32,14 +57,12 @@
(oos 'test-op :cl-store-tests))
(defsystem cl-store-tests
- #+sbcl :depends-on #+sbcl (sb-rt)
+ :depends-on (rt)
:components ((:file "tests")))
(defmethod perform ((op test-op) (sys (eql (find-system :cl-store-tests))))
(or (funcall (find-symbol "RUN-TESTS" "CL-STORE-TESTS"))
(error "Test-op Failed.")))
-
-
;; EOF
Index: cl-store/fast-io.lisp
diff -u cl-store/fast-io.lisp:1.1.1.1 cl-store/fast-io.lisp:1.2
--- cl-store/fast-io.lisp:1.1.1.1 Mon May 17 11:41:19 2004
+++ cl-store/fast-io.lisp Tue May 18 10:56:27 2004
@@ -1,3 +1,6 @@
+;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;; See the file LICENCE for licence information.
+
(in-package :cl-store)
(declaim (optimize speed (safety 0) (space 0) (debug 0) (compilation-speed 0)))
(eval-when (:compile-toplevel :load-toplevel :execute)
@@ -8,11 +11,13 @@
(defvar *full-write* t
"An evil, evil variable. Read sequence doesn't just block it also
-waits until the buffer has been filled. This forces the full
+waits until the buffer has been filled. This variable forces the full
4096 bytes stored in the buffer to be written. Set this
to nil if you don't like file sizes being multiples of 4096
when writing to files. This should be removed, or at least
-deprecated, when a better solution is found.")
+deprecated, when a better solution is found.
+If you are using SBCL do not worry about this.
+Just store objects to and from sockets.")
;; A structure was chosen over a normal object
@@ -36,10 +41,6 @@
;; reading
-;; how should EOF be handled??
-
-
-;;(declaim (ftype (function (buffer) (unsigned-byte 8)) read-buf-byte))
(defgeneric read-buf-byte (buf))
(defmethod read-buf-byte ((buf buffer))
Index: cl-store/package.lisp
diff -u cl-store/package.lisp:1.1.1.1 cl-store/package.lisp:1.2
--- cl-store/package.lisp:1.1.1.1 Mon May 17 11:41:20 2004
+++ cl-store/package.lisp Tue May 18 10:56:27 2004
@@ -23,68 +23,68 @@
:*nuke-existing-classes*
:*store-class-superclasses*)
#+sbcl (:import-from :sb-mop
- slot-definition-name
- slot-value-using-class
- slot-boundp-using-class
- slot-definition-allocation
- compute-slots
- slot-definition-initform
- slot-definition-initargs
- slot-definition-name
- slot-definition-readers
- slot-definition-type
- slot-definition-writers
- class-direct-default-initargs
- class-direct-slots
- class-direct-superclasses
- class-slots
- ensure-class)
+ :slot-definition-name
+ :slot-value-using-class
+ :slot-boundp-using-class
+ :slot-definition-allocation
+ :compute-slots
+ :slot-definition-initform
+ :slot-definition-initargs
+ :slot-definition-name
+ :slot-definition-readers
+ :slot-definition-type
+ :slot-definition-writers
+ :class-direct-default-initargs
+ :class-direct-slots
+ :class-direct-superclasses
+ :class-slots
+ :ensure-class)
#+cmu (:import-from :pcl
- slot-definition-name
- slot-value-using-class
- slot-boundp-using-class
- slot-definition-allocation
- compute-slots
- slot-definition-initform
- slot-definition-initargs
- slot-definition-name
- slot-definition-readers
- slot-definition-type
- slot-definition-writers
- class-direct-default-initargs
- class-direct-slots
- class-direct-superclasses
- class-slots
- ensure-class)
+ :slot-definition-name
+ :slot-value-using-class
+ :slot-boundp-using-class
+ :slot-definition-allocation
+ :compute-slots
+ :slot-definition-initform
+ :slot-definition-initargs
+ :slot-definition-name
+ :slot-definition-readers
+ :slot-definition-type
+ :slot-definition-writers
+ :class-direct-default-initargs
+ :class-direct-slots
+ :class-direct-superclasses
+ :class-slots
+ :ensure-class)
#+clisp (:import-from :clos
- slot-value
- std-compute-slots
- slot-boundp
- class-name
- class-direct-default-initargs
- class-direct-slots
- class-slots
- ensure-class)
+ :slot-value
+ :std-compute-slots
+ :slot-boundp
+ :class-name
+ :class-direct-default-initargs
+ :class-direct-slots
+ :class-slots
+ :ensure-class)
#+lispworks (:import-from :clos
- slot-definition-name
- slot-value-using-class
- slot-boundp-using-class
- slot-definition-allocation
- compute-slots
- slot-definition-initform
- slot-definition-initargs
- slot-definition-name
- slot-definition-readers
- slot-definition-type
- slot-definition-writers
- class-direct-default-initargs
- class-direct-slots
- class-slots
- class-direct-superclasses
- ensure-class))
+ :slot-definition-name
+ :slot-value-using-class
+ :slot-boundp-using-class
+ :slot-definition-allocation
+ :compute-slots
+ :slot-definition-initform
+ :slot-definition-initargs
+ :slot-definition-name
+ :slot-definition-readers
+ :slot-definition-type
+ :slot-definition-writers
+ :class-direct-default-initargs
+ :class-direct-slots
+ :class-slots
+ :class-direct-superclasses
+ :ensure-class))
Index: cl-store/store.lisp
diff -u cl-store/store.lisp:1.1.1.1 cl-store/store.lisp:1.2
--- cl-store/store.lisp:1.1.1.1 Mon May 17 11:41:23 2004
+++ cl-store/store.lisp Tue May 18 10:56:27 2004
@@ -12,6 +12,10 @@
- fix up circularity stuff so that eq floats are restored correctly.
+- add support for working directly with an implementations
+ sockets and maybe support for acl-compat.
+ Done for sbcl.
+
- hopefully find a better way to do circularity fixing
- structure storing for non python implementations
@@ -88,13 +92,13 @@
(defgeneric restore (place)
(:method ((place string))
- "Restore the object found in the String PLACE."
+ "Restore the object found in the String path designator PLACE."
(restore-file place))
(:method ((place pathname))
"Restore the object found in Pathname PLACE."
(restore-file place))
(:method ((place stream))
- "Restore the object found in STREAM STREAM"
+ "Restore the object found in the Stream STREAM"
(restore (make-buffer :stream place)))
(:method ((place buffer))
"Restore the object found in Stream PLACE."
@@ -196,7 +200,8 @@
(defmacro defstore ((var type buffer &rest method-args) &body body)
"Defines method store-object specialized on TYPE.
BODY is executed with VAR and STREAM bound to the
-value to be serialized and the output stream respectively."
+value to be serialized and the output stream respectively.
+When present METHOD-ARGS are used as qualifers to the generated method."
(with-gensyms (code)
`(let ((,code (register-code ',type)))
(declare (ignorable ,code))
Index: cl-store/tests.lisp
diff -u cl-store/tests.lisp:1.1.1.1 cl-store/tests.lisp:1.2
--- cl-store/tests.lisp:1.1.1.1 Mon May 17 11:41:24 2004
+++ cl-store/tests.lisp Tue May 18 10:56:27 2004
@@ -2,7 +2,7 @@
;; See the file LICENCE for licence information.
(defpackage :cl-store-tests
- (:use :cl #+sbcl :sb-rt #-sbcl :rt :cl-store))
+ (:use :cl :rt :cl-store))
(in-package :cl-store-tests)
@@ -330,9 +330,27 @@
t)
+(defclass foobarbaz () ((x :accessor x :initarg :x)))
+
+
+(defstore (obj foobarbaz buff)
+ (store-object (x obj) buff))
+
+;(defstore (obj foobarbaz buff :before)
+; (format t "Storing a foobarbaz object."))
+
+(defrestore (foobarbaz buff)
+ (make-instance 'foobarbaz :x (restore-object buff)))
+
+
+(deftest custom.1
+ (progn (store (make-instance 'foobarbaz :x "foo") *test-file*)
+ (equal "foo" (x (restore *test-file*))))
+ t)
+
+
(defun run-tests ()
- #+sbcl(sb-rt:do-tests)
- #-sbcl(rt:do-tests)
+ (rt:do-tests)
(when (probe-file *test-file*)
(delete-file *test-file*)))
More information about the Cl-store-cvs
mailing list