elephant-cvs

elephant-cvs@common-lisp.net

858 discussions

[elephant-cvs] CVS elephant/src/db-bdb
by ieslick 19 Oct '07

19 Oct '07

Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv24934/src/db-bdb Modified Files: bdb-collections.lisp Log Message: Fixing collection comparison bugs --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2007/04/25 02:27:58 1.23 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2007/10/19 16:06:00 1.24 @@ -419,10 +419,11 @@ (multiple-value-bind (k v) (db-cursor-get-both-buffered (cursor-handle cursor) key-buf value-buf :get-both t) - (declare (ignore v)) (if k (progn (setf (cursor-initialized-p cursor) t) - (values t key value)) + (values t + (progn (buffer-read-oid k) (deserialize k sc)) + (deserialize v sc))) (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-get-both-range ((cursor bdb-cursor) key value) @@ -436,7 +437,9 @@ key-buf value-buf :get-both-range t) (if k (progn (setf (cursor-initialized-p cursor) t) - (values t key (deserialize v sc))) + (values t + (progn (buffer-read-oid k) (deserialize k sc)) + (deserialize v sc))) (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-delete ((cursor bdb-cursor)) @@ -590,9 +593,10 @@ (if k (progn (setf (cursor-initialized-p cursor) t) - (values t key (deserialize val sc) - (progn (buffer-read-oid pkey) - (deserialize pkey sc)))) + (values t + (progn (buffer-read-oid k) (deserialize k sc)) + (deserialize val sc) + (progn (buffer-read-oid pkey) (deserialize pkey sc)))) (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-pset-range ((cursor bdb-secondary-cursor) key) @@ -624,7 +628,10 @@ (declare (ignore p)) (if k (progn (setf (cursor-initialized-p cursor) t) - (values t key (deserialize val sc) pkey)) + (values t + (progn (buffer-read-oid k) (deserialize k sc)) + (deserialize val sc) + pkey)) (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-pget-both-range ((cursor bdb-secondary-cursor) key pkey) @@ -640,7 +647,9 @@ pkey-buf value-buf :get-both-range t) (if k (progn (setf (cursor-initialized-p cursor) t) - (values t key (deserialize val sc) + (values t + (progn (buffer-read-oid k) (deserialize k sc)) + (deserialize val sc) (progn (buffer-read-oid p) (deserialize p sc)))) (setf (cursor-initialized-p cursor) nil)))))) @@ -688,7 +697,8 @@ (db-cursor-move-buffered (cursor-handle cursor) key-buf value-buf :next-dup t) (if (and key (= (buffer-read-oid key) (cursor-oid cursor))) - (values t (deserialize key (get-con (cursor-btree cursor))) + (values t + (deserialize key (get-con (cursor-btree cursor))) (deserialize val (get-con (cursor-btree cursor)))) (setf (cursor-initialized-p cursor) nil))))))

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 19 Oct '07

19 Oct '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv24934/src/elephant Modified Files: collections.lisp Log Message: Fixing collection comparison bugs --- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/07/10 21:03:23 1.33 +++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/10/19 16:06:01 1.34 @@ -400,13 +400,13 @@ (typecase a (number (<= a b)) (persistent (<= (oid a) (oid b))) - (string (string<= a b)) - (symbol (string<= (symbol-name a) (symbol-name b))) - (pathname (string<= (namestring a) (namestring b))) + (string (string-not-greaterp a b)) + (symbol (string-not-greaterp (symbol-name a) (symbol-name b))) + (pathname (string-not-greaterp (namestring a) (namestring b))) (t nil))))) (defun lisp-compare-equal (a b) - (equal a b)) + (equalp a b)) (defgeneric map-btree (fn btree &rest args &key start end value from-end collect &allow-other-keys) (:documentation "Map btree maps over a btree from the value start to the value of end. @@ -507,7 +507,7 @@ (if from-end (cursor-current cur) (cursor-pnext-nodup cur))) - (map-values () + (map-values () ;; Handle the next key value (multiple-value-bind (exists? skey val pkey) (value-increment)

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 10 Jul '07

