elephant-cvs

elephant-cvs@common-lisp.net

858 discussions

[elephant-cvs] CVS elephant/tests
by rread 07 Feb '06

07 Feb '06

Update of /project/elephant/cvsroot/elephant/tests In directory common-lisp:/tmp/cvs-serv9614/tests Modified Files: elephant-tests.lisp testcollections.lisp Added Files: RunIndexingTutorial.lisp testindexing.lisp Log Message: Merger from Ian's branch into the main trunk. --- /project/elephant/cvsroot/elephant/tests/RunIndexingTutorial.lisp 2006/02/05 23:44:26 1.1 +++ /project/elephant/cvsroot/elephant/tests/RunIndexingTutorial.lisp 2006/02/07 23:23:51 1.2 @@ -0,0 +1,39 @@ +(asdf:operate 'asdf:load-op :elephant) +(asdf:operate 'asdf:load-op :ele-bdb) +(asdf:operate 'asdf:load-op :elephant-tests) + +(compile-file "indexing.lisp") +(load "index-tutorial.lisp") + +(in-package "ELEPHANT-TUTORIAL") +(defconstant KILO 1000) +(defun test-generate-and-report-big (num name store-spec) + (open-store store-spec) + (generate-events name num 0.0 ) + (report-events name) + (close-store)) + +(defun find-mid-event (name) + (let ((midpoint (floor (/ (+ *start-timestamp* + *end-timestamp*) 2)))) + (report-events-by-time-only name + midpoint + (+ midpoint)) + ) +) + +(defun report-events-by-time-only (user start end) + "A custom reporting function for our logs - pull out a time range. A real + implementation might do it by dates or by dates + times using one of the + lisp time libraries" + (let ((entries1 (time (get-instances-by-range 'url-log 'timestamp start end))) + (entries2 nil)) + (mapc #'(lambda (x) (if (equal (plog-user x) user) (push x entries2))) entries1) + (format t "Event logs for ~A (~A range, ~A user):~%" user (length entries1) (length entries2)) +)) + + +(time (test-generate-and-report-big (* 10 KILO) "bud" ele-tests::*test-path-primary*)) +(open-store ele-tests::*test-path-primary*) +(time (find-mid-event "bud")) +(close-store) --- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2006/02/04 22:25:10 1.9 +++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2006/02/07 23:23:51 1.10 @@ -92,17 +92,48 @@ (defvar *test-path-primary* *testdb-path* ) + (defvar *test-path-secondary* *testdb-path2* ) - (defun do-all-tests() (progn (do-all-tests-spec *testdb-path*) (do-all-tests-spec *testsqlite3-path*) )) +(defun do-all-tests-spec (spec) + (when spec + (with-open-store (spec) + (let ((*auto-commit* nil)) + (declare (special *auto-commit*)) + (do-tests))))) + +(defun do-test-spec (testname &optional (spec *testdb-path*)) + "For easy interactive running of tests while debugging" + (when spec + (with-open-store (spec) + (let ((*auto-commit* nil)) + (do-test testname))))) + +(defun do-indexing-tests () + (declare (special *old-store*)) + (setq *old-store* *store-controller*) + (unwind-protect + (progn + (open-store *testdb-path*) + (print (do-test 'indexing-basic)) + (print (do-test 'indexing-inherit)) + (print (do-test 'indexing-range)) + (print (do-test 'indexing-reconnect-db)) + (print (do-test 'indexing-change-class)) + (print (do-test 'indexing-redef-class)) + (print (do-test 'indexing-explicit-changes)) + (print (do-test 'indexing-timing)) + (close-store)) + (setq *store-controller* *old-store*))) + (defun do-crazy-pg-tests() (open-store *testpg-path*) (do-test 'indexed-btree-make) --- /project/elephant/cvsroot/elephant/tests/testcollections.lisp 2006/02/05 23:13:08 1.10 +++ /project/elephant/cvsroot/elephant/tests/testcollections.lisp 2006/02/07 23:23:51 1.11 @@ -215,6 +215,7 @@ (deftest remove-kv-from-slot1 (finishes (remove-kv 2 index1)) t) + (deftest no-key-nor-indices-slot1 (values (get-value (second keys) indexed) @@ -225,6 +226,7 @@ (deftest remove-kv-from-slot2 (finishes (remove-kv 300 index2)) t) + (deftest no-key-nor-indices-slot2 (values (get-value (third keys) indexed) --- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/01/29 04:57:21 1.1 +++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2006/02/07 23:23:51 1.2 @@ -0,0 +1,235 @@ + +(in-package :ele-tests) + +(defun setup-testing () + (setf rt::*debug* t) + (setf rt::*catch-errors* nil) +;; (trace elephant::indexed-slot-writer) + (trace ((method initialize-instance :before (persistent)))) + (trace ((method initialize-instance (persistent-object)))) +;; (trace ((method shared-initialize :around (persistent-object t)))) +;; (trace ((method shared-initialize :around (persistent-metaclass t)))) +;; (trace elephant::find-class-index) +;; (trace get-instances-by-class) +;; (trace get-instances-by-value) + (trace enable-class-indexing) + (trace get-instances-by-range) + (trace elephant::cache-instance) + (trace elephant::get-cached-instance) + (trace elephant::get-cache) + (trace elephant::db-transaction-commit) + ) + +;; put list of objects, retrieve on value, range and by class +(deftest indexing-basic + (progn +;; (format t "Global vars:~%") +;; (format t "~%basic store: ~A ~A~%" *store-controller* (controller-path *store-controller*)) +;; (format t "auto-commit: ~A~%" *auto-commit*) + (disable-class-indexing 'idx-one :errorp nil) + (setf (find-class 'idx-one) nil) + + (defclass idx-one () + ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :indexed t)) + (:metaclass persistent-metaclass)) + + (progn + (with-transaction () + (setq inst1 (make-instance 'idx-one :slot1 1 :sc *store-controller*)) + (setq inst2 (make-instance 'idx-one :slot1 1 :sc *store-controller*)) + (setq inst3 (make-instance 'idx-one :slot1 3 :sc *store-controller*))) + +;; (format t "Starting gathering of instances~%") + (values (length (get-instances-by-class 'idx-one)) + (length (get-instances-by-value 'idx-one 'slot1 1)) + (length (get-instances-by-value 'idx-one 'slot1 3)) + (eq (first (get-instances-by-value 'idx-one 'slot1 3)) inst3) + (length (get-instances-by-range 'idx-one 'slot1 1 3))))) + 3 2 1 t 3) + +;; test inherited slots +(deftest indexing-inherit + (progn +;; (format t "inherit store: ~A ~A~%" *store-controller* (controller-path *store-controller*)) + (disable-class-indexing 'idx-one :sc *store-controller* :errorp nil) + (disable-class-indexing 'idx-two :sc *store-controller* :errorp nil) + (setf (find-class 'idx-one) nil) + (setf (find-class 'idx-two) nil) + + (defclass idx-one () + ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :indexed t) + (slot2 :initarg :slot2 :initform 2 :accessor slot2 :indexed t) + (slot3 :initarg :slot3 :initform 3 :accessor slot3) + (slot4 :initarg :slot4 :initform 4 :accessor slot4 :transient t)) + (:metaclass persistent-metaclass)) + + (defclass idx-two (idx-one) + ((slot2 :initarg :slot2 :initform 20 :accessor slot2) + (slot3 :initarg :slot3 :initform 30 :accessor slot3 :indexed t) + (slot4 :initarg :slot4 :initform 40 :accessor slot4 :indexed t)) + (:metaclass persistent-metaclass)) + + (progn + (with-transaction () + (setq inst1 (make-instance 'idx-two :sc *store-controller*))) + + (values (slot1 inst1) + (slot2 inst1) + (slot3 inst1) + (slot4 inst1) + (equal (elephant::indexing-record-slots (elephant::indexed-record (find-class 'idx-two))) + '(slot1 slot3 slot4))))) + 1 20 30 40 t) + +(deftest indexing-range + (progn +;; (format t "range store: ~A ~A~%" *store-controller* (controller-path *store-controller*)) + (disable-class-indexing 'idx-one :sc *store-controller* :errorp nil) + (setf (find-class 'idx-one) nil) + + (defclass idx-one () + ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :indexed t)) + (:metaclass persistent-metaclass)) + + (defun make-idx-one (val) + (make-instance 'idx-one :slot1 val :sc *store-controller*)) + + (with-transaction () + (mapc #'make-idx-one '(1 1 1 2 2 4 5 5 5 6 10))) + + ;; Range should get multiple & single keys inclusive of + ;; start and end + (let ((list (mapcar #'slot1 (get-instances-by-range 'idx-one 'slot1 2 6)))) + (equal list '(2 2 4 5 5 5 6)))) + t) + +(deftest indexing-reconnect-db + (progn + (disable-class-indexing 'idx-two :errorp nil) + (setf (find-class 'idx-two) nil) +;; (format t "connect store: ~A ~A~%" *store-controller* (controller-path *store-controller*)) + + (defclass idx-two () + ((slot1 :initarg :slot1 :initform 1 :accessor slot1 :indexed t) + (slot2 :initarg :slot2 :initform 2 :accessor slot2) + (slot3 :initarg :slot3 :initform 3 :accessor slot3 :indexed t)) + (:metaclass persistent-metaclass)) + + (let ((*old-default* *default-indexed-class-synch-policy*) + (*default-indexed-class-synch-policy* :db)) + + (with-transaction () + (make-instance 'idx-two)) + + ;; Wipe out the class so it's not a redefinition + (setf (find-class 'idx-two) nil) + + ;; Assume our db is out of synch with our class def + (defclass idx-two () + ((slot1 :initarg :slot1 :initform 1 :accessor slot1) + (slot2 :initarg :slot2 :initform 2 :accessor slot2 :indexed t) + (slot3 :initarg :slot3 :initform 3 :accessor slot3 :indexed t)) + (:metaclass persistent-metaclass)) + + ;; Add an instance of the new class + (with-transaction () + (make-instance 'idx-two)) + + ;; DB should dominate (if set as default) + (values (length (get-instances-by-value 'idx-two 'slot3 3)) + (length (get-instances-by-value 'idx-two 'slot1 1)) + (signals-error (length (get-instances-by-value 'idx-two 'slot2 2)))))) + 2 2 t) + +(deftest indexing-change-class + nil + nil) + +(deftest indexing-redef-class + nil + nil) + +(deftest indexing-explicit-changes + nil + nil) + +;; create 10k objects, write each object's +;; slots + +(defclass stress-normal () + ((stress1 :accessor stress1 :initarg :stress1 :initform nil :indexed nil) + (stress2 :accessor stress2 :initarg :stress2 :initform nil :indexed nil)) + (:metaclass persistent-metaclass)) + +(defclass stress-index () + ((stress1 :accessor stress1 :initarg :stress1 :initform nil :indexed t) + (stress2 :accessor stress2 :initarg :stress2 :initform 2 :indexed t) + (stress3 :accessor stress3 :initarg :stress3 :initform 3 :indexed nil)) + (:metaclass persistent-metaclass)) + +(defvar normal-index nil) + +(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)))) + +(defun indexed-stress-setup (count class-name &rest inst-args) + (dotimes (i count) + (apply #'make-instance class-name :stress1 i inst-args))) + +(defun normal-range-lookup (count size) + "Given stress1 slot has values between 1 and count, extract a range of size size that starts + at (/ count 2)" + (let* ((objects nil) + (start (/ count 2)) + (end (1- (+ start size)))) + (with-btree-cursor (cur normal-index) + (multiple-value-bind (value? key val) (cursor-next cur) + (declare (ignore key)) + (when (and value? + (>= (stress1 val) start) + (<= (stress1 val) end)) + (push val objects)))) + objects)) + +(defun indexed-range-lookup (class count size) + (let* ((start (/ count 2)) + (end (1- (+ start size)))) + (get-instances-by-range class 'stress1 start end))) + +(defparameter *stress-count* 500) +(defparameter *range-size* 40) + +(deftest indexing-timing + (progn + + (let ((insts (get-instances-by-class 'stress-index))) + (when insts + (drop-instances insts))) + + (format t "~%Stress test normal setup time (~A):~%" *stress-count*) + (with-transaction () + (time (normal-stress-setup *stress-count* 'stress-normal :stress2 10))) + + (format t "~%Stress test indexed setup time (~A):~%" *stress-count*) + (with-transaction () + (time (indexed-stress-setup *stress-count* 'stress-index :stress2 10))) + + (format t "~%Stress test normal lookup time (~A):~%" *range-size*) + (time + (dotimes (i *range-size*) + (declare (ignore i)) + (normal-range-lookup *stress-count* *range-size*))) + + (format t "~%Stress test indexed lookup time (~A):~%" *range-size*) + (time + (dotimes (i *range-size*) + (declare (ignore i)) + (indexed-range-lookup 'stress-index *stress-count* *range-size*))) + t) + t) + + + +

1 0

[elephant-cvs] CVS elephant
by rread 07 Feb '06

07 Feb '06

Update of /project/elephant/cvsroot/elephant In directory common-lisp:/tmp/cvs-serv9614 Modified Files: elephant-tests.asd elephant.asd Log Message: Merger from Ian's branch into the main trunk. --- /project/elephant/cvsroot/elephant/elephant-tests.asd 2005/11/23 17:51:31 1.4 +++ /project/elephant/cvsroot/elephant/elephant-tests.asd 2006/02/07 23:23:50 1.5 @@ -55,9 +55,10 @@ :components ((:file "elephant-tests") (:file "testserializer") + (:file "testsleepycat") (:file "mop-tests") (:file "testcollections") - (:file "testsleepycat") + (:file "testindexing") (:file "testmigration") ) :serial t))) --- /project/elephant/cvsroot/elephant/elephant.asd 2006/02/04 22:25:09 1.11 +++ /project/elephant/cvsroot/elephant/elephant.asd 2006/02/07 23:23:50 1.12 @@ -64,7 +64,11 @@ (:file "classes") (:file "controller") (:file "collections") - (:file "serializer")) + (:file "serializer") + (:file "index-utils") + (:file "indexing")) + #+openmcl + (:file "openmcl-mop-patches") :serial t)) :depends-on (:uffi))

1 0

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

06 Feb '06

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp:/tmp/cvs-serv6962/src Modified Files: Tag: ELEPHANT-0-4-1-rc1-IAN sleepycat.lisp Log Message: Quick patch to solve OpenMCL library building problems reported by Waldo Rubinstein --- /project/elephant/cvsroot/elephant/src/sleepycat.lisp 2006/01/26 04:03:44 1.16.2.1 +++ /project/elephant/cvsroot/elephant/src/sleepycat.lisp 2006/02/06 17:40:56 1.16.2.2 @@ -126,8 +126,8 @@ (eval-when (:compile-toplevel :load-toplevel) (defparameter *c-library-extension* - #+macosx "dylib" - #-macosx "so" )) + #+(or darwin macosx) "dylib" + #-(or darwin macosx) "so" )) (eval-when (:compile-toplevel :load-toplevel)

1 0

[elephant-cvs] CVS elephant/src
by rread 05 Feb '06

05 Feb '06

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp:/tmp/cvs-serv1987 Removed Files: BerkeleyDB-tests.lisp MigrationTests.lisp RUNTEST.lisp SQLDB-tests.lisp Log Message: Moving these files into tests.

1 0

[elephant-cvs] CVS elephant/tests
by rread 05 Feb '06

05 Feb '06

Update of /project/elephant/cvsroot/elephant/tests In directory common-lisp:/tmp/cvs-serv1957 Added Files: BerkeleyDB-tests.lisp MigrationTests.lisp RUNTEST.lisp SQLDB-tests.lisp Log Message: Moving these test files into the tests directory for clarity --- /project/elephant/cvsroot/elephant/tests/BerkeleyDB-tests.lisp 2006/02/05 23:46:41 NONE +++ /project/elephant/cvsroot/elephant/tests/BerkeleyDB-tests.lisp 2006/02/05 23:46:41 1.1 ;;; Copyright (c) 2006 by Robert L. Read ;;; <rread(a)common-lisp.net> ;;; 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. (asdf:operate 'asdf:load-op :elephant) (asdf:operate 'asdf:load-op :ele-bdb) (asdf:operate 'asdf:load-op :elephant-tests) (in-package "ELEPHANT-TESTS") ;; The primary and secondary test-paths are ;; use for the migration tests. ;; (setq *test-path-primary* *testdb-path*) (setq *test-path-secondary* nil) (do-all-tests-spec *test-path-primary*) --- /project/elephant/cvsroot/elephant/tests/MigrationTests.lisp 2006/02/05 23:46:41 NONE +++ /project/elephant/cvsroot/elephant/tests/MigrationTests.lisp 2006/02/05 23:46:41 1.1 ;;; MigrationTests.lisp ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Copyright (c) 2005,2006 by Robert L. Read ;;; <rread(a)common-lisp.net> ;;; ;;; 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. ;; This file is an example of how to perform the ;; migration tests. You will have to modify it ;; slightly depending on the systems that want to test... ;; You can test migration even between two BDB respositories if you wish (asdf:operate 'asdf:load-op :elephant) (asdf:operate 'asdf:load-op :ele-clsql) (asdf:operate 'asdf:load-op :clsql-postgresql-socket) (asdf:operate 'asdf:load-op :ele-bdb) (asdf:operate 'asdf:load-op :elephant-tests) ;; For sqlite-3.. ;; (asdf:operate 'asdf:load-op :ele-sqlite3) (in-package "ELEPHANT-TESTS") ;; The primary and secondary test-paths are ;; use for the migration tests. ;; This this configuration for testing between BDB and SQL.... (setq *test-path-primary* *testpg-path*) ;; (setq *test-path-primary* *testsqlite3-path*) (setq *test-path-secondary* *testdb-path*) ;; This this configuration for testing from one BDB repository to another... (setq *test-path-primary* *testdb-path*) ;; (setq *test-path-primary* *testsqlite3-path*) (setq *test-path-secondary* *testdb-path2*) (do-migrate-test-spec *test-path-primary*) --- /project/elephant/cvsroot/elephant/tests/RUNTEST.lisp 2006/02/05 23:46:41 NONE +++ /project/elephant/cvsroot/elephant/tests/RUNTEST.lisp 2006/02/05 23:46:41 1.1 ;;; RUNTEST.lisp ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Copyright (c) 2005,2006 by Robert L. Read ;;; <rread(a)common-lisp.net> ;;; ;;; 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. ;; This file is now obsolete... ;; Please use SQLDB-test.lisp or BerkeleyDB-tests.lisp (asdf:operate 'asdf:load-op :elephant) (asdf:operate 'asdf:load-op :ele-clsql) (asdf:oos 'asdf:load-op :clsql-postgresql-socket) (asdf:operate 'asdf:load-op :ele-bdb) (asdf:operate 'asdf:load-op :elephant-tests) (asdf:operate 'asdf:load-op :ele-sqlite3) (in-package "ELEPHANT-TESTS") (do-all-tests) (do-all-tests-spec *testpg-path*) (do-migrate-test-spec *testpg-path*) (do-all-tests-spec *testdb-path*) (do-all-tests-spec *testsqlite3-path*) ;; The primary and secondary test-paths are ;; use for the migration tests. (setq *test-path-primary* *testpg-path*) (setq *test-path-primary* *testsqlite3-path*) (setq *test-path-secondary* *testdb-path*) (setq *test-path-primary* *testdb-path*) (setq *test-path-secondary* nil) (do-all-tests-spec *test-path-primary*) (use-package :sb-profile) (profile "CLSQL") (profile "POSTGRESQL-SOCKET") (profile "ELEPHANT") (use-package "SB-PROFILE") (open-store *testpg-path*) (open-store *testdb-path*) (add-to-root "x1" "y1") (get-from-root "x1") (add-to-root "x2" '(a 4 "spud")) (get-from-root "x2") --- /project/elephant/cvsroot/elephant/tests/SQLDB-tests.lisp 2006/02/05 23:46:41 NONE +++ /project/elephant/cvsroot/elephant/tests/SQLDB-tests.lisp 2006/02/05 23:46:41 1.1 ;;; SQLDB-tests.lisp ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Copyright (c) 2005,2006 by Robert L. Read ;;; <rread(a)common-lisp.net> ;;; ;;; 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. (asdf:operate 'asdf:load-op :elephant) (asdf:operate 'asdf:load-op :ele-clsql) (asdf:operate 'asdf:load-op :elephant-tests) ;; For postgres use this... (asdf:oos 'asdf:load-op :clsql-postgresql-socket) ;; For sqllite3... use this... ;; (asdf:operate 'asdf:load-op :ele-sqlite3) (in-package "ELEPHANT-TESTS") ;; The primary and secondary test-paths are ;; use for the migration tests. ;; You may have to change these from the defaults set in ;; elephant-tests.lisp to point to your database. (setq *test-path-primary* *testpg-path*) ;; This is an alternative ;; (setq *test-path-primary* *testsqlite3-path*) (setq *test-path-secondary* nil) (do-all-tests-spec *test-path-primary*)

1 0

[elephant-cvs] CVS elephant/tests
by rread 05 Feb '06

05 Feb '06

Update of /project/elephant/cvsroot/elephant/tests In directory common-lisp:/tmp/cvs-serv499 Added Files: Tag: ELEPHANT-0-4-1-rc1-IAN RunIndexingTutorial.lisp Log Message: A sample file -- we don't have to keep this, but I didn't want it to get lost.

1 0

[elephant-cvs] CVS elephant/tests
by ieslick 05 Feb '06

05 Feb '06

Update of /project/elephant/cvsroot/elephant/tests In directory common-lisp:/tmp/cvs-serv29751/tests Modified Files: mop-tests.lisp testcollections.lisp testmigration.lisp Log Message: Minor modifications including a cleanup of the basicpersistence test and fixing two bugs in allegro support for slot-unboundp and makunbound. I also removed a workaround of these bugs in the mop-tests.lisp test suite. This checkin confirms that release candidate 0-5-0-rc1 passes all tests under Allegro 7.0 using the BDB 4.3 and SQLite3 backends. --- /project/elephant/cvsroot/elephant/tests/mop-tests.lisp 2006/02/04 22:25:10 1.9 +++ /project/elephant/cvsroot/elephant/tests/mop-tests.lisp 2006/02/05 23:13:08 1.10 @@ -179,17 +179,11 @@ (is-not-null (subtypep 'redef 'persistent-object))) t) -;; i wish i could use slot-makunbound but allegro sux (deftest makunbound (let ((p (make-instance 'p-class :sc *store-controller*))) (with-transaction (:store-controller *store-controller*) (setf (slot1 p) t) - #-allegro - (slot-makunbound p 'slot1) - #+allegro - (slot-makunbound-using-class (find-class 'p-class) p - (find-slot-def 'p-class 'slot1)) - ) + (slot-makunbound p 'slot1)) (signals-condition (slot1 p))) t) --- /project/elephant/cvsroot/elephant/tests/testcollections.lisp 2006/02/04 22:25:10 1.9 +++ /project/elephant/cvsroot/elephant/tests/testcollections.lisp 2006/02/05 23:13:08 1.10 @@ -15,25 +15,23 @@ (in-package :ele-tests) (deftest basicpersistence - (let ((old-store *store-controller*) - (*prev-commit* *auto-commit*) + (let ((*prev-commit* *auto-commit*) (*auto-commit* t) (rv nil)) - (unwind-protect - (let ((x (gensym))) - (add-to-root "x" x) - (let ((sc1 (open-store *test-path-primary*))) - (setf rv (equal (format nil "~A" x) - (format nil "~A" (get-from-root "x")))) -;; This line makes the tests fail, though I don't know why! -;; (close-controller *store-controller*) - )) - (progn - (setq *store-controller* old-store) - (setq *auto-commit* *prev-commit*))) + (unwind-protect + (let ((x (gensym))) + (add-to-root "x" x) + ;; Clear instances + (setf (elephant::instance-cache *store-controller*) + (elephant::make-cache-table :test #'eql)) + ;; Are gensyms equal across db instantiations? + ;; This forces a refetch of the object from db + (setq rv (equal (format nil "~A" x) + (format nil "~A" (get-from-root "x"))))) + (progn + (setq *auto-commit* *prev-commit*))) rv) - t -) + t) (deftest testoid (progn --- /project/elephant/cvsroot/elephant/tests/testmigration.lisp 2006/02/04 22:25:10 1.5 +++ /project/elephant/cvsroot/elephant/tests/testmigration.lisp 2006/02/05 23:13:08 1.6 @@ -194,7 +194,8 @@ (and (and (not (slot-boundp fm1 'slot1)) (not (slot-boundp f1 'slot1))) - (equal (slot1 fm2) (slot1 f2)) - (equal (slot2 bm1) (slot2 b1)))))) +;; (equal (slot1 fm2) (slot1 f2)) +;; (equal (slot2 bm1) (slot2 b1)) + )))) (setq *auto-commit* *prev-commit*)))) t)

1 0

[elephant-cvs] CVS elephant/src
by ieslick 05 Feb '06

05 Feb '06

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp:/tmp/cvs-serv29751/src Modified Files: classes.lisp controller.lisp metaclasses.lisp Log Message: Minor modifications including a cleanup of the basicpersistence test and fixing two bugs in allegro support for slot-unboundp and makunbound. I also removed a workaround of these bugs in the mop-tests.lisp test suite. This checkin confirms that release candidate 0-5-0-rc1 passes all tests under Allegro 7.0 using the BDB 4.3 and SQLite3 backends. --- /project/elephant/cvsroot/elephant/src/classes.lisp 2006/02/04 22:25:09 1.17 +++ /project/elephant/cvsroot/elephant/src/classes.lisp 2006/02/05 23:13:07 1.18 @@ -172,7 +172,7 @@ ;; probably should delete discarded slots, but we'll worry about that later (prog1 (call-next-method) - (format t "persisent-slots ~A~%" (persistent-slots (class-of instance))) +;; (format t "persistent-slots ~A~%" (persistent-slots (class-of instance))) ;; (format t "slot-boundp ~A~%" (slot-boundp instance '%persistent-slots)) (let* ((class (class-of instance)) (new-persistent-slots (set-difference (persistent-slots class) @@ -235,10 +235,10 @@ (loop for slot in (class-slots class) for matches-p = (eq (slot-definition-name slot) slot-name) until matches-p - finally (if (and matches-p - (typep slot 'persistent-slot-definition)) - (persistent-slot-boundp instance slot-name) - (call-next-method)))) + finally (return (if (and matches-p + (subtypep (type-of slot) 'persistent-slot-definition)) + (persistent-slot-boundp instance slot-name) + (call-next-method))))) (defmethod slot-makunbound-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition)) "Deletes the slot from the database." @@ -268,6 +268,6 @@ (defmethod slot-makunbound-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-name symbol)) (loop for slot in (class-slots class) until (eq (slot-definition-name slot) slot-name) - finally (if (typep slot 'persistent-slot-definition) - (slot-makunbound-using-class class instance slot) - (call-next-method)))) + finally (return (if (typep slot 'persistent-slot-definition) + (slot-makunbound-using-class class instance slot) + (call-next-method))))) --- /project/elephant/cvsroot/elephant/src/controller.lisp 2006/02/04 22:25:09 1.15 +++ /project/elephant/cvsroot/elephant/src/controller.lisp 2006/02/05 23:13:07 1.16 @@ -400,10 +400,9 @@ (defmacro with-open-store ((spec) &body body) "Executes the body with an open controller, unconditionally closing the controller on exit." - `(let ((*store-controller* - (get-controller ,spec))) + `(let ((*store-controller* (get-controller ,spec))) (declare (special *store-controller*)) -;; (open-controller *store-controller*) + (open-controller *store-controller*) (unwind-protect (progn ,@body) (close-controller *store-controller*)))) --- /project/elephant/cvsroot/elephant/src/metaclasses.lisp 2006/02/04 22:25:09 1.11 +++ /project/elephant/cvsroot/elephant/src/metaclasses.lisp 2006/02/05 23:13:07 1.12 @@ -278,7 +278,7 @@ (let ((buf (db-get-key-buffered (controller-db (check-con (:dbcn-spc-pst ,instance))) key-buf value-buf))) - (if buf T nil)))))) + (if buf t nil)))))) #+(or cmu sbcl) (defun make-persistent-slot-boundp (name)

