elephant-cvs

elephant-cvs@common-lisp.net

858 discussions

[elephant-cvs] CVS elephant/src/contrib/rread/dcm
by rread 27 Apr '06

27 Apr '06

Update of /project/elephant/cvsroot/elephant/src/contrib/rread/dcm In directory clnet:/tmp/cvs-serv16667 Modified Files: dcm.asd Log Message: Fixing the license line in the asd --- /project/elephant/cvsroot/elephant/src/contrib/rread/dcm/dcm.asd 2006/04/27 02:00:02 1.1 +++ /project/elephant/cvsroot/elephant/src/contrib/rread/dcm/dcm.asd 2006/04/27 15:27:36 1.2 @@ -20,7 +20,7 @@ :author "Robert L. Read <read(a)robertlread.net>" :version "0.1" :maintainer "Robert L. Read <read(a)robertlread.net" - :licence "All Rights Reserverd" + :licence "LLGPL; part of Elephant" :description "A simple object prevalence system with strategies" :long-description "An object prevalence system with strategies built on Elephant" :depends-on (:elephant)

1 0

[elephant-cvs] CVS elephant/src/contrib/rread/dcm
by rread 27 Apr '06

27 Apr '06

Update of /project/elephant/cvsroot/elephant/src/contrib/rread/dcm In directory clnet:/tmp/cvs-serv9657/rread/dcm Added Files: dcm-macros.lisp dcm-package.lisp dcm-tests.lisp dcm.asd dcm.lisp gdcm.lisp Log Message: Adding "Data Collection Management". --- /project/elephant/cvsroot/elephant/src/contrib/rread/dcm/dcm-macros.lisp 2006/04/27 02:00:02 NONE +++ /project/elephant/cvsroot/elephant/src/contrib/rread/dcm/dcm-macros.lisp 2006/04/27 02:00:02 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; dcm-macros ;;; ;;; Initial version by Robert L. Read ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; ;;; Elephant users are granted the rights to distribute and use this software ;;; as governed by the terms of the Lisp Lesser GNU Public License ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;; ;;; Copyright (c) 2005 Robert L. Read <read at robertlread.net> (in-package "DCM") (defmacro init-director (cls dirclass &rest x) `(let ((dir (make-instance ,cls ,@x))) (initialize dir ,cls ,dirclass) (setf (gethash ,cls *director-class-map*) dir) (load-all dir) dir)) (defmacro init-director-noload (cls dirclass &rest x) `(let ((dir (make-instance ,cls ,@x))) (initialize dir ,cls ,dirclass) (setf (gethash ,cls *director-class-map*) dir) ;; (load-all dir) dir)) --- /project/elephant/cvsroot/elephant/src/contrib/rread/dcm/dcm-package.lisp 2006/04/27 02:00:02 NONE +++ /project/elephant/cvsroot/elephant/src/contrib/rread/dcm/dcm-package.lisp 2006/04/27 02:00:02 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; dcm-package.lisp ;;; ;;; Initial version by Robert L. Read ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; ;;; Elephant users are granted the rights to distribute and use this software ;;; as governed by the terms of the Lisp Lesser GNU Public License ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;; ;;; Copyright (c) 2005 Robert L. Read <read at robertlread.net> (defpackage dcm (:documentation "DCM is a very simple in-memory object prevalence system.") (:nicknames dcm :dcm) ;; (:use common-lisp elephant ele-clsql) (:use common-lisp elephant) (:export ;; These parameters are used to tell DCM how to connect ;; to repositories #:*SLEEPYCAT-HOME* #:*POSTGRES-SPEC* #:*DCM-DEFAULT* #:*ELEPHANT-CAT* #:*DEF-STORE-NAME* #:key #:key-equal #:dcm-equal #:max-key-value #:max-key #:managed-object #:mid #:k #:owner #:ownr #:tstamp #:dcm-tstmp #:mo-equal #:get-values #:randomize-slot-value #:get-user-defined-slots #:randomize-managed-object #:ExObject #:managed-handle #:test-randomize-managed-object #:max-key-value #:*DIR-CAT* #:director #:load-all #:delete-all-objects-from-director #:*HASH-CAT* #:hash-director #:get-all-objects #:get-all-objects-type #:get-all-objects-owned-by #:get-unused-key-value #:hash-values-reduce #:hash-keys-reduce #:register-obj #:lookup-obj #:delete-obj #:hash-dir-test #:*ELEPHANT-CAT* #:*basic-store-controller* #:init-elephant-controllers #:release-elephant-controllers #:elephant-director #:initialize-btree #:initialize #:register-many-random #:elephant-dir-test #:hash-ele-director #:hash-ele-dir-test #:*DIR-STRATEGIES* #:directory-factory #:init-director #:dir-test #:test-get-unused-key-value #:unused-key #:tm-register-then-lookup #:tm-get-all-objects #:tm-test-elephant #:run-all-dcm-tests #:test-ex-director #:get-director-by-class #:get-all-cur-objects #:get-all-objects-gen #:retire #:find-generation #:GenDir ) ) --- /project/elephant/cvsroot/elephant/src/contrib/rread/dcm/dcm-tests.lisp 2006/04/27 02:00:02 NONE +++ /project/elephant/cvsroot/elephant/src/contrib/rread/dcm/dcm-tests.lisp 2006/04/27 02:00:02 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; dcm-tests.lisp ;;; ;;; Initial version by Robert L. Read ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; ;;; Elephant users are granted the rights to distribute and use this software ;;; as governed by the terms of the Lisp Lesser GNU Public License ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;; ;;; Copyright (c) 2005 Robert L. Read <read at robertlread.net> (in-package "DCM") (defclass ExObjectDirector (hash-ele-director) ((mtype :initform 'ExObject :accessor :mtype))) (defun test-ex-director () (let ((k1 nil) (k2 nil)) (let* ((o1 (make-instance 'ExObject)) (ed (init-director 'ExObjectDirector 'ExObjectDirector)) (o2 (make-instance 'ExObject))) (setf (slot-value o1 'username) "spud") (setf (slot-value o2 'username) "mud") (setf k1 (k (mid (register-obj ed o1)))) (setf k2 (k (mid (register-obj ed o2)))) ) (let* ( (ed (init-director 'ExObjectDirector 'ExObjectDirector))) (format t "K1 ~A~%" (slot-value (lookup-obj ed (make-instance 'key :id k1)) 'username)) (format t "K2 ~A~%" (slot-value (lookup-obj ed (make-instance 'key :id k2)) 'username)) (and (equal (slot-value (lookup-obj ed (make-instance 'key :id k1)) 'username) "spud") (equal (slot-value (lookup-obj ed (make-instance 'key :id k2)) 'username) "mud") )))) ;; Create 10 objects, retire them, and make sure that they can ;; still be found. (defclass TestGenDir (GenDir) ((mtype :initform 'ExObject)) ) (defun test-retirement () (let ((g (init-director 'TestGenDir 'TestGenDir)) (r (randomize-managed-object (make-instance 'ExObject)))) (setf (slot-value r 'number) 0) (setf (slot-value r 'username) "username") (setf (slot-value r 'password) "password") (register-obj g r) (assert (= 0 (find-generation g (mid r)))) (retire g (mid r)) (assert (= 1 (find-generation g (mid r)))) ) ) (defun test-deletion-from-gen () (let ((g (init-director 'TestGenDir 'TestGenDir)) (r (randomize-managed-object (make-instance 'ExObject)))) (setf (slot-value r 'number) 0) (setf (slot-value r 'username) "username") (setf (slot-value r 'password) "password") (register-obj g r) (retire g (mid r)) (let ((id (mid r))) (assert (= 1 (find-generation g (mid r)))) (delete-all-objects-from-director g 'ExObject) (lookup-obj-aux g id) (let ((gp (init-director 'TestGenDir 'TestGenDir))) (assert (null (get-all-objects gp))) ) ) )) (defun test-naming-uniqueness () (let ((g (init-director 'TestGenDir 'TestGenDir)) (r (randomize-managed-object (make-instance 'ExObject))) (s 0)) (setf (slot-value r 'number) 0) (setf (slot-value r 'username) "username") (setf (slot-value r 'password) "password") (register-obj g r) (do ((i 0 (1+ i)) (dirs (subdirs g) (rest dirs))) ((null dirs)) (setf s (+ s (length (get-all-objects (car dirs)))))) (assert (= s 1)))) ;; This command should test everything so far.... (defun run-all-dcm-tests () (let ((dt (make-instance 'dir-test))) (unused-key dt) (tm-register-then-lookup dt) (tm-get-all-objects dt) (tm-test-elephant dt) )) --- /project/elephant/cvsroot/elephant/src/contrib/rread/dcm/dcm.asd 2006/04/27 02:00:02 NONE +++ /project/elephant/cvsroot/elephant/src/contrib/rread/dcm/dcm.asd 2006/04/27 02:00:02 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; dcm.asd -- ASDF system definition for DCM ;;; ;;; Initial version by Robert L. Read ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; ;;; Elephant users are granted the rights to distribute and use this software ;;; as governed by the terms of the Lisp Lesser GNU Public License ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;; ;;; Copyright (c) 2005 Robert L. Read <read at robertlread.net> (defsystem dcm :name "dcm" :author "Robert L. Read <read(a)robertlread.net>" :version "0.1" :maintainer "Robert L. Read <read(a)robertlread.net" :licence "All Rights Reserverd" :description "A simple object prevalence system with strategies" :long-description "An object prevalence system with strategies built on Elephant" :depends-on (:elephant) :components ((:file "dcm-package") (:file "dcm-macros") (:file "dcm" :depends-on ("dcm-package" "dcm-macros")) (:file "gdcm" :depends-on ("dcm" "dcm-macros")) (:file "dcm-tests" :depends-on ("dcm" "gdcm" "dcm-macros")) ) :serial t ) --- /project/elephant/cvsroot/elephant/src/contrib/rread/dcm/dcm.lisp 2006/04/27 02:00:02 NONE +++ /project/elephant/cvsroot/elephant/src/contrib/rread/dcm/dcm.lisp 2006/04/27 02:00:02 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; dcm-tests.lisp ;;; ;;; Initial version by Robert L. Read ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; ;;; Elephant users are granted the rights to distribute and use this software ;;; as governed by the terms of the Lisp Lesser GNU Public License ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;; ;;; Copyright (c) 2005 Robert L. Read <read at robertlread.net> (in-package "DCM") (defparameter *SLEEPYCAT-HOME* "/home/read/testdb") (defparameter *POSTGRES-SPEC* '(:clsql (:postgresql "localhost.localdomain" "test" "postgres" ""))) (defparameter *DCM-DEFAULT* *POSTGRES-SPEC*) (defparameter *ELEPHANT-CAT* "elephant director") (defparameter *DEF-STORE-NAME* "DefaultStoreX") (asdf:operate 'asdf:load-op :elephant) (use-package "ELEPHANT") ;; (asdf:operate 'asdf:load-op :ele-bdb) (asdf:operate 'asdf:load-op :ele-clsql) (defclass key () ((id :type 'integer :initform -1 :initarg :id :accessor k))) (defmethod max-key-value ((a key) (b key)) (max (k a) (k b))) (defmethod max-key ((a key) (b key)) (if (< (k a) (k b)) b a)) ;; I think perhas we could use a better type specifier for this ;; than integer. (defclass managed-object () ((mid :type 'key :initform nil :initarg :mid :accessor mid) (owner :type 'key ;; This is basically saying that the key 0 had better specify a legitimate ;; owner --- but that is the responsibility of the clients of this package. :initform (make-instance 'key :id 0) :initarg :owner :accessor :ownr) (tstamp :type 'number ;; This is basically saying that the key 0 had better specify a legitimate ;; owner --- but that is the responsibility of the clients of this package. :initform (get-universal-time) :initarg :tstamp :accessor :dcm-tstmp) ) ) (defmethod mo-equal ((a managed-object) (b managed-object)) (equal (get-values a) (get-values b))) (defmethod key-equal ((a key) (b key)) (= (k a) (k b))) (defmethod dcm-equal (a b) (let ((ka (if (typep a 'managed-object) (k (mid a)) (if (typep a 'key) (k a) a))) (kb (if (typep b 'managed-object) (k (mid b)) (if (typep b 'key) (k b) b)))) (and ka kb (= ka kb)) ) ) (defmethod get-values ((a managed-object)) (mapcar #'(lambda (x) (let* ((name (sb-pcl:slot-definition-name x)) (value (if (slot-boundp a name) (slot-value a name) nil))) (cons name value))) (sb-mop:class-slots (class-of a)))) ;; This will make red tests for now... (defun randomize-slot-value (s mo) (let ((ltype (sb-pcl:slot-definition-type s)) (name (sb-pcl:slot-definition-name s))) (let ((crazy (cadr ltype))) (let ((v (cond [548 lines skipped] --- /project/elephant/cvsroot/elephant/src/contrib/rread/dcm/gdcm.lisp 2006/04/27 02:00:02 NONE +++ /project/elephant/cvsroot/elephant/src/contrib/rread/dcm/gdcm.lisp 2006/04/27 02:00:02 1.1 [751 lines skipped]

1 0

[elephant-cvs] CVS elephant/src/contrib/rread/dcm
by rread 27 Apr '06

27 Apr '06

Update of /project/elephant/cvsroot/elephant/src/contrib/rread/dcm In directory clnet:/tmp/cvs-serv9618/rread/dcm Log Message: Directory /project/elephant/cvsroot/elephant/src/contrib/rread/dcm added to the repository

1 0

[elephant-cvs] CVS elephant/src/contrib/rread
by rread 27 Apr '06

27 Apr '06

Update of /project/elephant/cvsroot/elephant/src/contrib/rread In directory clnet:/tmp/cvs-serv9572/rread Log Message: Directory /project/elephant/cvsroot/elephant/src/contrib/rread added to the repository

1 0

[elephant-cvs] CVS elephant/src/db-clsql
by rread 27 Apr '06

27 Apr '06

Update of /project/elephant/cvsroot/elephant/src/db-clsql In directory clnet:/tmp/cvs-serv6814/src/db-clsql Modified Files: sql-controller.lisp Log Message: Just a bagatelle --- /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2006/03/27 20:36:27 1.10 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2006/04/27 01:34:49 1.11 @@ -325,6 +325,10 @@ ) ) +(defmethod reconnect-controller ((sc sql-store-controller)) + (setf (controller-db sc) + (clsql:reconnect :database (controller-db sc))) +) (defmethod close-controller ((sc sql-store-controller)) (when (slot-value sc 'db) ;; close the connection

1 0

[elephant-cvs] CVS elephant/tests
by ieslick 26 Apr '06

26 Apr '06

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv9359/tests Modified Files: testindexing.lisp Log Message: Corrections for SBCL serialization and index testing. --- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/04/26 17:53:45 1.16 +++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/04/26 21:41:25 1.17 @@ -371,22 +371,23 @@ (defvar normal-index nil) -(defclass stress-normal () - ((stress1 :accessor stress1 :initarg :stress1 :initform nil :index nil) - (stress2 :accessor stress2 :initarg :stress2 :initform nil :index nil)) - (:metaclass persistent-metaclass)) +(defun make-stress-classes () + (defclass stress-normal () + ((stress1 :accessor stress1 :initarg :stress1 :initform nil :index nil) + (stress2 :accessor stress2 :initarg :stress2 :initform nil :index nil)) + (:metaclass persistent-metaclass)) + + (defclass stress-index () + ((stress1 :accessor stress1 :initarg :stress1 :initform nil :index t) + (stress2 :accessor stress2 :initarg :stress2 :initform 2 :index t) + (stress3 :accessor stress3 :initarg :stress3 :initform 3 :index nil)) + (:metaclass persistent-metaclass))) (defun normal-stress-setup (count class-name &rest inst-args) (setf normal-index (make-btree)) (dotimes (i count) (setf (get-value i normal-index) (apply #'make-instance class-name :stress1 i inst-args)))) -(defclass stress-index () - ((stress1 :accessor stress1 :initarg :stress1 :initform nil :index t) - (stress2 :accessor stress2 :initarg :stress2 :initform 2 :index t) - (stress3 :accessor stress3 :initarg :stress3 :initform 3 :index nil)) - (:metaclass persistent-metaclass)) - (defun indexed-stress-setup (count class-name &rest inst-args) (dotimes (i count) (apply #'make-instance class-name :stress1 i inst-args))) @@ -421,43 +422,42 @@ (deftest indexing-timing (progn + (make-stress-classes) (let ((insts (get-instances-by-class 'stress-index)) (start nil) (end nil) (normal-time 0) (index-time 0)) (when insts - (drop-instances insts))) + (drop-instances insts :sc *store-controller*)) ;; (format t "~%Stress test normal setup time (~A):~%" *stress-count*) - (with-transaction () - (normal-stress-setup *stress-count* 'stress-normal :stress2 10) - ) + (with-transaction () + (normal-stress-setup *stress-count* 'stress-normal :stress2 10)) ;; (format t "~%Stress test indexed setup time (~A):~%" *stress-count*) - (with-transaction () - (indexed-stress-setup *stress-count* 'stress-index :stress2 10) - ) + (with-transaction () + (indexed-stress-setup *stress-count* 'stress-index :stress2 10)) ;; (format t "~%Stress test normal lookup time (~A):~%" *range-size*) - (setf start (get-internal-run-time)) - (dotimes (i *range-size*) - (declare (ignore i)) - (normal-range-lookup *stress-count* *range-size*)) - (setf end (get-internal-run-time)) - (setf normal-time (/ (- end start 0.0) internal-time-units-per-second)) + (setf start (get-internal-run-time)) + (dotimes (i *range-size*) + (declare (ignore i)) + (normal-range-lookup *stress-count* *range-size*)) + (setf end (get-internal-run-time)) + (setf normal-time (/ (- end start 0.0) internal-time-units-per-second)) ;; (format t "~%Stress test indexed lookup time (~A):~%" *range-size*) - (setf start (get-internal-run-time)) - (dotimes (i *range-size*) - (declare (ignore i)) - (indexed-range-lookup 'stress-index *stress-count* *range-size*)) - (setf end (get-internal-run-time)) - (setf index-time (/ (- end start 0.0) internal-time-units-per-second)) - - (format t "~%Ranged get of ~A/~A objects = Linear: ~A sec Indexed: ~A sec~%" - *range-size* *stress-count* normal-time index-time) - (> normal-time index-time)) + (setf start (get-internal-run-time)) + (dotimes (i *range-size*) + (declare (ignore i)) + (indexed-range-lookup 'stress-index *stress-count* *range-size*)) + (setf end (get-internal-run-time)) + (setf index-time (/ (- end start 0.0) internal-time-units-per-second)) + + (format t "~%Ranged get of ~A/~A objects = Linear: ~A sec Indexed: ~A sec~%" + *range-size* *stress-count* normal-time index-time) + (> normal-time index-time))) t)

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 26 Apr '06

26 Apr '06

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv9359/src/elephant Modified Files: classindex.lisp serializer.lisp Log Message: Corrections for SBCL serialization and index testing. --- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2006/04/26 19:19:12 1.10 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2006/04/26 21:41:24 1.11 @@ -423,14 +423,28 @@ (next-in-range skey (cons val nil)) nil))))) + +(defmacro do-subsets ((subset subset-size list) &body body) + (let ((place (gensym)) + (i (gensym))) + `(let ((,place ,list) + (,subset nil)) + (loop while ,place do + (setf ,subset nil) + (loop for ,i from 1 upto ,subset-size do + (if (null ,place) (return) + (push (pop ,place) ,subset))) + ,@body)))) + (defun drop-instances (instances &key (sc *store-controller*)) (when instances - (assert (and (consp instances) (< (length instances) 500))) - (with-transaction (:store-controller sc) - (mapc (lambda (instance) - (remove-kv (oid instance) (find-class-index (class-of instance))) - (drop-pobject instance)) - instances)))) - + (assert (consp instances)) + (do-subsets (subset 500 instances) + (with-transaction (:store-controller sc) + (mapc (lambda (instance) + (remove-kv (oid instance) (find-class-index (class-of instance))) + (drop-pobject instance)) + subset))))) + --- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/04/26 17:53:44 1.3 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2006/04/26 21:41:24 1.4 @@ -84,8 +84,7 @@ (string +ucs2-symbol+)) #+(or (and sbcl sb-unicode) lispworks) (etypecase s - (base-string #+sbcl +ucs4-symbol+ #+lispworks +ucs2-symbol+ ) - ;; +ucs1-symbol+) + (base-string +ucs1-symbol+) (string #+sbcl +ucs4-symbol+ #+lispworks +ucs2-symbol+)) #-(or lispworks (and allegro ics) (and sbcl sb-unicode)) +ucs1-symbol+ @@ -105,8 +104,7 @@ (string +ucs2-string+)) #+(or (and sbcl sb-unicode) lispworks) (etypecase frob - (base-string #+sbcl +ucs4-string+ #+lispworks +ucs2-string+ ) - ;; +ucs1-string+ + (base-string +ucs1-string+) (string #+sbcl +ucs4-string+ #+lispworks +ucs2-string+)) #-(or lispworks (and allegro ics) (and sbcl sb-unicode)) +ucs1-string+ @@ -148,8 +146,7 @@ (string +ucs2-pathname+)) #+(or (and sbcl sb-unicode) lispworks) (etypecase s - (base-string #+sbcl +ucs4-pathname+ #+lispwoks +ucs2-pathname+ ) - ;; +ucs1-pathname+ + (base-string +ucs1-pathname+) (string #+sbcl +ucs4-pathname+ #+lispwoks +ucs2-pathname+)) #-(or lispworks (and allegro ics) (and sbcl sb-unicode)) +ucs1-pathname+ @@ -482,8 +479,8 @@ (eval-when (:compile-toplevel :load-toplevel) - (asdf:operate 'asdf:load-op :cl-base64) -) + (asdf:operate 'asdf:load-op :cl-base64)) + (defun ser-deser-equal (x1 &key sc) (let* ( (x1s (serialize-to-base64-string x1))

1 0

[elephant-cvs] CVS elephant/src/memutil
by ieslick 26 Apr '06

26 Apr '06

Update of /project/elephant/cvsroot/elephant/src/memutil In directory clnet:/tmp/cvs-serv9359/src/memutil Modified Files: memutil.lisp Log Message: Corrections for SBCL serialization and index testing. --- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2006/04/26 17:53:45 1.5 +++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2006/04/26 21:41:24 1.6 @@ -56,10 +56,6 @@ #:*c-library-extension* )) -;; --REMOVE HACK-- -(defpackage elephant - (:use :cl)) - (in-package "ELEPHANT-MEMUTIL") #+cmu @@ -332,8 +328,7 @@ (string (excl:native-string-sizeof ,s :external-format :unicode))) #+(or (and sbcl sb-unicode) lispworks) `(etypecase ,s - (base-string (* (length ,s) #+sbcl 4 #+lispworks 2) ) - ;; (length ,s))) + (base-string (length ,s)) (string (* (length ,s) #+sbcl 4 #+lispworks 2))) #-(or lispworks (and allegro ics) (and sbcl sb-unicode)) `(length ,s)) @@ -592,6 +587,7 @@ (incf (buffer-stream-position bs)) (deref-array (buffer-stream-buffer bs) '(:array :unsigned-byte) position))) + (defun buffer-read-byte-vector (bs) "Read the whole buffer into byte vector." (declare (optimize (speed 3) (safety 0))

1 0

[elephant-cvs] CVS elephant/tests
by ieslick 26 Apr '06

26 Apr '06

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv22948/tests Modified Files: testmigration.lisp Log Message: Fix for a problem during migration of persistent classes from one store to another. 0.6.0 is clean for BDB/Allegro on Mac OS X --- /project/elephant/cvsroot/elephant/tests/testmigration.lisp 2006/04/26 17:53:45 1.12 +++ /project/elephant/cvsroot/elephant/tests/testmigration.lisp 2006/04/26 19:19:12 1.13 @@ -171,12 +171,14 @@ (unwind-protect ;; ensure class index is initialized in sc1 (progn + (with-transaction (:store-controller sc2) + (remove-kv 'ipfoo (elephant::controller-class-root sc2))) (setf (elephant::%index-cache (find-class 'ipfoo)) nil) (find-class-index 'ipfoo :sc sc1) (format t "Making objects~%") - (with-transaction (:store-controller sc2) - (drop-instances (get-instances-by-class 'ipfoo) :sc sc2)) - (with-transaction (:store-controller sc1) +;; (with-transaction (:store-controller sc2) +;; (drop-instances (get-instances-by-class 'ipfoo) :sc sc2)) + (with-transaction (:store-controller sc1 :retries 2) (drop-instances (get-instances-by-class 'ipfoo) :sc sc1) (make-instance 'ipfoo :slot1 1 :sc sc1) (make-instance 'ipfoo :slot1 10 :sc sc1)

1 0

[elephant-cvs] CVS elephant/src/db-bdb
by ieslick 26 Apr '06

26 Apr '06

Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv22948/src/db-bdb Modified Files: bdb-collections.lisp bdb-transactions.lisp Log Message: Fix for a problem during migration of persistent classes from one store to another. 0.6.0 is clean for BDB/Allegro on Mac OS X --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2006/04/26 17:53:44 1.6 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2006/04/26 19:19:12 1.7 @@ -159,7 +159,7 @@ (serialize key key-buf) (serialize value value-buf) (with-transaction (:store-controller sc) - (db-put-buffered (controller-btrees sc) + (db-put-buffered (controller-btrees sc) key-buf value-buf) (loop for index being the hash-value of indices do --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-transactions.lisp 2006/02/20 21:21:41 1.2 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-transactions.lisp 2006/04/26 19:19:12 1.3 @@ -44,8 +44,8 @@ (let ((result (let ((*current-transaction* txn) (*auto-commit* nil)) - (declare (special *current-transaction* *auto-commit*) - (dynamic-extent *current-transaction* *auto-commit*)) + (declare (special *current-transaction* *auto-commit*)) +;; (dynamic-extent *current-transaction* *auto-commit*)) (catch 'transaction (unwind-protect (prog1

1 0

← Newer
1
...
45
46
47
48
49
50
51
...
86
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

elephant-cvs