10 Jul '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv16487 Modified Files: collections.lisp Log Message: Compare dissimilar types in indices --- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/05/07 18:38:29 1.32 +++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/07/10 21:03:23 1.33 @@ -394,11 +394,16 @@ ;; ======================================= (defun lisp-compare<= (a b) - (etypecase a - (number (<= a b)) - (string (string<= a b)) - (persistent (<= (oid a) (oid b))) - (symbol (string<= (symbol-name a) (symbol-name b))))) + (let ((ta (type-of a)) + (tb (type-of b))) + (if (equal ta tb) + (typecase a + (number (<= a b)) + (persistent (<= (oid a) (oid b))) + (string (string<= a b)) + (symbol (string<= (symbol-name a) (symbol-name b))) + (pathname (string<= (namestring a) (namestring b))) + (t nil))))) (defun lisp-compare-equal (a b) (equal a b))

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 26 Jun '07

26 Jun '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv29972/src/elephant Modified Files: pset.lisp Log Message: Small fix to metaclass issues in pset --- /project/elephant/cvsroot/elephant/src/elephant/pset.lisp 2007/06/12 14:17:45 1.4 +++ /project/elephant/cvsroot/elephant/src/elephant/pset.lisp 2007/06/26 15:27:50 1.5 @@ -31,7 +31,7 @@ ;; Public API ;; -(defpclass pset (persistent-collection) () +(defclass pset () () (:documentation "An unordered persistent collection of unique elements according to serializer equal comparison")) @@ -72,7 +72,7 @@ (defmethod build-pset ((sc store-controller)) "Default pset method; override if backend has better policy" (let ((btree (make-btree sc))) - (make-instance 'default-pset :btree btree :sc sc))) + (make-instance 'default-pset :btree btree))) (defun make-pset (&key items pset (sc *store-controller*)) (let ((new-pset (build-pset sc)))

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 12 Jun '07

12 Jun '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv2975 Modified Files: pset.lisp Log Message: Patch fix for non-persistent pset --- /project/elephant/cvsroot/elephant/src/elephant/pset.lisp 2007/04/25 02:28:02 1.3 +++ /project/elephant/cvsroot/elephant/src/elephant/pset.lisp 2007/06/12 14:17:45 1.4 @@ -31,7 +31,7 @@ ;; Public API ;; -(defclass pset (persistent-collection) () +(defpclass pset (persistent-collection) () (:documentation "An unordered persistent collection of unique elements according to serializer equal comparison")) @@ -72,7 +72,7 @@ (defmethod build-pset ((sc store-controller)) "Default pset method; override if backend has better policy" (let ((btree (make-btree sc))) - (make-instance 'default-pset :btree btree :sc sc :from-oid (oid btree)))) + (make-instance 'default-pset :btree btree :sc sc))) (defun make-pset (&key items pset (sc *store-controller*)) (let ((new-pset (build-pset sc)))

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 04 Jun '07

04 Jun '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv31612/src/elephant Modified Files: unicode2.lisp Log Message: Bug fix for utf16/32 unicode serialization --- /project/elephant/cvsroot/elephant/src/elephant/unicode2.lisp 2007/04/29 02:10:55 1.9 +++ /project/elephant/cvsroot/elephant/src/elephant/unicode2.lisp 2007/06/04 21:14:04 1.10 @@ -244,7 +244,7 @@ (setf code (dpb (next-byte 1) (byte 8 0) code)) (setf (schar string i) (code-char code))) (incf (elephant-memutil::buffer-stream-position bstream) - (+ pos (* length 2)))) + (* length 2))) (the simple-string string))) (defmethod deserialize-string ((type (eql :utf32le)) bstream &optional temp-string) @@ -266,7 +266,7 @@ (setf code (dpb (next-byte 3) (byte 8 0) code)) (setf (char string i) (code-char code))) (incf (elephant-memutil::buffer-stream-position bstream) - (+ pos (* length 4))) + (* length 4)) (the simple-string string))))

1 0

[elephant-cvs] CVS elephant/tests
by ieslick 04 Jun '07

04 Jun '07

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv21637/tests Modified Files: testserializer.lisp Log Message: Fix to new test --- /project/elephant/cvsroot/elephant/tests/testserializer.lisp 2007/06/04 20:02:16 1.23 +++ /project/elephant/cvsroot/elephant/tests/testserializer.lisp 2007/06/04 20:25:15 1.24 @@ -400,14 +400,14 @@ t t t t t t t) (defclass spud () - ((msgid :type 'list :initform "" :accessor :msgd :initarg :msgid) - (value :type '(or list string) :initform "" :accessor :vl :initarg :value))) + ((msgid :type list :initform "" :accessor :msgd :initarg :msgid) + (value :type (or list string) :initform "" :accessor :vl :initarg :value))) (deftest test-serialization-unicode-slot (let ((s (make-instance 'spud :msgid '(a b c) :value "Mesaĝo Teksto"))) - (in-out-equal s) + (in-out-deep-equalp s) ) -) + t) (defun in-out-deep-equalp (var) (assert *store-controller*)

1 0

[elephant-cvs] CVS elephant/tests
by rread 04 Jun '07

04 Jun '07

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv15491 Modified Files: testserializer.lisp Log Message: Correcting cut-and-paste error --- /project/elephant/cvsroot/elephant/tests/testserializer.lisp 2007/06/04 19:43:17 1.22 +++ /project/elephant/cvsroot/elephant/tests/testserializer.lisp 2007/06/04 20:02:16 1.23 @@ -404,7 +404,7 @@ (value :type '(or list string) :initform "" :accessor :vl :initarg :value))) (deftest test-serialization-unicode-slot - (let ((s (make-instance 'CL-USER::Message :msgid '(a b c) :value "Mesaĝo Teksto"))) + (let ((s (make-instance 'spud :msgid '(a b c) :value "Mesaĝo Teksto"))) (in-out-equal s) ) )

1 0

[elephant-cvs] CVS elephant/tests
by rread 04 Jun '07

04 Jun '07

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv11529 Modified Files: testserializer.lisp Log Message: New test case based on unicode serialization bug --- /project/elephant/cvsroot/elephant/tests/testserializer.lisp 2007/04/21 17:23:02 1.21 +++ /project/elephant/cvsroot/elephant/tests/testserializer.lisp 2007/06/04 19:43:17 1.22 @@ -399,6 +399,16 @@ (deep-equalp b b))) t t t t t t t) +(defclass spud () + ((msgid :type 'list :initform "" :accessor :msgd :initarg :msgid) + (value :type '(or list string) :initform "" :accessor :vl :initarg :value))) + +(deftest test-serialization-unicode-slot + (let ((s (make-instance 'CL-USER::Message :msgid '(a b c) :value "Mesaĝo Teksto"))) + (in-out-equal s) + ) +) + (defun in-out-deep-equalp (var) (assert *store-controller*) (with-buffer-streams (out-buf)

1 0

[elephant-cvs] CVS elephant/doc
by ieslick 01 Jun '07

01 Jun '07

Update of /project/elephant/cvsroot/elephant/doc In directory clnet:/tmp/cvs-serv15969 Modified Files: tutorial.texinfo Log Message: Fix wrong function name in tutorial --- /project/elephant/cvsroot/elephant/doc/tutorial.texinfo 2007/04/28 02:31:11 1.20 +++ /project/elephant/cvsroot/elephant/doc/tutorial.texinfo 2007/06/01 16:38:22 1.21 @@ -791,31 +791,31 @@ by range, use the :start and :end arguments. @lisp -(map-class-index #'print-friend 'friend 'name :value "Carlos") +(map-inverted-index #'print-friend 'friend 'name :value "Carlos") name: Carlos birthdate: (1 1 1972) => NIL -(map-class-index #'print-friend 'friend 'name +(map-inverted-index #'print-friend 'friend 'name :start "Adam" :end "Devin") name: Adriana birthdate: (24 4 1980) name: Carlos birthdate: (1 1 1972) => NIL -(map-class-index #'print-friend 'friend 'birthday +(map-inverted-index #'print-friend 'friend 'birthday :start (encode-date '(1 1 1974)) :end (encode-date '(31 12 1984))) name: Zaid birthdate: (14 8 1976) name: Adriana birthdate: (24 4 1980) => NIL -(map-class-index #'print-friend 'friend 'birthday +(map-inverted-index #'print-friend 'friend 'birthday :start nil :end (encode-date '(10 10 1978))) name: Carlos birthdate: (1 1 1972) name: Zaid birthdate: (14 8 1976) => NIL -(map-class-index #'print-friend 'friend 'birthday +(map-inverted-index #'print-friend 'friend 'birthday :start (encode-date '(10 10 1975)) :end nil) name: Zaid birthdate: (14 8 1976)

1 0

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