1 0

[elephant-cvs] CVS elephant
by ieslick 05 Feb '06

05 Feb '06

Update of /project/elephant/cvsroot/elephant In directory common-lisp:/tmp/cvs-serv29751 Modified Files: ele-sqlite3.asd Log Message: Minor modifications including a cleanup of the basicpersistence test and fixing two bugs in allegro support for slot-unboundp and makunbound. I also removed a workaround of these bugs in the mop-tests.lisp test suite. This checkin confirms that release candidate 0-5-0-rc1 passes all tests under Allegro 7.0 using the BDB 4.3 and SQLite3 backends. --- /project/elephant/cvsroot/elephant/ele-sqlite3.asd 2005/11/23 17:51:31 1.2 +++ /project/elephant/cvsroot/elephant/ele-sqlite3.asd 2006/02/05 23:13:07 1.3 @@ -56,4 +56,4 @@ ( ) :serial t)) - :depends-on (:elephant :clsql :cl-base64 :clsql-sqlite3)) + :depends-on (:ele-clsql :clsql-sqlite3))

1 0

[elephant-cvs] CVS elephant/tests
by rread 04 Feb '06

04 Feb '06

Update of /project/elephant/cvsroot/elephant/tests In directory common-lisp:/tmp/cvs-serv456/tests Modified Files: elephant-tests.lisp mop-tests.lisp testcollections.lisp testmigration.lisp testserializer.lisp testsleepycat.lisp testsorter.lisp Log Message: Mostly changing to LLGPL --- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2006/01/29 01:08:32 1.8 +++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2006/02/04 22:25:10 1.9 @@ -12,33 +12,9 @@ ;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee ;;; <ablumberg(a)common-lisp.net> <blee(a)common-lisp.net> ;;; -;;; This program is released under the following license -;;; ("GPL"). For differenct licensing terms, contact the -;;; copyright holders. -;;; -;;; This program is free software; you can redistribute it -;;; and/or modify it under the terms of the GNU General -;;; Public License as published by the Free Software -;;; Foundation; either version 2 of the License, or (at -;;; your option) any later version. -;;; -;;; This program is distributed in the hope that it will be -;;; useful, but WITHOUT ANY WARRANTY; without even the -;;; implied warranty of MERCHANTABILITY or FITNESS FOR A -;;; PARTICULAR PURPOSE. See the GNU General Public License -;;; for more details. -;;; -;;; The GNU General Public License can be found in the file -;;; LICENSE which should have been distributed with this -;;; code. It can also be found at -;;; -;;; http://www.opensource.org/licenses/gpl-license.php -;;; -;;; You should have received a copy of the GNU General -;;; Public License along with this program; if not, write -;;; to the Free Software Foundation, Inc., 59 Temple Place, -;;; Suite 330, Boston, MA 02111-1307 USA -;;; +;;; 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. (defpackage elephant-tests (:nicknames ele-tests :ele-tests) --- /project/elephant/cvsroot/elephant/tests/mop-tests.lisp 2005/11/23 17:51:59 1.8 +++ /project/elephant/cvsroot/elephant/tests/mop-tests.lisp 2006/02/04 22:25:10 1.9 @@ -1,3 +1,16 @@ +;;; mop-tests.lisp +;;; +;;; part of +;;; +;;; Elephant: an object-oriented database for Common Lisp +;;; +;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee +;;; <ablumberg(a)common-lisp.net> <blee(a)common-lisp.net> +;;; +;;; 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. + (in-package :ele-tests) (deftest non-transient-class-slot-1 --- /project/elephant/cvsroot/elephant/tests/testcollections.lisp 2006/02/04 20:34:02 1.8 +++ /project/elephant/cvsroot/elephant/tests/testcollections.lisp 2006/02/04 22:25:10 1.9 @@ -1,3 +1,16 @@ +;;; testcollections.lisp +;;; +;;; part of +;;; +;;; Elephant: an object-oriented database for Common Lisp +;;; +;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee +;;; <ablumberg(a)common-lisp.net> <blee(a)common-lisp.net> +;;; +;;; 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. +;;; (in-package :ele-tests) @@ -717,16 +730,16 @@ ;; (deftest class-change-deletion -;; (progn -;; (defclass blob-tbc () -;; ((slot1 :accessor slot1 :initarg :slot1) -;; (slot2 :accessor slot2 :initarg :slot2))) -;; (add-to-root "blob" (make-instance 'blob-tbc)) -;; (defclass blob-tbc () -;; ((slot1 :accessor slot1 :initarg :slot1) -;; (slot3 :accessor slot3 :initarg :slot3))) -;; (remove-from-root "blob") -;; (get-from-root "blob") -;; ) -;; nil nil) +;; (progn +;; (defclass blob-tbc () +;; ((slot1 :accessor slot1 :initarg :slot1) +;; (slot2 :accessor slot2 :initarg :slot2))) +;; (add-to-root "blob" (make-instance 'blob-tbc)) +;; (defclass blob-tbc () +;; ((slot1 :accessor slot1 :initarg :slot1) +;; (slot3 :accessor slot3 :initarg :slot3))) +;; (remove-from-root "blob") +;; (get-from-root "blob") +;; ) +;; nil nil) --- /project/elephant/cvsroot/elephant/tests/testmigration.lisp 2006/02/04 20:34:02 1.4 +++ /project/elephant/cvsroot/elephant/tests/testmigration.lisp 2006/02/04 22:25:10 1.5 @@ -1,8 +1,15 @@ -;; This file can really only be used if you -;; have preformed both: -;; (asdf:operate 'asdf:load-op :ele-bdb) -;; and -;; (asdf:operate 'asdf:load-op :ele-clsql) +;;; testmigration.lisp +;;; +;;; part of +;;; +;;; Elephant: an object-oriented database for Common Lisp +;;; +;;; Copyright (c) 2005,2006 by Robert L. Read +;;; <rread(a)common-lisp.net> +;;; +;;; 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. (in-package :ele-tests) --- /project/elephant/cvsroot/elephant/tests/testserializer.lisp 2006/01/29 01:08:32 1.8 +++ /project/elephant/cvsroot/elephant/tests/testserializer.lisp 2006/02/04 22:25:10 1.9 @@ -1,3 +1,16 @@ +;;; testserializer.lisp +;;; +;;; part of +;;; +;;; Elephant: an object-oriented database for Common Lisp +;;; +;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee +;;; <ablumberg(a)common-lisp.net> <blee(a)common-lisp.net> +;;; +;;; 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. + (in-package :ele-tests) (defun in-out-value (var) --- /project/elephant/cvsroot/elephant/tests/testsleepycat.lisp 2006/01/25 15:36:32 1.5 +++ /project/elephant/cvsroot/elephant/tests/testsleepycat.lisp 2006/02/04 22:25:10 1.6 @@ -1,7 +1,17 @@ +;;; testsleepycat.lisp +;;; +;;; part of +;;; +;;; Elephant: an object-oriented database for Common Lisp +;;; +;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee +;;; <ablumberg(a)common-lisp.net> <blee(a)common-lisp.net> +;;; +;;; 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. (in-package "ELE-TESTS") -;;(unuse-package "ELE") -;;(use-package "SLEEPYCAT") (defvar env) (defvar db) --- /project/elephant/cvsroot/elephant/tests/testsorter.lisp 2004/09/16 04:29:19 1.1 +++ /project/elephant/cvsroot/elephant/tests/testsorter.lisp 2006/02/04 22:25:10 1.2 @@ -1,3 +1,16 @@ +;;; testsorter.lisp +;;; +;;; part of +;;; +;;; Elephant: an object-oriented database for Common Lisp +;;; +;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee +;;; <ablumberg(a)common-lisp.net> <blee(a)common-lisp.net> +;;; +;;; 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. + (in-package "ELE") (def-function ("lisp_cmp_test" lisp-compare) @@ -103,4 +116,4 @@ (defconstant lowest-bad-num? 18455751272964294657) - \ No newline at end of file +

1 0

← Newer
1
...
57
58
59
60
61
62
63
...
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