From rread at common-lisp.net  Fri Jan  6 14:20:07 2006
From: rread at common-lisp.net (Robert L. Read)
Date: Fri,  6 Jan 2006 15:20:07 +0100 (CET)
Subject: [elephant-cvs] CVS update: elephant/src/metaclasses.lisp 
Message-ID: <20060106142007.18D0B88161@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp.net:/tmp/cvs-serv14714/src

Modified Files:
	metaclasses.lisp 
Log Message:
Andrew Philpot found this bug that broke the ACL implementation

Date: Fri Jan  6 15:20:03 2006
Author: rread

Index: elephant/src/metaclasses.lisp
diff -u elephant/src/metaclasses.lisp:1.8 elephant/src/metaclasses.lisp:1.9
--- elephant/src/metaclasses.lisp:1.8	Wed Nov 23 18:51:37 2005
+++ elephant/src/metaclasses.lisp	Fri Jan  6 15:20:03 2006
@@ -77,7 +77,10 @@
   ;; It probably would be better to put a string in here in the case
   ;; of sleepycat...
   (dbonnection-spec-pst :type (or list string) :accessor :dbcn-spc-pst :initarg :dbconnection-spec-pst
-			:initform '())
+;; Andrew Philpot discovered that this breaks the ACL implementation.
+;; We are green under both SBCL and ACL with it commented out, so I am commiting it. -- rlr 06 JAN 2006
+;;			:initform '()
+)
    )
   (:documentation 
    "Abstract superclass for all persistent classes (common



From rread at common-lisp.net  Fri Jan  6 14:42:35 2006
From: rread at common-lisp.net (Robert L. Read)
Date: Fri,  6 Jan 2006 15:42:35 +0100 (CET)
Subject: [elephant-cvs] CVS update: elephant/doc/tutorial.texinfo 
Message-ID: <20060106144235.1F1FB88161@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/doc
In directory common-lisp.net:/tmp/cvs-serv15892

Modified Files:
	tutorial.texinfo 
Log Message:
Making sure the directory exists

Date: Fri Jan  6 15:42:34 2006
Author: rread

Index: elephant/doc/tutorial.texinfo
diff -u elephant/doc/tutorial.texinfo:1.1 elephant/doc/tutorial.texinfo:1.2
--- elephant/doc/tutorial.texinfo:1.1	Sun Sep 19 19:44:42 2004
+++ elephant/doc/tutorial.texinfo	Fri Jan  6 15:42:34 2006
@@ -378,7 +378,7 @@
 deserialization, no merge conflicts.....
 
 @lisp
-* (defvar *friends-birthdays* (make-instance 'btree))
+* (defvar *friends-birthdays* (make-btree))
 => *FRIENDS-BIRTHDAYS*
 
 * (add-to-root "friends-birthdays" *friends-birthdays*)
@@ -500,7 +500,7 @@
 and I put them in a table
 
 @lisp
-* (defvar *appointments* (with-transaction () (make-instance 'indexed-btree)))
+* (defvar *appointments* (with-transaction () (make-indexed-btree)))
 => *APPOINTMENTS*
 @end lisp
 
@@ -609,7 +609,7 @@
 run recovery on the database (see sleepycat docs) you can specify that
 with the @code{:recover} and @code{:recover-fatal} keys.
 
-To create one by hand, 
+To create one by hand one can do, 
 
 @lisp
 * (setq *store-controller* (make-instance 'store-controller :path "testdb"))
@@ -619,7 +619,15 @@
 => #<STORE-CONTROLLER @{49252F75@}>
 @end lisp
 
-opens the environment and database.  The @code{persistent-*} objects
+but
+
+ at lisp
+* (open-store "testdb"))
+ at end lisp
+
+is preferred.
+
+This opens the environment and database.  The @code{persistent-*} objects
 reference the @code{*store-controller*} special.  (This is in part because
 slot accessors can't take additional arguments.)  If for some reason
 you want to operate on 2 store controllers, you'll have to do that by



From rread at common-lisp.net  Fri Jan  6 14:42:37 2006
From: rread at common-lisp.net (Robert L. Read)
Date: Fri,  6 Jan 2006 15:42:37 +0100 (CET)
Subject: [elephant-cvs] CVS update: elephant/doc/includes/PLACEHOLDER.txt 
Message-ID: <20060106144237.0206C88161@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/doc/includes
In directory common-lisp.net:/tmp/cvs-serv15892/includes

Added Files:
	PLACEHOLDER.txt 
Log Message:
Making sure the directory exists

Date: Fri Jan  6 15:42:35 2006
Author: rread




From rread at common-lisp.net  Tue Jan 24 15:42:30 2006
From: rread at common-lisp.net (rread)
Date: Tue, 24 Jan 2006 09:42:30 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/src
Message-ID: <20060124154230.DBED329527@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv9274

Modified Files:
	RUNTEST.lisp classes.lisp collections.lisp controller.lisp 
	elephant.lisp metaclasses.lisp sql-controller.lisp 
Log Message:
Changes from Andrew Blumberg discovered while debugging 
on openMCL.


--- /project/elephant/cvsroot/elephant/src/RUNTEST.lisp	2005/11/23 17:51:37	1.2
+++ /project/elephant/cvsroot/elephant/src/RUNTEST.lisp	2006/01/24 15:42:30	1.3
@@ -19,6 +19,10 @@
 (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*)
 
 
--- /project/elephant/cvsroot/elephant/src/classes.lisp	2005/11/23 17:51:37	1.14
+++ /project/elephant/cvsroot/elephant/src/classes.lisp	2006/01/24 15:42:30	1.15
@@ -187,6 +187,9 @@
 		 (setf (slot-value-using-class class instance slot-def)
 		       (funcall initfun))))
 	     )
+;; 	  (format t "transient-slot-inits ~A~%" transient-slot-inits)
+;; 	  (format t "indices boundp ~A~%" (slot-boundp instance 'indices))
+;; 	  (format t "indices-caches boundp ~A~%" (slot-boundp instance 'indices-cache))
 	  ;; let the implementation initialize the transient slots
 	  (apply #'call-next-method instance transient-slot-inits initargs))))))
 
@@ -194,11 +197,16 @@
   ;; 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 "slot-boundp ~A~%" (slot-boundp instance '%persistent-slots))
     (let* ((class (class-of instance))
 	   (new-persistent-slots (set-difference (persistent-slots class)
 						 (old-persistent-slots class))))
 	   
-      (apply #'shared-initialize instance new-persistent-slots initargs))))
+      (apply #'shared-initialize instance new-persistent-slots initargs))
+;;    (format t "slot-boundp ~A~%" (slot-boundp instance '%persistent-slots))
+    )
+  )
 
 (defun find-slot-def-by-name (class slot-name)
   (loop for slot-def in (class-slots class)
--- /project/elephant/cvsroot/elephant/src/collections.lisp	2005/11/23 17:51:37	1.12
+++ /project/elephant/cvsroot/elephant/src/collections.lisp	2006/01/24 15:42:30	1.13
@@ -377,7 +377,8 @@
 (defmethod (setf get-value) (value key (bt btree-index))
   "Puts are not allowed on secondary indices.  Try adding to
 the primary."
-  (declare (ignore value key bt))
+  (declare (ignore value key)
+         (ignorable bt))
   (error "Puts are forbidden on secondary indices.  Try adding to the primary."))
 
 (defgeneric get-primary-key (key bt)
@@ -1008,20 +1009,23 @@
 (defmethod cursor-get-both ((cursor bdb-secondary-cursor) key value)
   "cursor-get-both not implemented for secondary indices.
 Use cursor-pget-both."
-  (declare (ignore cursor key value))
+  (declare (ignore key value)
+         (ignorable cursor))
   (error "cursor-get-both not implemented on secondary
 indices.  Use cursor-pget-both."))
 
 (defmethod cursor-get-both-range ((cursor bdb-secondary-cursor) key value)
   "cursor-get-both-range not implemented for secondary indices.
 Use cursor-pget-both-range."
-  (declare (ignore cursor key value))
+  (declare (ignore key value)
+         (ignorable cursor))
   (error "cursor-get-both-range not implemented on secondary indices.  Use cursor-pget-both-range."))
 
 (defmethod cursor-put ((cursor bdb-secondary-cursor) value &rest rest)
   "Puts are forbidden on secondary indices.  Try adding to
 the primary."
-  (declare (ignore rest value cursor))
+  (declare (ignore rest value)
+         (ignorable cursor))
   (error "Puts are forbidden on secondary indices.  Try adding to the primary."))
 
 (defmethod cursor-next-dup ((cursor bdb-secondary-cursor))
--- /project/elephant/cvsroot/elephant/src/controller.lisp	2005/11/23 17:51:37	1.13
+++ /project/elephant/cvsroot/elephant/src/controller.lisp	2006/01/24 15:42:30	1.14
@@ -181,7 +181,7 @@
   )
  
 (defun add-index-from-index (iname v dstibt dstsc)
-  (declare (type btree-index v)
+#-ALLEGRO  (declare (type btree-index v)
 	   (type indexed-btree dstibt))
   (let ((kf (key-form v)))
     (format t " kf ~A ~%" kf)
--- /project/elephant/cvsroot/elephant/src/elephant.lisp	2005/11/23 17:51:37	1.15
+++ /project/elephant/cvsroot/elephant/src/elephant.lisp	2006/01/24 15:42:30	1.16
@@ -216,7 +216,11 @@
 		slot-definition-initargs
 		class-finalized-p
 		finalize-inheritance
-		compute-slots)
+		compute-slots
+		slot-definition-readers
+                slot-definition-writers
+                class-direct-slots
+		)
   #+allegro
   (:import-from :excl
 		compute-effective-slot-definition-initargs)
--- /project/elephant/cvsroot/elephant/src/metaclasses.lisp	2006/01/06 14:20:03	1.9
+++ /project/elephant/cvsroot/elephant/src/metaclasses.lisp	2006/01/24 15:42:30	1.10
@@ -94,6 +94,9 @@
 default; use the :transient flag otherwise."))
 
 (defmethod persistent-slots ((class persistent-metaclass))
+  (if (slot-boundp class '%persistent-slots)
+      (car (%persistent-slots class))
+      nil)
   (car (%persistent-slots class)))
 
 (defmethod persistent-slots ((class standard-class))
--- /project/elephant/cvsroot/elephant/src/sql-controller.lisp	2005/11/23 17:51:38	1.2
+++ /project/elephant/cvsroot/elephant/src/sql-controller.lisp	2006/01/24 15:42:30	1.3
@@ -533,7 +533,7 @@
 		  :where [and [= [clctn_id] clcn]]
 		  :database con
 		  )))
-    (mapcar #'(lambda (x) (mapcar #'(lambda (q) (deserialize-from-base64-string :sc sc)) x))
+    (mapcar #'(lambda (x) (mapcar #'(lambda (q) (deserialize-from-base64-string q :sc sc)) x))
 	    tuples)))
 
 (defmethod sql-from-root-existsp (key con)



From rread at common-lisp.net  Tue Jan 24 18:00:13 2006
From: rread at common-lisp.net (rread)
Date: Tue, 24 Jan 2006 12:00:13 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/tests/testdb2
Message-ID: <20060124180013.145B91E175@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests/testdb2
In directory common-lisp:/tmp/cvs-serv20770/testdb2

Log Message:
Directory /project/elephant/cvsroot/elephant/tests/testdb2 added to the repository





From rread at common-lisp.net  Tue Jan 24 18:25:00 2006
From: rread at common-lisp.net (rread)
Date: Tue, 24 Jan 2006 12:25:00 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/doc
Message-ID: <20060124182500.B8AC1226DB@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/doc
In directory common-lisp:/tmp/cvs-serv22618/doc

Modified Files:
	tutorial.texinfo 
Log Message:
Clearer test usage and system-specific test invocation patterns


--- /project/elephant/cvsroot/elephant/doc/tutorial.texinfo	2006/01/06 14:42:34	1.2
+++ /project/elephant/cvsroot/elephant/doc/tutorial.texinfo	2006/01/24 18:25:00	1.3
@@ -625,7 +625,7 @@
 * (open-store "testdb"))
 @end lisp
 
-is preferred.
+is the preferred mechanism.
 
 This opens the environment and database.  The @code{persistent-*} objects
 reference the @code{*store-controller*} special.  (This is in part because



From rread at common-lisp.net  Tue Jan 24 18:25:01 2006
From: rread at common-lisp.net (rread)
Date: Tue, 24 Jan 2006 12:25:01 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/src
Message-ID: <20060124182501.1159E226DB@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv22618/src

Modified Files:
	RUNTEST.lisp 
Added Files:
	BerkeleyDB-tests.lisp MigrationTests.lisp SQLDB-tests.lisp 
Log Message:
Clearer test usage and system-specific test invocation patterns


--- /project/elephant/cvsroot/elephant/src/RUNTEST.lisp	2006/01/24 15:42:30	1.3
+++ /project/elephant/cvsroot/elephant/src/RUNTEST.lisp	2006/01/24 18:25:00	1.4
@@ -1,3 +1,6 @@
+;; 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)

--- /project/elephant/cvsroot/elephant/src/BerkeleyDB-tests.lisp	2006/01/24 18:25:01	NONE
+++ /project/elephant/cvsroot/elephant/src/BerkeleyDB-tests.lisp	2006/01/24 18:25:01	1.1
(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/src/MigrationTests.lisp	2006/01/24 18:25:01	NONE
+++ /project/elephant/cvsroot/elephant/src/MigrationTests.lisp	2006/01/24 18:25:01	1.1
;; 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/src/SQLDB-tests.lisp	2006/01/24 18:25:01	NONE
+++ /project/elephant/cvsroot/elephant/src/SQLDB-tests.lisp	2006/01/24 18:25:01	1.1
(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*)


From rread at common-lisp.net  Tue Jan 24 18:25:01 2006
From: rread at common-lisp.net (rread)
Date: Tue, 24 Jan 2006 12:25:01 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20060124182501.6543F226DB@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory common-lisp:/tmp/cvs-serv22618/tests

Modified Files:
	elephant-tests.lisp testcollections.lisp testmigration.lisp 
	testsleepycat.lisp 
Log Message:
Clearer test usage and system-specific test invocation patterns


--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2005/11/23 17:51:59	1.6
+++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2006/01/24 18:25:01	1.7
@@ -86,14 +86,18 @@
 
 
 (defvar *testdb-path* 
-  ;;"/usr/local/share/common-lisp/elephant-0.2/tests/testdb"
   (namestring
    (merge-pathnames 
     #p"tests/testdb/" 
     (asdf:component-pathname (asdf:find-system 'elephant-tests)))))
 
+(defvar *testdb-path2* 
+  (namestring
+   (merge-pathnames 
+    #p"tests/testdb2/" 
+    (asdf:component-pathname (asdf:find-system 'elephant-tests)))))
+
 (defvar *sleepycatdb-path* 
-  ;;"/usr/local/share/common-lisp/elephant-0.2/tests/testdb"
   (namestring
    (merge-pathnames 
     #p"tests/testsleepycat/" 
@@ -136,7 +140,15 @@
 (defun do-migrate-test-spec(spud)
   (with-open-store(spud)
     (let ((*auto-commit* nil))
-      (do-test 'migrate1))))
+      (assert (equal (do-test 'remove-element) 'remove-element))
+      (assert (equal (do-test 'migrate1) 'migrate1))
+      (assert (equal (do-test 'migrate2) 'migrate2))
+      (assert (equal (do-test 'migrate3) 'migrate3))
+      (assert (equal (do-test 'migrate4) 'migrate4))
+      (assert (equal (do-test 'migrate5) 'migrate5))
+      t
+      )
+    ))
 
 (defun do-all-tests-spec(spec)
   (with-open-store (spec)
--- /project/elephant/cvsroot/elephant/tests/testcollections.lisp	2005/12/05 15:08:36	1.5
+++ /project/elephant/cvsroot/elephant/tests/testcollections.lisp	2006/01/24 18:25:01	1.6
@@ -11,7 +11,9 @@
 		 (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"))))))
+				   (format nil "~A" (get-from-root "x"))))
+		   (close-store sc1)
+		   ))
 	    (progn
 	    (setq *store-controller* old-store)
 	    (setq *auto-commit* *prev-commit*)))
--- /project/elephant/cvsroot/elephant/tests/testmigration.lisp	2005/11/23 17:51:59	1.2
+++ /project/elephant/cvsroot/elephant/tests/testmigration.lisp	2006/01/24 18:25:01	1.3
@@ -7,16 +7,26 @@
 (in-package :ele-tests)
 
 (deftest remove-element
+    (if (or (null *test-path-secondary*) 
+	    (null *test-path-primary*))
+	(progn
+	  (format t "*test-path-secondary*  and *test-path-primary* not both set, skipping this test.")
+	  t)
     (let ((a (vector 'a 'b 'c))
 	  (ans (vector 'a 'c)))
       (setf a (ele::remove-indexed-element-and-adjust 1 a))
       (and (equal (aref a 0) (aref ans 0))
 	   (equal (aref a 1) (aref ans 1))
-	   (equal (length a) (length ans))))
+	   (equal (length a) (length ans)))))
   t)
 
 
 (deftest migrate1
+    (if (or (null *test-path-secondary*) 
+	    (null *test-path-primary*))
+	(progn
+	  (format t "*test-path-secondary*  and *test-path-primary* not both set, skipping this test.")
+	  t)
     (let ((old-store *store-controller*)
 	  (*prev-commit* *auto-commit*)
 	  (*auto-commit* t)
@@ -32,11 +42,16 @@
 	    (progn
 	    (setq *store-controller* old-store)
 	    (setq *auto-commit* *prev-commit*)))
-      rv)
+      rv))
   t)
 
 
 (deftest migrate2
+    (if (or (null *test-path-secondary*) 
+	    (null *test-path-primary*))
+	(progn
+	  (format t "*test-path-secondary*  and *test-path-primary* not both set, skipping this test.")
+	  nil)
     (let ((old-store *store-controller*)
 	  (*prev-commit* *auto-commit*)
 	  (*auto-commit* t)
@@ -53,11 +68,16 @@
 		 (btree-differ ibt mig))))
 	    (progn
 	      (setq *store-controller* old-store)
-	      (setq *auto-commit* *prev-commit*))))
+	      (setq *auto-commit* *prev-commit*)))))
   nil)
 
 
 (deftest migrate3
+    (if (or (null *test-path-secondary*) 
+	    (null *test-path-primary*))
+	(progn
+	  (format t "*test-path-secondary*  and *test-path-primary* not both set, skipping this test.")
+	  t)
     (let ((old-store *store-controller*)
 	  (*prev-commit* *auto-commit*)
 	  (*auto-commit* t)
@@ -92,11 +112,17 @@
 	(progn
 	  (setq *store-controller* old-store)
 	  (setq *auto-commit* *prev-commit*)))
-      rv)
+      rv
+      ))
   t)
 
 
 (deftest migrate4
+    (if (or (null *test-path-secondary*) 
+	    (null *test-path-primary*))
+	(progn
+	  (format t "*test-path-secondary*  and *test-path-primary* not both set, skipping this test.")
+	  t)
     (finishes
       (let ((old-store *store-controller*)
 	    (*prev-commit* *auto-commit*)
@@ -121,10 +147,15 @@
 	(progn
 	  (setq *store-controller* old-store)
 	  (setq *auto-commit* *prev-commit*)))
-      ))
+      )))
   t)
 
 (deftest migrate5
+    (if (or (null *test-path-secondary*) 
+	    (null *test-path-primary*))
+	(progn
+	  (format t "*test-path-secondary*  and *test-path-primary* not both set, skipping this test.")
+	  t)
     (finishes
       (let ((old-store *store-controller*)
 	    (*prev-commit* *auto-commit*)
@@ -166,5 +197,5 @@
 	(progn
 	  (setq *store-controller* old-store)
 	  (setq *auto-commit* *prev-commit*))))
-      )
+      ))
   t)
--- /project/elephant/cvsroot/elephant/tests/testsleepycat.lisp	2005/02/24 01:06:05	1.3
+++ /project/elephant/cvsroot/elephant/tests/testsleepycat.lisp	2006/01/24 18:25:01	1.4
@@ -17,7 +17,12 @@
 	   :auto-commit t :create t :thread t))
 
 (deftest prepares-sleepycat
-    (finishes (prepare-sleepycat)) t)
+    (if (not (find-package "ele-bdb"))
+	(progn 
+	  (format t "package ele-bdb not found, so not runnning test prepares-sleepycat~%")
+	     t)
+    (finishes (prepare-sleepycat)))
+    t)
 
 #|
 (deftest put-alot
@@ -60,7 +65,11 @@
 	  finally (sleepycat::db-sequence-remove seq :auto-commit t))))
 
 (deftest test-seq1
-    (finishes (test-sequence1))
+    (if (not (find-package "ele-bdb"))
+	(progn 
+	  (format t "package ele-bdb not found, so not runnning test prepares-sleepycat~%")
+	     t)
+    (finishes (test-sequence1)))
   t)
 
 (defun test-sequence2 ()
@@ -79,7 +88,11 @@
 	  finally (sleepycat::db-sequence-remove seq :auto-commit t))))
 
 (deftest test-seq2
-    (finishes (test-sequence2))
+    (if (not (find-package "ele-bdb"))
+	(progn 
+	  (format t "package ele-bdb not found, so not runnning test prepares-sleepycat~%")
+	     t)
+    (finishes (test-sequence2)))
   t)
 
 (defun cleanup-sleepycat ()
@@ -90,7 +103,11 @@
   (sleepycat::db-env-remove env "test"))
 
 (deftest cleansup-sleepycat
-    (finishes (cleanup-sleepycat))
+    (if (not (find-package "ele-bdb"))
+	(progn 
+	  (format t "package ele-bdb not found, so not runnning test prepares-sleepycat~%")
+	     t)
+    (finishes (cleanup-sleepycat)))
   t)
 
 ;;(unuse-package "SLEEPYCAT")



From rread at common-lisp.net  Tue Jan 24 20:37:43 2006
From: rread at common-lisp.net (rread)
Date: Tue, 24 Jan 2006 14:37:43 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/doc
Message-ID: <20060124203743.74A902A4BB@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/doc
In directory common-lisp:/tmp/cvs-serv874

Modified Files:
	elephant.texinfo tutorial.texinfo 
Added Files:
	installation.texinfo 
Log Message:
Improving the documentation with some stuff about the tests, I hope.


--- /project/elephant/cvsroot/elephant/doc/elephant.texinfo	2005/11/23 17:51:34	1.2
+++ /project/elephant/cvsroot/elephant/doc/elephant.texinfo	2006/01/24 20:37:43	1.3
@@ -43,7 +43,7 @@
 * Introduction:: Introducing Elephant!
 * Tutorial::     A leisurely walk-through.
 * Reference::    API documentation.
-* SQL back-end:: CL-SQL based implementation
+* Installation:: Installation and test-suite procedures and issues
 * Design Notes:: Internals.
 * Copying::      Your rights and freedoms.
 * Concept Index::
@@ -57,7 +57,7 @@
 @include tutorial.texinfo
 @include reference.texinfo
 @include notes.texinfo
- at include sql-backend.texinfo
+ at include installation.texinfo
 @include copying.texinfo
 
 @node Concept Index
--- /project/elephant/cvsroot/elephant/doc/tutorial.texinfo	2006/01/24 18:25:00	1.3
+++ /project/elephant/cvsroot/elephant/doc/tutorial.texinfo	2006/01/24 20:37:43	1.4
@@ -49,10 +49,12 @@
 your store!  We'll assume in this tutorial you created a folder
 @code{testdb} in the current directory.
 
-Assuming you've managed to install Elephant properly,
+Assuming you've managed to install Elephant properly, and 
+are using a BerkeleyDB installation.
 
 @lisp
 * (asdf:operate 'asdf:load-op :elephant)
+* (asdf:operate 'asdf:load-op :ele-bdb)
 @end lisp
 
 will load the relevant files.

--- /project/elephant/cvsroot/elephant/doc/installation.texinfo	2006/01/24 20:37:43	NONE
+++ /project/elephant/cvsroot/elephant/doc/installation.texinfo	2006/01/24 20:37:43	1.1
@c -*-texinfo-*-

@node Installation
@comment node-name, next, previous, up
@chapter Installation
@cindex Installation

@menu
* Installation Basics:: Basic installation
* Test-Suites:: Running the test suites
* SQL-Introduction:: The design and status of the SQL back-end extention.
* Extention Status:: The current status of the SQL back-end extention.
* Multi-repository Operation:: Specifying repositories
* Setting up PostGres:: An example
* Repository Migration:: How to move objects from one repository to another
@end menu

@node Installation Basics 
@comment node-name, next, previous, up
@section Installation

Please see the file ``INSTALL'' in the source distribution for 
more precise information; this is an overview.

Installation of Elephant itself is easy because of the asdf system.
Just execute:
@lisp
(asdf:operate 'asdf:load-op :elephant)
@end lisp



However, Elephant cannot function without a back-end repository.
Elephant presents exactly the same API no matter what you choose
as a repository.  However, you have to use asdf to load the 
code that interfaces to particular repository system.

The basic choices are to use the BerkeleyDB system or 
a SQL based system.  You must perform one of these:
@lisp
(asdf:operate 'asdf:load-op :ele-clsql)
(asdf:operate 'asdf:load-op :ele-bdb)
@end lisp

If you choose a SQL based system, you may have to 
load a specific package for that system, such as:

@lisp
(asdf:operate 'asdf:load-op :ele-sqlite3)
@end lisp
or, for Postgres, 
@lisp
(asdf:oos 'asdf:load-op :clsql-postgresql-socket)
@end lisp


You will have to have the CL-SQL package installed.  Following the 
documentation for CL-SQL under the section ``How CLSQL finds and loads foreign
libraries'' you may need to do something like:
@lisp
(clsql:push-library-path "/usr/lib/")
@end lisp

before doing
@lisp
(asdf:oos 'asdf:load-op :clsql-postgresql-socket)
@end lisp

in order for clsql to find the PostGres library libpq.so, for example.

Without modifcation, Elephant uses this as it's lib path:
@lisp
/usr/local/share/common-lisp/elephant-0.3/
@end lisp

So you could put a symbolic link to libpq.so there, where libmemutil.so and 
libsleepycat.so will also reside.

Elephant is designed to allow multi-repository operation; 
so you could concievably use two or more repositories at the 
same time.  More particularly, you can seamlessly migrate your
data from one repository to a different one at a later date.
In a long duration project, this might occur because of a licensing
or performance issue with a particular respository.




@node Test-Suites
@comment node-name, next, previous, up
@section Test-Suites

Elephant is moderately mature.  Hopefully, it will work out-of-the-box
for you.

However, if you are using an LISP implementation different than the ones
on which it is developed and maintained (currently OpenMCL, SBCL, and ACL),
or as the repositories evolve, or just because of mistakes, you may need
to run the test suites.  If you report a bug, we will ask you 
to run these tests and report the output.  Running them when you 
first install things may give you a sense of confidence and understanding
that makes it worth the trouble.

There are three files that execute the tests.  You should choose
one as a starting point based on what backend(s) you are using.
If using BerekleyDB, use 
@lisp
BerkeleyDB-tests.lisp
@end lisp

If using both, use both of the above and also use:
@lisp
MigrationTests.lisp
@end lisp

The text of this file is included here to give the
casual reader an idea of how elepant test can be run in general:
@lisp
;; 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*)
@end lisp

The appropriate test should execute for you with no errors.
If you get errors, you may wish to report it the 
@code{ elephant-devel at common-lisp.net} email list.



@node SQL-Introduction
@comment node-name, next, previous, up
@section SQL-Introduction

Although originally designed as an interface to the BerkeleyDB system,
the original Elephant system has been experimenetally extended to 
support the use of relational database management systems as the
implementation of the persistent store.  This relies on Kevin Rosenberg's
CL-SQL interface to relational systems.

Although the BerkeleyDB system is an ideal object store for LISP objects,
one might prefer the licensing of a different system.  For example, at 
the time of this writing, it is my interpretation that one cannot use
the BerkeleyDB system behind a public website 
http://www.sleepycat.com/download/licensinginfo.shtml#redistribute
unless one releases the entire web application as open source.

Neither the PostGres DBMS nor SQLite 3 has any such restriction.  Elephant itself is released
under the GPL.  It is somewhat debatable if the GPL allows one to construct
to construct a non-open-source web application but the preponderance of 
opinion appears to be that it does.  Thefore using Elephant and the other
GPLed software that it depends upon allows one to host a a non open-source
web application.  This might be a reason to use Elephant on PostGres of SQLite rather
than Elephant on BerkeleyDB.

Other reasons to use a relational database system might include:
familiarity with those systems, the fact that some part of your application
needs to use the truly relational aspects of those systems, preference for
the tools associated with those systems, etc.

The SQL back-end extention of Elephant provides a function for migrating
data seamlessly between repositories.  That is, one can quite easily move
data from a BerkeleyDB repository to a PostGres repository, and vice versa.
In fact, one of the most important aspects of the extention is that it 
makes Elephant a multi-repository system, rather than a single repository
system, as addition to allowing different implementation strategies for 
those repositories.  This offers at least the possiblity than once 
can develop using one backend, for example BerkeleyDB, and then later
move to MySQL.

At the time of this writing, the basic strategy for the SQL implementation
is quite simple.  The same serializer used for the Sleepycat implementation
is employed, the byte-string is base64 encoded, and placed in a single 
table which is managed by Elephant.

As of Elephant 0.3, Elephant has been tested to work with both Postgres, and 
SQLite 3, thanks do Dan Knapp.

@node Extention Status
@comment node-name, next, previous, up
@section Extention Status

As far as is known at this writing, all functionality except nested transaction
support and cursor-put's that is supported by the BerkeleyDB backend is supported by the CL-SQL
based back-end.  Concurrency and transaction atomicity has not been tested well
for the CL-SQL based system.

Additionally, it is NOT the case that the Elephant system currently provides
transaction support across multiple repositories; it provides the transaction
support provided by the underlying repository to the user in a per-repository
basis.

The PostGres backend is as currently employed is about 5 times slower than 
the BerkeleyDB backend.  This could probably change with continued development.

CL-SQL supports a lot of DBMS systems, but only PostGres has been tested.

The SQL back-end extention has only been tested under SBCL 0.8.18.

The SQL back-end is as easy to use as the BerkeleyDB back-end.  However,
the multi-repository version somewhat complicates the underlying 
persistent object management.  At the time of this writing, the 
community has not decided if this extention will be a part of 
Elephant proper or a separate branch; if it is not made a part of 
Elephant proper, a user might prefer the simpler (and better maintained?)
system if they only want to use the BerkeleyDB back-end.

@node Multi-repository Operation
@comment node-name, next, previous, up
@section Multi-repository Operation

Elephant now keeps a small hashtables that maps ``database specifications'' into
actual database connections.

If a database spec is a string, it is assumed to be a BerkeleyDB path.
If it is a list, it is a assumed to be a CL-SQL connection specification.
For example:
@lisp
ELE-TESTS> *testdb-path*
"/home/read/projects/elephant/elephant/tests/testdb/"
ELE-TESTS> *testpg-path*
(:postgresql "localhost.localdomain" "test" "postgres" "")
ELE-TESTS> 
@end lisp


The tests now have a function @code{do-all-tests-spec} that take a spec and 
based on its type attempt to open the correct kind of store controller and 
perform the tests.

The routine @code{get-controller} takes this specifiation.

The basic strategy is that the ``database specification'' object is stored in
every persistent object and collection so that the repository can be found.

In this way, objects that reside in different repositories can coexist within
the LISP object space, allowing data migration.




@node Setting up PostGres
@comment node-name, next, previous, up
@section Setting up PostGres


To set up a PostGres based back end, you should:

@enumerate
@item Install postgres and make sure postmaster is running.

@item Create a database called ``test'' and set its permissions
to be reached by whatever connection specification you intend to use.  The
tests use: 

@lisp
(defvar *testpg-path*
'(:postgreql "localhost.localdomain" "test" "postgres" ""))
@end lisp

meaning that connections must be allowed to the database test, user ``postgres'',
no password, connected from the same machine ``localhost.localdomain''.
(This would be changed to something more secure in a real application.)
Typically you edit the file : pg_hba.conf to enable various kinds of connections
in postgres.

@item  Be sure to enable socket connection to postgres when you invoke the postmaster.

@item  Test that you can connect to the database with these credentials by running:

@code{ psql -h 127.0.0.1 -U postgres test}

Before you attempt to connect with Elephant.
@end enumerate


meaning that connections must be allowed to the database test, user ``postgres'',
no password, connected from the same machine ``localhost.localdomain''.
(This would be changed to something more secure in a real application.)

Furthermore, you must grant practically all creation/read/write privileges 
to the user postgres on this schema, so that it can construct the tables 
it needs.

Upon first opening a CL-SQL based store controller, the tables, indexes,
sequences, and so on needed by the Elephant system will be created in the 
schema named ``test'' automatically.

To run the tests, execute:

@lisp
(asdf:operate 'asdf:load-op :elephant)
(asdf:operate 'asdf:load-op :ele-clsql)
(asdf:oos 'asdf:load-op :clsql-postgresql-socket)
(in-package "ELEPHANT-TESTS")
(do-all-tests-spec *testpg-path*)
@end lisp

This should produce a small number of errors (about 7) for those test having 
to do with migration and the BerkeleyDB system specifically.

If you execute:

@lisp
(asdf:operate 'asdf:load-op :ele-bdb)
@end lisp

Then connection to the BerkeleyDB system will be enabled, and you should 
be able to execute both

@lisp
(do-all-tests-spec *testpg-path*)
(do-all-tests-spec *testdb-path*)
@end lisp

with no errors in either case.

At present the system has only been tested under PostGres. Some code
parametrization would be required to work with other databases.

Setting up SQLite3 is even easier.  Install SQLite3 (I had to use
the source rather than the binary install, in order to get the dynamic
libraries constructed.)

An example use of SQLLite3 would be:
@lisp
(asdf:operate 'asdf:load-op :elephant)
(asdf:operate 'asdf:load-op :ele-clsql)
(asdf:operate 'asdf:load-op :ele-sqlite3)
(in-package "ELEPHANT-TESTS")
(setq *test-path-primary* '(:sqlite3 "testdb"))
(do-all-tests-spec *test-path-primary*)
@end lisp

The file RUNTESTS.lisp, although possibly not exactly what you want,
contains useful example code.

You can of course migrate between the three currently supported repository
strategies in any combination: BDB, Postgresql, and SQLite3.

In all probability, other relational datbases would be very easy to 
support but have not yet been tested.  The basic pattern of 
the ``path'' specifiers is (cons clsqal-database-type-symbol (normal-clsql-connection-specifier)).

@node Repository Migration
@comment node-name, next, previous, up
@section Repository Migration


This version of Elephant supports migration betwen store controllers,
whether of the same implementation strategy or not.

The tests @code{migrate1} - @code{migrate5} are demonstrations of this techinque.

The functions for performing these migrations are:

@code{migraten-pobj}

The name of this function is meant to imply that it is 
destructive of the object in question, mutating it to 

[23 lines skipped]


From rread at common-lisp.net  Wed Jan 25 14:09:46 2006
From: rread at common-lisp.net (rread)
Date: Wed, 25 Jan 2006 08:09:46 -0600 (CST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20060125140946.4BD712745B@common-lisp.net>

Update of /project/elephant/cvsroot/elephant
In directory common-lisp:/tmp/cvs-serv23860

Modified Files:
	INSTALL elephant.asd 
Log Message:
Making Andrew's changes.



--- /project/elephant/cvsroot/elephant/INSTALL	2005/11/23 17:51:31	1.12
+++ /project/elephant/cvsroot/elephant/INSTALL	2006/01/25 14:09:46	1.13
@@ -122,87 +122,13 @@
 for in my code, but expect (use-package "ELE")'s to produce
 conflicting symbol warnings.
 
------------
-Quick Start
------------
-(These instructions were correct for Elephant 0.2.  They
-are now somewhat obsolete in Elephant 0.3; better information
-can be found in the formal documentation.)
+4) Make the documentation:
 
-For more complete documentation see TUTORIAL and NOTES.  But
-a REPL session is worth a thousand words, so ...
+Execute:
 
--bash-2.05b$ pwd
-/home/ben
+make
 
--bash-2.05b$ mkdir testdb
-
--bash-2.05b$ lisp
-
-CMU Common Lisp 19a, running on archer.uchicago.edu
-With core: /usr/local/lib/cmucl/lib/lisp.core
-Dumped on: Tue, 2004-08-03 11:19:33-05:00 on snapdragon.csl.sri.com
-See <http://www.cons.org/cmucl/> for support information.
-Loaded subsystems:
-    Python 1.1, target Intel x86
-    CLOS based on Gerd's PCL 2004/04/14 03:32:47
-
-CL-USER> (asdf:operate 'asdf:load-op :elephant)
-; loading system definition from elephant.asd into #<The ASDF1841 package>
-;...
-NIL
-
-CL-USER> (use-package "ELE")
-T
-
-CL-USER> (open-store "/home/ben/testdb")
-#<STORE-CONTROLLER {489C1EDD}>
-
-CL-USER> (add-to-root "my key" "my string")
-NIL
-
-CL-USER> (get-from-root "my key")
-"my string"
-T
-
-CL-USER> (get-from-root "my key2")
-NIL
-NIL
-
-CL-USER> (close-store)
-NIL
-
-CL-USER> (quit)
-; Evaluation aborted
-
--bash-2.05b$ lisp
-
-CMU Common Lisp 19a, running on archer.uchicago.edu
-With core: /usr/local/lib/cmucl/lib/lisp.core
-Dumped on: Tue, 2004-08-03 11:19:33-05:00 on snapdragon.csl.sri.com
-See <http://www.cons.org/cmucl/> for support information.
-Loaded subsystems:
-    Python 1.1, target Intel x86
-    CLOS based on Gerd's PCL 2004/04/14 03:32:47
-
-CL-USER> (asdf:operate 'asdf:load-op :elephant)
-; loading system definition from elephant.asd into #<The ASDF1841 package>
-; ...
-NIL
-
-CL-USER> (use-package "ELE")
-T
-
-CL-USER> (open-store "/home/ben/testdb")
-
-CL-USER> (get-from-root "my key")
-"my string"
-T
-
-CL-USER> (close-store)
-NIL
-
-CL-USER> 
+In the doc directory should be build the HTML version of the texinfo files.
 
 -------
 Testing
--- /project/elephant/cvsroot/elephant/elephant.asd	2005/11/23 17:51:31	1.8
+++ /project/elephant/cvsroot/elephant/elephant.asd	2006/01/25 14:09:46	1.9
@@ -63,6 +63,8 @@
 	     (:file "controller")
 	     (:file "collections")
 	     (:file "serializer"))
+	    #+openmcl
+	    (:file "openmcl-mop-patches")
 	    :serial t))
   :depends-on (:uffi))
 



From rread at common-lisp.net  Wed Jan 25 14:09:46 2006
From: rread at common-lisp.net (rread)
Date: Wed, 25 Jan 2006 08:09:46 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/src
Message-ID: <20060125140946.9238A2E02B@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv23860/src

Modified Files:
	classes.lisp elephant.lisp 
Log Message:
Making Andrew's changes.



--- /project/elephant/cvsroot/elephant/src/classes.lisp	2006/01/24 15:42:30	1.15
+++ /project/elephant/cvsroot/elephant/src/classes.lisp	2006/01/25 14:09:46	1.16
@@ -124,7 +124,7 @@
 	    do (initialize-accessors slot-def instance))
       (make-instances-obsolete instance))))
 
-#+(or cmu sbcl)
+#+(or cmu sbcl openmcl)
 (defmethod reinitialize-instance :around ((instance persistent-metaclass) &rest initargs &key &allow-other-keys)
   (prog1
       (call-next-method)
@@ -132,7 +132,7 @@
       (update-persistent-slots instance (persistent-slot-names instance))
       (make-instances-obsolete instance))))
 
-#+allegro
+;; #+allegro
 (defmethod finalize-inheritance :around ((instance persistent-metaclass))
   (prog1
       (call-next-method)
@@ -140,13 +140,13 @@
 	(setf (%persistent-slots instance) 
 	      (cons (persistent-slot-names instance) nil)))))
 
-#+(or cmu sbcl)
-(defmethod finalize-inheritance :around ((instance persistent-metaclass))
-  (prog1
-      (call-next-method)
-    (if (not (slot-boundp instance '%persistent-slots))
-	(setf (%persistent-slots instance) 
-	      (cons (persistent-slot-names instance) nil)))))
+;; #+(or cmu sbcl)
+;; (defmethod finalize-inheritance :around ((instance persistent-metaclass))
+;;   (prog1
+;;       (call-next-method)
+;;     (if (not (slot-boundp instance '%persistent-slots))
+;; 	(setf (%persistent-slots instance) 
+;; 	      (cons (persistent-slot-names instance) nil)))))
 
 (defmethod shared-initialize :around ((instance persistent-object) slot-names &rest initargs &key &allow-other-keys)
   "Initializes the persistent slots via initargs or forms.
--- /project/elephant/cvsroot/elephant/src/elephant.lisp	2006/01/24 15:42:30	1.16
+++ /project/elephant/cvsroot/elephant/src/elephant.lisp	2006/01/25 14:09:46	1.17
@@ -226,6 +226,7 @@
 		compute-effective-slot-definition-initargs)
   #+openmcl
   (:import-from :ccl
+		class-finalized-p
 		compute-class-precedence-list
 		validate-superclass
 		standard-slot-definition



From rread at common-lisp.net  Wed Jan 25 14:33:40 2006
From: rread at common-lisp.net (rread)
Date: Wed, 25 Jan 2006 08:33:40 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/tests/testdb2
Message-ID: <20060125143340.1A6CB36814@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests/testdb2
In directory common-lisp:/tmp/cvs-serv25952/testdb2

Added Files:
	SPACE_HOLDER.txt 
Log Message:
Another space for testing...



--- /project/elephant/cvsroot/elephant/tests/testdb2/SPACE_HOLDER.txt	2006/01/25 14:33:40	NONE
+++ /project/elephant/cvsroot/elephant/tests/testdb2/SPACE_HOLDER.txt	2006/01/25 14:33:40	1.1


From rread at common-lisp.net  Wed Jan 25 15:36:32 2006
From: rread at common-lisp.net (rread)
Date: Wed, 25 Jan 2006 09:36:32 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/src
Message-ID: <20060125153632.680AC36970@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv30381/src

Modified Files:
	bdb-enable.lisp 
Log Message:
Improved the tests


--- /project/elephant/cvsroot/elephant/src/bdb-enable.lisp	2005/11/23 17:51:37	1.2
+++ /project/elephant/cvsroot/elephant/src/bdb-enable.lisp	2006/01/25 15:36:32	1.3
@@ -41,7 +41,11 @@
 ;;; to the Free Software Foundation, Inc., 59 Temple Place,
 ;;; Suite 330, Boston, MA 02111-1307 USA
 ;;;
-
+(defpackage ele-bdb
+  (:documentation 
+   "ELE-BDB: This is just a marker-pacakge to show whether or not
+the Berkeley-DB code is enabled.")
+  (:nicknames ele-bdb :ele-bdb))
 
 #+cmu
 (eval-when (:compile-toplevel)



From rread at common-lisp.net  Wed Jan 25 15:36:32 2006
From: rread at common-lisp.net (rread)
Date: Wed, 25 Jan 2006 09:36:32 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20060125153632.B34A936970@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory common-lisp:/tmp/cvs-serv30381/tests

Modified Files:
	testcollections.lisp testsleepycat.lisp 
Log Message:
Improved the tests


--- /project/elephant/cvsroot/elephant/tests/testcollections.lisp	2006/01/24 18:25:01	1.6
+++ /project/elephant/cvsroot/elephant/tests/testcollections.lisp	2006/01/25 15:36:32	1.7
@@ -12,7 +12,8 @@
 		 (let ((sc1 (open-store *test-path-primary*)))
 		   (setf rv (equal (format nil "~A" x)
 				   (format nil "~A" (get-from-root "x"))))
-		   (close-store sc1)
+;; This line makes the tests fail, though I don't know why!
+;;		   (close-controller *store-controller*)
 		   ))
 	    (progn
 	    (setq *store-controller* old-store)
--- /project/elephant/cvsroot/elephant/tests/testsleepycat.lisp	2006/01/24 18:25:01	1.4
+++ /project/elephant/cvsroot/elephant/tests/testsleepycat.lisp	2006/01/25 15:36:32	1.5
@@ -17,7 +17,7 @@
 	   :auto-commit t :create t :thread t))
 
 (deftest prepares-sleepycat
-    (if (not (find-package "ele-bdb"))
+    (if (not (find-package 'ele-bdb))
 	(progn 
 	  (format t "package ele-bdb not found, so not runnning test prepares-sleepycat~%")
 	     t)
@@ -65,7 +65,7 @@
 	  finally (sleepycat::db-sequence-remove seq :auto-commit t))))
 
 (deftest test-seq1
-    (if (not (find-package "ele-bdb"))
+    (if (not (find-package 'ele-bdb))
 	(progn 
 	  (format t "package ele-bdb not found, so not runnning test prepares-sleepycat~%")
 	     t)
@@ -88,7 +88,7 @@
 	  finally (sleepycat::db-sequence-remove seq :auto-commit t))))
 
 (deftest test-seq2
-    (if (not (find-package "ele-bdb"))
+    (if (not (find-package 'ele-bdb))
 	(progn 
 	  (format t "package ele-bdb not found, so not runnning test prepares-sleepycat~%")
 	     t)
@@ -103,7 +103,7 @@
   (sleepycat::db-env-remove env "test"))
 
 (deftest cleansup-sleepycat
-    (if (not (find-package "ele-bdb"))
+    (if (not (find-package 'ele-bdb))
 	(progn 
 	  (format t "package ele-bdb not found, so not runnning test prepares-sleepycat~%")
 	     t)



From rread at common-lisp.net  Wed Jan 25 16:58:25 2006
From: rread at common-lisp.net (rread)
Date: Wed, 25 Jan 2006 10:58:25 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/src
Message-ID: <20060125165825.6000D2E051@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv9912/src

Modified Files:
	elephant.lisp 
Log Message:
Committing, hopefully the final change.


--- /project/elephant/cvsroot/elephant/src/elephant.lisp	2006/01/25 14:09:46	1.17
+++ /project/elephant/cvsroot/elephant/src/elephant.lisp	2006/01/25 16:58:25	1.18
@@ -227,6 +227,7 @@
   #+openmcl
   (:import-from :ccl
 		class-finalized-p
+		finalize-inheritance
 		compute-class-precedence-list
 		validate-superclass
 		standard-slot-definition



From ieslick at common-lisp.net  Wed Jan 25 21:52:54 2006
From: ieslick at common-lisp.net (ieslick)
Date: Wed, 25 Jan 2006 15:52:54 -0600 (CST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20060125215254.DEB5429470@common-lisp.net>

Update of /project/elephant/cvsroot/elephant
In directory common-lisp:/tmp/cvs-serv3385

Modified Files:
	NOTES 
Log Message:


--- /project/elephant/cvsroot/elephant/NOTES	2004/09/19 17:39:59	1.5
+++ /project/elephant/cvsroot/elephant/NOTES	2006/01/25 21:52:54	1.6
@@ -29,6 +29,7 @@
 database / serializer, specials are needed.  Also specials
 will probably play nice with threaded lisps.  
 
+
 -----------------------
 CLASSES AND METACLASSES
 -----------------------



From rread at common-lisp.net  Wed Jan 25 22:18:03 2006
From: rread at common-lisp.net (rread)
Date: Wed, 25 Jan 2006 16:18:03 -0600 (CST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20060125221803.1A14F15851@common-lisp.net>

Update of /project/elephant/cvsroot/elephant
In directory common-lisp:/tmp/cvs-serv5396

Modified Files:
	ele-bdb.asd 
Log Message:
Not sure about this...


--- /project/elephant/cvsroot/elephant/ele-bdb.asd	2005/11/23 17:51:31	1.2
+++ /project/elephant/cvsroot/elephant/ele-bdb.asd	2006/01/25 22:18:03	1.3
@@ -49,7 +49,6 @@
   :licence "GPL"
   :description "Berkeley-DB based Object respository for Common Lisp"
   :long-description "Including this loads the Berkeley-DB code; you may have to edit the pathname!"
-  
   :components
   ((:module :src
 	    :components



From rread at common-lisp.net  Wed Jan 25 22:18:03 2006
From: rread at common-lisp.net (rread)
Date: Wed, 25 Jan 2006 16:18:03 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/src
Message-ID: <20060125221803.5FB9115851@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv5396/src

Modified Files:
	BerkeleyDB-tests.lisp bdb-enable.lisp 
Log Message:
Not sure about this...


--- /project/elephant/cvsroot/elephant/src/BerkeleyDB-tests.lisp	2006/01/24 18:25:00	1.1
+++ /project/elephant/cvsroot/elephant/src/BerkeleyDB-tests.lisp	2006/01/25 22:18:03	1.2
@@ -11,3 +11,4 @@
 (setq *test-path-secondary* nil)
 
 (do-all-tests-spec *test-path-primary*)
+
--- /project/elephant/cvsroot/elephant/src/bdb-enable.lisp	2006/01/25 15:36:32	1.3
+++ /project/elephant/cvsroot/elephant/src/bdb-enable.lisp	2006/01/25 22:18:03	1.4
@@ -41,11 +41,11 @@
 ;;; to the Free Software Foundation, Inc., 59 Temple Place,
 ;;; Suite 330, Boston, MA 02111-1307 USA
 ;;;
-(defpackage ele-bdb
-  (:documentation 
-   "ELE-BDB: This is just a marker-pacakge to show whether or not
-the Berkeley-DB code is enabled.")
-  (:nicknames ele-bdb :ele-bdb))
+;; (defpackage ele-bdb
+;;   (:documentation 
+;;    "ELE-BDB: This is just a marker-pacakge to show whether or not
+;; the Berkeley-DB code is enabled.")
+;;   (:nicknames ele-bdb :ele-bdb))
 
 #+cmu
 (eval-when (:compile-toplevel)



From rread at common-lisp.net  Thu Jan 26 03:17:56 2006
From: rread at common-lisp.net (rread)
Date: Wed, 25 Jan 2006 21:17:56 -0600 (CST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20060126031756.1AA481D4D0@common-lisp.net>

Update of /project/elephant/cvsroot/elephant
In directory common-lisp:/tmp/cvs-serv30112

Modified Files:
	elephant.asd 
Log Message:
I put opemcl patch int the wrong place.


--- /project/elephant/cvsroot/elephant/elephant.asd	2006/01/25 14:09:46	1.9
+++ /project/elephant/cvsroot/elephant/elephant.asd	2006/01/26 03:17:56	1.10
@@ -58,13 +58,13 @@
 	     (:file "utils")
 	     #+cmu
 	     (:file "cmu-mop-patches")
+	    #+openmcl
+	     (:file "openmcl-mop-patches")
 	     (:file "metaclasses") 
 	     (:file "classes") 
 	     (:file "controller")
 	     (:file "collections")
 	     (:file "serializer"))
-	    #+openmcl
-	    (:file "openmcl-mop-patches")
 	    :serial t))
   :depends-on (:uffi))
 



From ieslick at common-lisp.net  Thu Jan 26 04:03:44 2006
From: ieslick at common-lisp.net (ieslick)
Date: Wed, 25 Jan 2006 22:03:44 -0600 (CST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20060126040344.A991228010@common-lisp.net>

Update of /project/elephant/cvsroot/elephant
In directory common-lisp:/tmp/cvs-serv1023

Modified Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	Makefile elephant.asd 
Log Message:
First pass implementation of main class indexing system after branching from 0.4.1-rc1

--- /project/elephant/cvsroot/elephant/Makefile	2005/11/23 17:51:31	1.7
+++ /project/elephant/cvsroot/elephant/Makefile	2006/01/26 04:03:44	1.7.2.1
@@ -24,16 +24,18 @@
 
 ifeq (Darwin,$(UNAME))
 	SHARED=-bundle
+	EXT=dylib
 else
 	SHARED=-shared
+	EXT=so
 endif
 
-all: libsleepycat.so libmemutil.so
+all: libsleepycat.$(EXT) libmemutil.$(EXT)
 
-libmemutil.so: src/libmemutil.c
+libmemutil.$(EXT): src/libmemutil.c
 	gcc $(SHARED) -Wall  -fPIC -O3 -o $@ $< -lm
 
-libsleepycat.so: src/libsleepycat.c 
+libsleepycat.$(EXT): src/libsleepycat.c 
 	gcc $(SHARED) -Wall -L$(DBLIBDIR)  -I$(DBINCDIR) -fPIC -O3 -o $@ $< -ldb -lm 
 
 
--- /project/elephant/cvsroot/elephant/elephant.asd	2006/01/25 14:09:46	1.9
+++ /project/elephant/cvsroot/elephant/elephant.asd	2006/01/26 04:03:44	1.9.2.1
@@ -62,7 +62,8 @@
 	     (:file "classes") 
 	     (:file "controller")
 	     (:file "collections")
-	     (:file "serializer"))
+	     (:file "serializer")
+	     (:file "indexing"))
 	    #+openmcl
 	    (:file "openmcl-mop-patches")
 	    :serial t))



From ieslick at common-lisp.net  Thu Jan 26 04:03:45 2006
From: ieslick at common-lisp.net (ieslick)
Date: Wed, 25 Jan 2006 22:03:45 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/src
Message-ID: <20060126040345.1CE2528010@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv1023/src

Modified Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	bdb-enable.lisp classes.lisp collections.lisp controller.lisp 
	metaclasses.lisp sleepycat.lisp 
Added Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	IAN-TODO indexing.lisp 
Log Message:
First pass implementation of main class indexing system after branching from 0.4.1-rc1

--- /project/elephant/cvsroot/elephant/src/bdb-enable.lisp	2006/01/25 22:18:03	1.4
+++ /project/elephant/cvsroot/elephant/src/bdb-enable.lisp	2006/01/26 04:03:44	1.4.2.1
@@ -66,15 +66,15 @@
       (uffi:load-foreign-library "/lib/tls/libpthread.so.0" :module "pthread")
     (error "Couldn't load libpthread!"))
 
-    (unless
-        (uffi:load-foreign-library 
-         (if (find-package 'asdf)
+  (unless
+      (uffi:load-foreign-library 
+       (if (find-package 'asdf)
  	   (merge-pathnames 
- 	    #p"libmemutil.so"
+ 	    (make-pathname :name "libmemutil" :type *c-library-extension*)
  	    (asdf:component-pathname (asdf:find-system 'elephant)))
-  	   "/usr/local/share/common-lisp/elephant-0.3/libmemutil.so")
-         :module "libmemutil")
-      (error "Couldn't load libmemutil.so!"))
+  	   (format nil "/usr/local/share/common-lisp/elephant-0.3/libmemutil.~A" *c-library-extension*))
+       :module "libmemutil")
+    (error "Couldn't load libmemutil.~A!" *c-library-extension*))
 
 
 ;; This code has now been moved to the small, asdf-loadable system
@@ -87,9 +87,9 @@
 ;;       "/db/ben/lisp/db43/lib/libdb.so" 
        "/usr/local/BerkeleyDB.4.3/lib/libdb-4.3.so"
        ;; this works on FreeBSD
-       #+(and (or bsd freebsd) (not darwin))
+       #+(and (or bsd freebsd) (not darwin macosx))
        "/usr/local/lib/db43/libdb.so" 
-       #+darwin
+       #+(or darwin macosx)
        ;; for Fink (OS X) -- but I will assume Linux more common...
 ;;       "/sw/lib/libdb-4.3.dylib"
        ;; a possible manual install
@@ -102,10 +102,10 @@
        (uffi:load-foreign-library 
         (if (find-package 'asdf)
  	   (merge-pathnames 
- 	    #p"libsleepycat.so"
+ 	    (make-pathname :name "libsleepycat" :type *c-library-extension*)
  	    (asdf:component-pathname (asdf:find-system 'elephant)))
- 	   "/usr/local/share/common-lisp/elephant-0.3/libsleepycat.so")
+  	   (format nil "/usr/local/share/common-lisp/elephant-0.3/libsleepycat.~A" *c-library-extension*))
         :module "libsleepycat")
-     (error "Couldn't load libsleepycat!"))
+     (error "Couldn't load libsleepycat.~A!" *c-library-extension*))
 
 )
--- /project/elephant/cvsroot/elephant/src/classes.lisp	2006/01/25 14:09:46	1.16
+++ /project/elephant/cvsroot/elephant/src/classes.lisp	2006/01/26 04:03:44	1.16.2.1
@@ -138,7 +138,10 @@
       (call-next-method)
     (if (not (slot-boundp instance '%persistent-slots))
 	(setf (%persistent-slots instance) 
-	      (cons (persistent-slot-names instance) nil)))))
+	      (cons (persistent-slot-names instance) nil)))
+    (if (not (slot-boundp instance '%indexed-slots))
+	(setf (%indexed-slots instance) 
+	      (cons (indexed-slot-names instance) nil)))))
 
 ;; #+(or cmu sbcl)
 ;; (defmethod finalize-inheritance :around ((instance persistent-metaclass))
@@ -247,6 +250,8 @@
   (declare (optimize (speed 3)))
   (let ((name (slot-definition-name slot-def)))
     (persistent-slot-writer new-value instance name)))
+;;    (when (%indexed-p class)
+;;      (update-class-index class instance))))
 
 (defmethod slot-boundp-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Checks if the slot exists in the database."
--- /project/elephant/cvsroot/elephant/src/collections.lisp	2006/01/24 15:42:30	1.13
+++ /project/elephant/cvsroot/elephant/src/collections.lisp	2006/01/26 04:03:44	1.13.2.1
@@ -144,11 +144,9 @@
 
 (defclass bdb-indexed-btree (indexed-btree bdb-btree )
   (
-   (indices :accessor indices :initform (make-hash-table)
-	    )
+   (indices :accessor indices :initform (make-hash-table))
    (indices-cache :accessor indices-cache :initform (make-hash-table)
-	       :transient t
-)
+	       :transient t)
    )
   (:metaclass persistent-metaclass)
   (:documentation "A BDB-based BTree supports secondary indices."))
@@ -378,7 +376,7 @@
   "Puts are not allowed on secondary indices.  Try adding to
 the primary."
   (declare (ignore value key)
-         (ignorable bt))
+	   (ignorable bt))
   (error "Puts are forbidden on secondary indices.  Try adding to the primary."))
 
 (defgeneric get-primary-key (key bt)
--- /project/elephant/cvsroot/elephant/src/controller.lisp	2006/01/24 15:42:30	1.14
+++ /project/elephant/cvsroot/elephant/src/controller.lisp	2006/01/26 04:03:44	1.14.2.1
@@ -74,6 +74,7 @@
 	 :accessor controller-path
 	 :initarg :path)
     (root :reader controller-root)
+    (class-root :reader controller-class-root)
     (db :type (or null pointer-void) :accessor controller-db :initform '())
    (environment :type (or null pointer-void) 
 		:accessor controller-environment)
@@ -98,7 +99,7 @@
 creation, counters, locks, the root (for garbage collection,)
 et cetera."))
 
-;; Without somemore sophistication, these functions 
+;; Without some more sophistication, these functions 
 ;; need to be defined here, so that they will be available for testing
 ;; even if you do not use the strategy in question...
 (defun bdb-store-spec-p (path)
@@ -338,11 +339,16 @@
 
       (let ((root (make-instance 'bdb-btree :from-oid -1 :sc sc)))
 	(setf (slot-value sc 'root) root))
+
+      (setf (slot-value sc 'class-root) 
+	    (make-instance 'bdb-btree :from-oid -2 :sc sc))
+
       sc)))
 
 (defmethod close-controller ((sc bdb-store-controller))
   (when (slot-value sc 'root)
     ;; no root
+    (setf (slot-value sc 'class-root) nil)
     (setf (slot-value sc 'root) nil)
     ;; clean instance cache
     (setf (instance-cache sc) (make-cache-table :test 'eql))
--- /project/elephant/cvsroot/elephant/src/metaclasses.lisp	2006/01/24 15:42:30	1.10
+++ /project/elephant/cvsroot/elephant/src/metaclasses.lisp	2006/01/26 04:03:44	1.10.2.1
@@ -87,11 +87,14 @@
 to user-defined classes and collections.)"))
 
 (defclass persistent-metaclass (standard-class)
-  ((%persistent-slots :accessor %persistent-slots))
+  ((%persistent-slots :accessor %persistent-slots)
+   (%indexed-slots :accessor %indexed-slots)
+   (%instance-index :accessor %instance-index))
   (:documentation 
    "Metaclass for persistent classes.  Use this metaclass to
 define persistent classes.  All slots are persistent by
-default; use the :transient flag otherwise."))
+default; use the :transient flag otherwise.  Slots can also
+be indexed for by-value retrieval"))
 
 (defmethod persistent-slots ((class persistent-metaclass))
   (if (slot-boundp class '%persistent-slots)
@@ -113,6 +116,26 @@
 					    nil)
  					    )))
 
+(defmethod %indexed-p ((class persistent-metaclass))
+  (and (slot-boundp class '%indexed-slots)
+       (car (%indexed-slots class))))
+
+(defmethod indexed-slots ((class persistent-metaclass))
+  (car (%indexed-slots class)))
+
+(defmethod indexed-slots ((class standard-class))
+  nil)
+
+(defmethod old-indexed-slots ((class persistent-metaclass))
+  (cdr (%indexed-slots class)))
+
+(defmethod update-indexed-slots ((class persistent-metaclass) new-slot-list)
+  (setf (%indexed-slots class) (cons new-slot-list
+				     (if (slot-boundp class '%indexed-slots)
+					 (car (%indexed-slots class))
+					 nil))))
+
+
 (defclass persistent-slot-definition (standard-slot-definition)
   ())
 
@@ -131,6 +154,16 @@
 (defclass transient-effective-slot-definition (standard-effective-slot-definition transient-slot-definition)
   ())
 
+
+(defclass indexed-slot-definition (persistent-slot-definition)
+  ((indexed :initform t :initarg :indexed :allocation :class)))
+
+(defclass indexed-direct-slot-definition (persistent-direct-slot-definition indexed-slot-definition)
+  ())
+
+(defclass indexed-effective-slot-definition (persistent-effective-slot-definition indexed-slot-definition)
+  ())
+
 (defgeneric transient (slot))
 
 (defmethod transient ((slot standard-direct-slot-definition))
@@ -139,6 +172,14 @@
 (defmethod transient ((slot persistent-direct-slot-definition))
   nil)
 
+(defgeneric indexed (slot))
+
+(defmethod indexed ((slot standard-direct-slot-definition))
+  nil)
+
+(defmethod indexed ((slot indexed-direct-slot-definition))
+  t)
+
 #+allegro
 (defmethod excl::valid-slot-allocation-list ((class persistent-metaclass))
   '(:instance :class :database))
@@ -150,12 +191,18 @@
   "Checks for the transient tag (and the allocation type)
 and chooses persistent or transient slot definitions."
   (let ((allocation-key (getf initargs :allocation))
-	(transient-p (getf initargs :transient)))
+	(transient-p (getf initargs :transient))
+	(indexed-p (getf initargs :indexed)))
     (when (consp transient-p) (setq transient-p (car transient-p)))
+    (when (consp indexed-p) (setq indexed-p (car indexed-p)))
     (cond ((and (eq allocation-key :class) transient-p)
 	   (find-class 'transient-direct-slot-definition))
 	  ((and (eq allocation-key :class) (not transient-p))
 	   (error "Persistent class slots are not supported, try :transient t."))
+	  ((and indexed-p transient-p)
+	   (error "Cannot declare slots to be both transient and indexed"))
+	  (indexed-p
+	   (find-class 'indexed-direct-slot-definition))
 	  (transient-p
 	   (find-class 'transient-direct-slot-definition))
 	  (t
@@ -183,9 +230,15 @@
 (defmethod effective-slot-definition-class ((class persistent-metaclass) &rest initargs)
   "Chooses the persistent or transient effective slot
 definition class depending on the keyword."
-  (let ((transient-p (getf initargs :transient)))
+  (let ((transient-p (getf initargs :transient))
+	(indexed-p (getf initargs :indexed)))
     (when (consp transient-p) (setq transient-p (car transient-p)))
-    (cond (transient-p
+    (when (consp indexed-p) (setq indexed-p (car indexed-p)))
+    (cond ((and indexed-p transient-p)
+	   (error "Cannot declare a slot to be both indexed and transient"))
+	  (indexed-p
+	   (find-class 'indexed-effective-slot-definition))
+	  (transient-p
 	   (find-class 'transient-effective-slot-definition))
 	  (t
 	   (find-class 'persistent-effective-slot-definition)))))
@@ -235,11 +288,11 @@
 (defmethod compute-effective-slot-definition-initargs ((class persistent-metaclass) slot-definitions)
   (let ((initargs (call-next-method)))
     (if (ensure-transient-chain slot-definitions initargs)
-	(append initargs '(:transient t))
-	(progn
-	  (setf (getf initargs :allocation) :database)
-	  initargs))))
-
+	(setf initargs (append initargs '(:transient t)))
+	(setf (getf initargs :allocation) :database))
+    (if (some #'indexed slot-definitions)
+	(append initargs '(:indexed t))
+	initargs)))
 
 (defmacro persistent-slot-reader (instance name)
 `(if (not (bdb-store-spec-p  (:dbcn-spc-pst ,instance)))
@@ -323,7 +376,7 @@
 (defun persistent-slot-names (class)
   (let ((slot-definitions (class-slots class)))
     (loop for slot-definition in slot-definitions
-       when (equalp (class-of slot-definition) (find-class 'persistent-effective-slot-definition))
+       when (subtypep (type-of slot-definition) 'persistent-effective-slot-definition)
        collect (slot-definition-name slot-definition))))
 
 (defun transient-slot-names (class)
@@ -331,3 +384,8 @@
     (loop for slot-definition in slot-definitions
        unless (persistent-p slot-definition)
        collect (slot-definition-name slot-definition))))
+
+(defun indexed-slot-names (class)
+  (loop for slot-definition in (class-slots class)
+     when (subtypep (type-of slot-definition) 'indexed-effective-slot-definition)
+     collect (slot-definition-name slot-definition)))
--- /project/elephant/cvsroot/elephant/src/sleepycat.lisp	2005/12/05 15:27:54	1.16
+++ /project/elephant/cvsroot/elephant/src/sleepycat.lisp	2006/01/26 04:03:44	1.16.2.1
@@ -124,6 +124,10 @@
 (eval-when (:compile-toplevel)
   (proclaim '(optimize (ext:inhibit-warnings 3))))
 
+(eval-when (:compile-toplevel :load-toplevel)
+  (defparameter *c-library-extension*
+    #+macosx "dylib"
+    #-macosx "so" ))
 
 (eval-when (:compile-toplevel :load-toplevel)
 
@@ -131,11 +135,11 @@
         (uffi:load-foreign-library 
          (if (find-package 'asdf)
  	   (merge-pathnames 
- 	    #p"libmemutil.so"
+ 	    (make-pathname :name "libmemutil" :type *c-library-extension*)
  	    (asdf:component-pathname (asdf:find-system 'elephant)))
-  	   (format nil "~A/~A" *elephant-lib-path* "libmemutil.so"))
+  	   (format nil "~A/~A.~A" *elephant-lib-path* "libmemutil" *c-library-extension*))
          :module "libmemutil")
-      (error "Couldn't load libmemutil.so!"))
+      (error "Couldn't load libmemutil.~A!" *c-library-extension*))
 
   ;; fini on user editable part
 
@@ -509,7 +513,8 @@
   "Return the number of bytes of the internal representation
 of a string."
   #+(and allegro ics)
-  `(let ((l (length ,s))) (+ l l))
+  ;; old: `(let ((l (length ,s))) (+ l l))
+  `(excl:native-string-sizeof ,s :external-format :unicode)
   #+(or (and sbcl sb-unicode) lispworks)
   `(etypecase ,s 
     (base-string (length ,s)) 
@@ -521,7 +526,7 @@
 ;; memcpy is faster than looping!  For Lispworks this causes
 ;; a string to array conversion, but I don't know how to do
 ;; any better (fli:replace-foreign-array is promising?)
-#-(or cmu sbcl scl openmcl)
+#-(or cmu sbcl scl openmcl allegro)
 (def-function ("copy_buf" copy-str-to-buf)
     ((dest array-or-pointer-char)
      (dest-offset :int)
@@ -566,6 +571,18 @@
     (ccl::%copy-ivector-to-ptr ivector (+ disp src-offset)
 			       dest dest-offset length)))
 
+#+allegro
+(defun copy-str-to-buf (dest dest-offset src src-offset length)
+  "Use build-in unicode handling and copying facilities.
+   NOTE: We need to validate the speed of this vs. default."
+  (declare (optimize (speed 3) (safety 0))
+	   (type string src)
+	   (type array-or-pointer-char dest)
+	   (type fixnum length src-offset dest-offset)
+	   (dynamic-extent src dest length))
+  (excl:string-to-native (subseq src src-offset) :address (offset-char-pointer dest dest-offset)
+			     :external-format :unicode))
+
 ;; Lisp version, for kicks.  this assumes 8-bit chars!
 #+(not (or cmu sbcl scl allegro openmcl lispworks))
 (defun copy-str-to-buf (dest dest-offset src src-offset length)
@@ -752,7 +769,10 @@
 	(resize-buffer-stream bs needed))
 ;; I wonder if the basic problem here is that we are using this
 ;; routine instead of something like "copy-ub8-from-system-area"?
+      #-allegro
       (copy-str-to-buf buf size s 0 str-bytes)
+      #+allegro
+      (excl:string-to-native s :address (offset-char-pointer buf size) :external-format :unicode)
       (setf size needed)
       nil)))
 
@@ -880,7 +900,7 @@
     ;; wide!!!
     #+(and allegro ics)
     (excl:native-to-string 
-     (offset-char-pointer (buffer-stream-buffer bs) position) 
+     (offset-char-pointer (buffer-stream-buffer bs) position)
      :length byte-length
      :external-format :unicode)
     #+lispworks



From ieslick at common-lisp.net  Fri Jan 27 00:03:49 2006
From: ieslick at common-lisp.net (ieslick)
Date: Thu, 26 Jan 2006 18:03:49 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20060127000349.C03EB31055@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory common-lisp:/tmp/cvs-serv16040/tests

Modified Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	elephant-tests.lisp testserializer.lisp 
Log Message:


--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2006/01/24 18:25:01	1.7
+++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2006/01/27 00:03:49	1.7.2.1
@@ -114,10 +114,10 @@
 )
 
 (defvar *test-path-primary*
-  *testpg-path*
+  *testdb-path*  
 )
 (defvar *test-path-secondary*
-  *testdb-path*  
+  *testpg-path*
 )
 
 
@@ -151,9 +151,10 @@
     ))
 
 (defun do-all-tests-spec(spec)
-  (with-open-store (spec)
-    (let ((*auto-commit* nil))
-      (do-tests))))
+  (when spec
+    (with-open-store (spec)
+      (let ((*auto-commit* nil))
+	(do-tests)))))
 
 (defun find-slot-def (class-name slot-name)
   (find-if #'(lambda (slot-def)
--- /project/elephant/cvsroot/elephant/tests/testserializer.lisp	2005/11/23 17:51:59	1.7
+++ /project/elephant/cvsroot/elephant/tests/testserializer.lisp	2006/01/27 00:03:49	1.7.2.1
@@ -196,12 +196,14 @@
 	    (array-element-type 
 	     (in-out-value (make-array '(3 4 5) 
 				       :element-type 
-				       '(unsigned-byte 20)))))
+				       '(unsigned-byte 20)
+				       :initial-element 0))))
      (type= (upgraded-array-element-type 'fixnum)
 	    (array-element-type 
 	     (in-out-value (make-array '(3 4 5) 
 				       :element-type 
-				       'fixnum))))
+				       'fixnum
+				       :initial-element 0))))
      )
   t t t t)
      



From ieslick at common-lisp.net  Fri Jan 27 00:03:49 2006
From: ieslick at common-lisp.net (ieslick)
Date: Thu, 26 Jan 2006 18:03:49 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/src
Message-ID: <20060127000349.837A43105A@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv16040/src

Modified Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	IAN-TODO bdb-enable.lisp classes.lisp indexing.lisp 
	metaclasses.lisp 
Log Message:


--- /project/elephant/cvsroot/elephant/src/bdb-enable.lisp	2006/01/26 04:03:44	1.4.2.1
+++ /project/elephant/cvsroot/elephant/src/bdb-enable.lisp	2006/01/27 00:03:49	1.4.2.2
@@ -41,11 +41,12 @@
 ;;; to the Free Software Foundation, Inc., 59 Temple Place,
 ;;; Suite 330, Boston, MA 02111-1307 USA
 ;;;
-;; (defpackage ele-bdb
-;;   (:documentation 
-;;    "ELE-BDB: This is just a marker-pacakge to show whether or not
-;; the Berkeley-DB code is enabled.")
-;;   (:nicknames ele-bdb :ele-bdb))
+
+(defpackage ele-bdb
+  (:documentation 
+   "ELE-BDB: This is just a marker-pacakge to show whether or not
+the Berkeley-DB code is enabled.")
+   (:nicknames ele-bdb :ele-bdb))
 
 #+cmu
 (eval-when (:compile-toplevel)
--- /project/elephant/cvsroot/elephant/src/classes.lisp	2006/01/26 04:03:44	1.16.2.1
+++ /project/elephant/cvsroot/elephant/src/classes.lisp	2006/01/27 00:03:49	1.16.2.2
@@ -133,15 +133,18 @@
       (make-instances-obsolete instance))))
 
 ;; #+allegro
-(defmethod finalize-inheritance :around ((instance persistent-metaclass))
+(defmethod finalize-inheritance :around ((class persistent-metaclass))
   (prog1
       (call-next-method)
-    (if (not (slot-boundp instance '%persistent-slots))
-	(setf (%persistent-slots instance) 
-	      (cons (persistent-slot-names instance) nil)))
-    (if (not (slot-boundp instance '%indexed-slots))
-	(setf (%indexed-slots instance) 
-	      (cons (indexed-slot-names instance) nil)))))
+    (when (not (slot-boundp class '%persistent-slots))
+	(setf (%persistent-slots class) 
+	      (cons (persistent-slot-names class) nil)))
+    (when (not (slot-boundp class '%indexed-slots))
+	(setf (%indexed-slots class) 
+	      (cons (indexed-slot-names class) nil)))
+    (when (not (slot-boundp class '%derived-index-count))
+	(setf (%derived-index-count class) 0))))
+	     
 
 ;; #+(or cmu sbcl)
 ;; (defmethod finalize-inheritance :around ((instance persistent-metaclass))
@@ -200,7 +203,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 "persisent-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)
@@ -249,9 +252,9 @@
   "Set the slot value in the database."
   (declare (optimize (speed 3)))
   (let ((name (slot-definition-name slot-def)))
-    (persistent-slot-writer new-value instance name)))
-;;    (when (%indexed-p class)
-;;      (update-class-index class instance))))
+    (persistent-slot-writer new-value instance name)
+    (when (%indexed-p class)
+      (update-class-index class instance))))
 
 (defmethod slot-boundp-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Checks if the slot exists in the database."
--- /project/elephant/cvsroot/elephant/src/metaclasses.lisp	2006/01/26 04:03:44	1.10.2.1
+++ /project/elephant/cvsroot/elephant/src/metaclasses.lisp	2006/01/27 00:03:49	1.10.2.2
@@ -89,6 +89,7 @@
 (defclass persistent-metaclass (standard-class)
   ((%persistent-slots :accessor %persistent-slots)
    (%indexed-slots :accessor %indexed-slots)
+   (%derived-index-count :accessor %derived-index-count)
    (%instance-index :accessor %instance-index))
   (:documentation 
    "Metaclass for persistent classes.  Use this metaclass to
@@ -117,8 +118,10 @@
  					    )))
 
 (defmethod %indexed-p ((class persistent-metaclass))
-  (and (slot-boundp class '%indexed-slots)
-       (car (%indexed-slots class))))
+  (or (and (slot-boundp class '%indexed-slots)
+	   (car (%indexed-slots class)))
+      (and (slot-boundp class '%derived-index-count)
+	   (> (%derived-index-count class) 0))))
 
 (defmethod indexed-slots ((class persistent-metaclass))
   (car (%indexed-slots class)))
@@ -304,7 +307,7 @@
 	   (let ((buf (db-get-key-buffered 
 		       (controller-db (check-con (:dbcn-spc-pst ,instance))) 
 						 key-buf value-buf)))
-		   (if buf (deserialize buf  :sc (check-con (:dbcn-spc-pst instance)))
+		   (if buf (deserialize buf  :sc (check-con (:dbcn-spc-pst ,instance)))
 		       #+cmu
 		       (error 'unbound-slot :instance ,instance :slot ,name)
 		       #-cmu



From rread at common-lisp.net  Fri Jan 27 01:49:36 2006
From: rread at common-lisp.net (rread)
Date: Thu, 26 Jan 2006 19:49:36 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/src
Message-ID: <20060127014936.7368E2A035@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv22545

Added Files:
	openmcl-mop-patches.lisp 
Log Message:
Curses!  Finally adding.




--- /project/elephant/cvsroot/elephant/src/openmcl-mop-patches.lisp	2006/01/27 01:49:36	NONE
+++ /project/elephant/cvsroot/elephant/src/openmcl-mop-patches.lisp	2006/01/27 01:49:36	1.1
(in-package :CCL)

(let ((*warn-if-redefine-kernel* nil))
  (defun extract-instance-and-class-slotds (slotds)
    (collect ((instance-slots)
	      (shared-slots))
	     (dolist (s slotds (values (instance-slots) (shared-slots)))
	       (let ((alloc (%slot-definition-allocation s)))
		 (if (or (eq alloc :class)
			 (eq alloc :database))
		     (shared-slots s)
		   (instance-slots s)))))))

(defun extract-persistent-effective-slotds (class)
  (extract-slotds-with-allocation :database (%class-slots class)))

(in-package :inspector)

(defun standard-object-line-n (i n)
  (let* ((instance (inspector-object i))
         (class (class-of instance))
         (wrapper (ccl::standard-object-p instance))
	 (instance-start 2))
    (if (< n instance-start)
      (if (eql n 0)
	(values class "Class: " :normal)
	(values wrapper "Wrapper: " :static))
      (let* ((slotds (ccl::extract-instance-effective-slotds class))
             (instance-count (length slotds))
             (shared-start (+ instance-start instance-count
                              (if (eql 0 instance-count) 0 1))))
        (if (< n shared-start)
          (if (eql n instance-start)
            (values nil "Instance slots" :comment)
            (let ((slot-name (slot-definition-name
                              (elt slotds (- n instance-start 1)))))
              (values (slot-value-or-unbound instance slot-name)
                      slot-name
                      :colon)))
	  (let* ((slotds (ccl::extract-class-effective-slotds class))
                 (shared-count (length slotds))
                 (shared-end (+ shared-start shared-count
                                (if (eql shared-count 0) 0 1))))
            (if (< n shared-end)
              (if (eql n shared-start)
                (values nil "Class slots" :comment)
                (let ((slot-name (slot-definition-name 
                                  (elt slotds (- n shared-start 1)))))
                  (values (slot-value-or-unbound instance slot-name)
                           slot-name
                           :colon)))
	      (let* ((slotds (ccl::extract-persistent-effective-slotds class))
		     (persistent-count (length slotds))
		     (persistent-end (+ shared-end persistent-count
				       (if (eql persistent-count 0) 0 1))))
		(if (< n persistent-end)
		    (if (eql n shared-end)
			(values nil "Persistent slots" :comment)
		      (let ((slot-name (slot-definition-name 
					(elt slotds (- n shared-start 1)))))
			(values (slot-value-or-unbound instance slot-name)
				slot-name
				:colon)))
		  (if (and (eql 0 instance-count) (eql 0 shared-count) (eql n shared-end))
		      (values nil "No Slots" :comment)
		    (line-n-out-of-range i n)))))))))))


From ieslick at common-lisp.net  Fri Jan 27 18:52:49 2006
From: ieslick at common-lisp.net (ieslick)
Date: Fri, 27 Jan 2006 12:52:49 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/src
Message-ID: <20060127185249.434961B8CF@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv21689/src

Modified Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	IAN-TODO classes.lisp indexing.lisp metaclasses.lisp 
Log Message:

Latest stable point for everything except change-class and synching classes
to pre-existing repositories.  Significantly cleaned up indexed-slot handling
in the metaclass to be less impactful on existing code.


--- /project/elephant/cvsroot/elephant/src/classes.lisp	2006/01/27 00:03:49	1.16.2.2
+++ /project/elephant/cvsroot/elephant/src/classes.lisp	2006/01/27 18:52:49	1.16.2.3
@@ -114,10 +114,12 @@
 
 #+allegro
 (defmethod reinitialize-instance :around ((instance persistent-metaclass) &rest initargs &key &allow-other-keys)
+  (declare (ignore initargs))
   (prog1
       (call-next-method)
     (when (class-finalized-p instance)
       (update-persistent-slots instance (persistent-slot-names instance))
+      (update-indexed-record instance (indexed-slot-names-from-defs instance))
       (loop with persistent-slots = (persistent-slots instance)
 	    for slot-def in (class-direct-slots instance)
 	    when (member (slot-definition-name slot-def) persistent-slots)
@@ -126,6 +128,7 @@
 
 #+(or cmu sbcl openmcl)
 (defmethod reinitialize-instance :around ((instance persistent-metaclass) &rest initargs &key &allow-other-keys)
+  (declare (ignore initargs))
   (prog1
       (call-next-method)
     (when (class-finalized-p instance)
@@ -140,11 +143,7 @@
 	(setf (%persistent-slots class) 
 	      (cons (persistent-slot-names class) nil)))
     (when (not (slot-boundp class '%indexed-slots))
-	(setf (%indexed-slots class) 
-	      (cons (indexed-slot-names class) nil)))
-    (when (not (slot-boundp class '%derived-index-count))
-	(setf (%derived-index-count class) 0))))
-	     
+      (update-indexed-record class (indexed-slot-names-from-defs class)))))
 
 ;; #+(or cmu sbcl)
 ;; (defmethod finalize-inheritance :around ((instance persistent-metaclass))
@@ -201,6 +200,7 @@
 
 (defmethod update-instance-for-redefined-class :around ((instance persistent-object) added-slots discarded-slots property-list &rest initargs &key &allow-other-keys)
   ;; probably should delete discarded slots, but we'll worry about that later
+  (declare (ignore property-list discarded-slots added-slots))
   (prog1
       (call-next-method)
 ;;    (format t "persisent-slots ~A~%" (persistent-slots (class-of instance)))
@@ -253,8 +253,7 @@
   (declare (optimize (speed 3)))
   (let ((name (slot-definition-name slot-def)))
     (persistent-slot-writer new-value instance name)
-    (when (%indexed-p class)
-      (update-class-index class instance))))
+    (update-index-on-write class instance slot-def)))
 
 (defmethod slot-boundp-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Checks if the slot exists in the database."
@@ -275,19 +274,20 @@
 
 (defmethod slot-makunbound-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Deletes the slot from the database."
-  (declare (optimize (speed 3))
-  	   (ignore class))
-   (if (sql-store-spec-p (:dbcn-spc-pst instance))
-       (progn
+  (declare (optimize (speed 3)))
+  (when (indexed slot-def)
+    (unregister-indexed-slot class (slot-definition-name slot-def)))
+  (if (sql-store-spec-p (:dbcn-spc-pst instance))
+      (progn
  	(let* ((sc (check-con (:dbcn-spc-pst instance)))
  	       (con (controller-db sc)))
- 	(sql-remove-from-root
- 	 (form-slot-key (oid instance) (slot-definition-name slot-def))
- 	  sc
- 	  con
- 	 )
- 	))
-       (with-buffer-streams (key-buf)
+	  (sql-remove-from-root
+	   (form-slot-key (oid instance) (slot-definition-name slot-def))
+	   sc
+	   con
+	   )
+	  ))
+      (with-buffer-streams (key-buf)
  	(buffer-write-int (oid instance) key-buf)
  	(serialize (slot-definition-name slot-def) key-buf)
  	(db-delete-buffered
@@ -304,3 +304,14 @@
 	finally (if (typep slot 'persistent-slot-definition)
 		    (slot-makunbound-using-class class instance slot)
 		    (call-next-method))))
+
+;; Index update interface (used in functions above)
+
+(defmethod update-index-on-write ((class persistent-metaclass) (instance persistent-object) (slot persistent-slot-definition))
+  "Anything that side effects a persistent-object slot should call this to keep
+   the dependant indices in synch.  Only classes with derived indices need to
+   update on writes to non-persistent slots.  update-class-index is implemented
+   by the subsystem that maintains the index"
+  (when (or (slot-value slot 'indexed)
+	    (> (indexing-record-derived-count (indexed-record class)) 0))
+    (update-class-index class instance)))
--- /project/elephant/cvsroot/elephant/src/metaclasses.lisp	2006/01/27 00:03:49	1.10.2.2
+++ /project/elephant/cvsroot/elephant/src/metaclasses.lisp	2006/01/27 18:52:49	1.10.2.3
@@ -46,6 +46,7 @@
   (make-hash-table :test 'equal))
 
 (defun connection-is-indeed-open (con)
+  (declare (ignore con))
   t ;; I don't yet know how to implement this
   )
 
@@ -89,13 +90,16 @@
 (defclass persistent-metaclass (standard-class)
   ((%persistent-slots :accessor %persistent-slots)
    (%indexed-slots :accessor %indexed-slots)
-   (%derived-index-count :accessor %derived-index-count)
-   (%instance-index :accessor %instance-index))
+   (%index-cache :accessor %index-cache))
   (:documentation 
    "Metaclass for persistent classes.  Use this metaclass to
 define persistent classes.  All slots are persistent by
 default; use the :transient flag otherwise.  Slots can also
-be indexed for by-value retrieval"))
+be indexed for by-value retrieval."))
+
+;;
+;; Persistent slot maintenance
+;;
 
 (defmethod persistent-slots ((class persistent-metaclass))
   (if (slot-boundp class '%persistent-slots)
@@ -117,30 +121,9 @@
 					    nil)
  					    )))
 
-(defmethod %indexed-p ((class persistent-metaclass))
-  (or (and (slot-boundp class '%indexed-slots)
-	   (car (%indexed-slots class)))
-      (and (slot-boundp class '%derived-index-count)
-	   (> (%derived-index-count class) 0))))
-
-(defmethod indexed-slots ((class persistent-metaclass))
-  (car (%indexed-slots class)))
-
-(defmethod indexed-slots ((class standard-class))
-  nil)
-
-(defmethod old-indexed-slots ((class persistent-metaclass))
-  (cdr (%indexed-slots class)))
-
-(defmethod update-indexed-slots ((class persistent-metaclass) new-slot-list)
-  (setf (%indexed-slots class) (cons new-slot-list
-				     (if (slot-boundp class '%indexed-slots)
-					 (car (%indexed-slots class))
-					 nil))))
-
 
 (defclass persistent-slot-definition (standard-slot-definition)
-  ())
+  ((indexed :accessor indexed :initarg :indexed :initform nil :allocation :instance)))
 
 (defclass persistent-direct-slot-definition (standard-direct-slot-definition persistent-slot-definition)
   ())
@@ -157,16 +140,6 @@
 (defclass transient-effective-slot-definition (standard-effective-slot-definition transient-slot-definition)
   ())
 
-
-(defclass indexed-slot-definition (persistent-slot-definition)
-  ((indexed :initform t :initarg :indexed :allocation :class)))
-
-(defclass indexed-direct-slot-definition (persistent-direct-slot-definition indexed-slot-definition)
-  ())
-
-(defclass indexed-effective-slot-definition (persistent-effective-slot-definition indexed-slot-definition)
-  ())
-
 (defgeneric transient (slot))
 
 (defmethod transient ((slot standard-direct-slot-definition))
@@ -175,13 +148,101 @@
 (defmethod transient ((slot persistent-direct-slot-definition))
   nil)
 
-(defgeneric indexed (slot))
+;;
+;; Indexed slots maintenance
+;;
+
+;; This just encapsulates record keeping a bit
+(defclass indexing-record ()
+  ((slots :accessor indexing-record-slots :initarg :slots :initform nil)
+   (derived-count :accessor indexing-record-derived-count :initarg :derived-count :initform 0)))
+
+(defmethod print-object ((obj indexing-record) stream)
+  (format stream "#INDEXING-RECORD<islt: ~A dslt: ~A>" 
+	  (length (indexing-record-slots obj))
+	  (indexing-record-derived-count obj)))
 
-(defmethod indexed ((slot standard-direct-slot-definition))
+(defmethod indexed-record ((class standard-class)) 
   nil)
+(defmethod indexed-record ((class persistent-metaclass))
+  (car (%indexed-slots class)))
+(defmethod old-indexed-record ((class persistent-metaclass))
+  (cdr (%indexed-slots class)))
+(defmethod update-indexed-record ((class persistent-metaclass) new-slot-list)
+  (let ((oldrec (if (slot-boundp class '%indexed-slots)
+		    (indexed-record class)
+		    nil)))
+    (setf (%indexed-slots class) 
+	  (cons (make-instance 'indexing-record 
+			       :slots new-slot-list
+			       :derived-count (if oldrec (indexing-record-derived-count oldrec) 0))
+		(if oldrec oldrec nil)))))
 
-(defmethod indexed ((slot indexed-direct-slot-definition))
-  t)
+(defun indexed-slot-names-from-defs (class)
+  (let ((slot-definitions (class-slots class)))
+    (loop for slot-definition in slot-definitions
+       when (and (subtypep (type-of slot-definition) 'persistent-slot-definition)
+		 (indexed slot-definition))
+       collect (slot-definition-name slot-definition))))
+
+(defmethod register-indexed-slot ((class persistent-metaclass) slot)
+  "This method allows for post-definition update of indexed status of
+   class slots.  It changes the effective method so we can rely on 
+   generic function dispatch for differentated behavior"
+  ;; update record
+  (let ((record (indexed-record class)))
+    (unless (member slot (car (%persistent-slots class)))
+      (error "Tried to index slot ~A which isn't a persistent slot" slot))
+    (unless (member slot (indexing-record-slots record))
+;;      This is a normal startup case, but during other cases we'd like
+;;      the duplicate wraning
+;;      (warn "Tried to index slot ~A which is already indexed" slot))
+      (push slot (indexing-record-slots record))))
+  ;; change effective slot def
+  (let ((slot-def (find-slot-def-by-name class slot)))
+    (unless slot-def
+      (error "Slot definition for slot ~A not found, inconsistent state in
+              class ~A" slot (class-name class)))
+    (setf (slot-value slot-def 'indexed) t)))
+
+(defmethod unregister-indexed-slot (class slot)
+  "Revert an indexed slot to it's original state"
+  ;; update record
+  (let ((record (indexed-record class)))
+    (unless (member slot (indexing-record-slots record))
+      (error "Tried to unregister slot ~A which is not indexed" slot))
+    (setf (indexing-record-slots record) (remove slot (indexing-record-slots record))))
+  ;; change effective slot def status
+  (let ((slot-def (find-slot-def-by-name class slot)))
+    (unless slot-def
+      (error "Slot definition for slot ~A not found, inconsistent state in
+              class ~A" slot (class-name class)))
+    (setf (slot-value slot-def 'indexed) nil)))
+
+(defmethod register-derived-index (class name)
+  "Tell the class that it has derived indices defined against it
+   and keep a reference count"
+  (declare (ignore name))
+  (let ((record (indexed-record class)))
+    (incf (indexing-record-derived-count record))))
+
+(defmethod unregister-derived-index (class name)
+  (declare (ignore name))
+  (let ((record (indexed-record class)))
+    (decf (indexing-record-derived-count record))
+    (assert (>= (indexing-record-derived-count record) 0))))
+
+(defmethod indexed ((class persistent-metaclass))
+  (and (slot-boundp class '%indexed-slots )
+       (or (indexing-record-slots (indexed-record class))
+	   (not (= (indexing-record-derived-count (indexed-record class)) 0)))))
+
+(defmethod indexed ((slot standard-slot-definition)) nil)
+(defmethod indexed ((class standard-class)) nil)
+
+;;
+;; Original support for persistent slot protocol
+;;
 
 #+allegro
 (defmethod excl::valid-slot-allocation-list ((class persistent-metaclass))
@@ -204,8 +265,6 @@
 	   (error "Persistent class slots are not supported, try :transient t."))
 	  ((and indexed-p transient-p)
 	   (error "Cannot declare slots to be both transient and indexed"))
-	  (indexed-p
-	   (find-class 'indexed-direct-slot-definition))
 	  (transient-p
 	   (find-class 'transient-direct-slot-definition))
 	  (t
@@ -239,8 +298,6 @@
     (when (consp indexed-p) (setq indexed-p (car indexed-p)))
     (cond ((and indexed-p transient-p)
 	   (error "Cannot declare a slot to be both indexed and transient"))
-	  (indexed-p
-	   (find-class 'indexed-effective-slot-definition))
 	  (transient-p
 	   (find-class 'transient-effective-slot-definition))
 	  (t
@@ -293,7 +350,9 @@
     (if (ensure-transient-chain slot-definitions initargs)
 	(setf initargs (append initargs '(:transient t)))
 	(setf (getf initargs :allocation) :database))
-    (if (some #'indexed slot-definitions)
+    ;; Effective slots are indexed only if the most recent slot definition
+    ;; is indexed.  NOTE: Need to think more about inherited indexed slots
+    (if (indexed (first slot-definitions))
 	(append initargs '(:indexed t))
 	initargs)))
 
@@ -387,8 +446,3 @@
     (loop for slot-definition in slot-definitions
        unless (persistent-p slot-definition)
        collect (slot-definition-name slot-definition))))
-
-(defun indexed-slot-names (class)
-  (loop for slot-definition in (class-slots class)
-     when (subtypep (type-of slot-definition) 'indexed-effective-slot-definition)
-     collect (slot-definition-name slot-definition)))



From ieslick at common-lisp.net  Sun Jan 29 01:08:32 2006
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 28 Jan 2006 19:08:32 -0600 (CST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20060129010832.330FCE02F@common-lisp.net>

Update of /project/elephant/cvsroot/elephant
In directory common-lisp:/tmp/cvs-serv30673

Modified Files:
	Makefile 
Log Message:
Minor modifications to improve compilation on Mac OS X and test completion under Allegro

--- /project/elephant/cvsroot/elephant/Makefile	2005/11/23 17:51:31	1.7
+++ /project/elephant/cvsroot/elephant/Makefile	2006/01/29 01:08:31	1.8
@@ -24,16 +24,18 @@
 
 ifeq (Darwin,$(UNAME))
 	SHARED=-bundle
+	EXT=dylib
 else
 	SHARED=-shared
+	EXT=so
 endif
 
-all: libsleepycat.so libmemutil.so
+all: libsleepycat.$(EXT) libmemutil.$(EXT)
 
-libmemutil.so: src/libmemutil.c
+libmemutil.$(EXT): src/libmemutil.c
 	gcc $(SHARED) -Wall  -fPIC -O3 -o $@ $< -lm
 
-libsleepycat.so: src/libsleepycat.c 
+libsleepycat.$(EXT): src/libsleepycat.c 
 	gcc $(SHARED) -Wall -L$(DBLIBDIR)  -I$(DBINCDIR) -fPIC -O3 -o $@ $< -ldb -lm 
 
 



From ieslick at common-lisp.net  Sun Jan 29 01:08:32 2006
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 28 Jan 2006 19:08:32 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/src
Message-ID: <20060129010832.876A61027A@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv30673/src

Modified Files:
	bdb-enable.lisp sleepycat.lisp sql-controller.lisp 
Log Message:
Minor modifications to improve compilation on Mac OS X and test completion under Allegro

--- /project/elephant/cvsroot/elephant/src/bdb-enable.lisp	2006/01/25 22:18:03	1.4
+++ /project/elephant/cvsroot/elephant/src/bdb-enable.lisp	2006/01/29 01:08:32	1.5
@@ -41,11 +41,12 @@
 ;;; to the Free Software Foundation, Inc., 59 Temple Place,
 ;;; Suite 330, Boston, MA 02111-1307 USA
 ;;;
-;; (defpackage ele-bdb
-;;   (:documentation 
-;;    "ELE-BDB: This is just a marker-pacakge to show whether or not
-;; the Berkeley-DB code is enabled.")
-;;   (:nicknames ele-bdb :ele-bdb))
+
+(defpackage ele-bdb
+  (:documentation 
+   "ELE-BDB: This is just a marker-pacakge to show whether or not
+the Berkeley-DB code is enabled.")
+   (:nicknames ele-bdb :ele-bdb))
 
 #+cmu
 (eval-when (:compile-toplevel)
@@ -66,15 +67,15 @@
       (uffi:load-foreign-library "/lib/tls/libpthread.so.0" :module "pthread")
     (error "Couldn't load libpthread!"))
 
-    (unless
-        (uffi:load-foreign-library 
-         (if (find-package 'asdf)
+  (unless
+      (uffi:load-foreign-library 
+       (if (find-package 'asdf)
  	   (merge-pathnames 
- 	    #p"libmemutil.so"
+ 	    (make-pathname :name "libmemutil" :type *c-library-extension*)
  	    (asdf:component-pathname (asdf:find-system 'elephant)))
-  	   "/usr/local/share/common-lisp/elephant-0.3/libmemutil.so")
-         :module "libmemutil")
-      (error "Couldn't load libmemutil.so!"))
+  	   (format nil "/usr/local/share/common-lisp/elephant-0.3/libmemutil.~A" *c-library-extension*))
+       :module "libmemutil")
+    (error "Couldn't load libmemutil.~A!" *c-library-extension*))
 
 
 ;; This code has now been moved to the small, asdf-loadable system
@@ -87,9 +88,9 @@
 ;;       "/db/ben/lisp/db43/lib/libdb.so" 
        "/usr/local/BerkeleyDB.4.3/lib/libdb-4.3.so"
        ;; this works on FreeBSD
-       #+(and (or bsd freebsd) (not darwin))
+       #+(and (or bsd freebsd) (not darwin macosx))
        "/usr/local/lib/db43/libdb.so" 
-       #+darwin
+       #+(or darwin macosx)
        ;; for Fink (OS X) -- but I will assume Linux more common...
 ;;       "/sw/lib/libdb-4.3.dylib"
        ;; a possible manual install
@@ -102,10 +103,10 @@
        (uffi:load-foreign-library 
         (if (find-package 'asdf)
  	   (merge-pathnames 
- 	    #p"libsleepycat.so"
+ 	    (make-pathname :name "libsleepycat" :type *c-library-extension*)
  	    (asdf:component-pathname (asdf:find-system 'elephant)))
- 	   "/usr/local/share/common-lisp/elephant-0.3/libsleepycat.so")
+  	   (format nil "/usr/local/share/common-lisp/elephant-0.3/libsleepycat.~A" *c-library-extension*))
         :module "libsleepycat")
-     (error "Couldn't load libsleepycat!"))
+     (error "Couldn't load libsleepycat.~A!" *c-library-extension*))
 
 )
--- /project/elephant/cvsroot/elephant/src/sleepycat.lisp	2005/12/05 15:27:54	1.16
+++ /project/elephant/cvsroot/elephant/src/sleepycat.lisp	2006/01/29 01:08:32	1.17
@@ -124,6 +124,10 @@
 (eval-when (:compile-toplevel)
   (proclaim '(optimize (ext:inhibit-warnings 3))))
 
+(eval-when (:compile-toplevel :load-toplevel)
+  (defparameter *c-library-extension*
+    #+macosx "dylib"
+    #-macosx "so" ))
 
 (eval-when (:compile-toplevel :load-toplevel)
 
@@ -131,11 +135,11 @@
         (uffi:load-foreign-library 
          (if (find-package 'asdf)
  	   (merge-pathnames 
- 	    #p"libmemutil.so"
+ 	    (make-pathname :name "libmemutil" :type *c-library-extension*)
  	    (asdf:component-pathname (asdf:find-system 'elephant)))
-  	   (format nil "~A/~A" *elephant-lib-path* "libmemutil.so"))
+  	   (format nil "~A/~A.~A" *elephant-lib-path* "libmemutil" *c-library-extension*))
          :module "libmemutil")
-      (error "Couldn't load libmemutil.so!"))
+      (error "Couldn't load libmemutil.~A!" *c-library-extension*))
 
   ;; fini on user editable part
 
@@ -509,7 +513,8 @@
   "Return the number of bytes of the internal representation
 of a string."
   #+(and allegro ics)
-  `(let ((l (length ,s))) (+ l l))
+  ;; old: `(let ((l (length ,s))) (+ l l))
+  `(excl:native-string-sizeof ,s :external-format :unicode)
   #+(or (and sbcl sb-unicode) lispworks)
   `(etypecase ,s 
     (base-string (length ,s)) 
@@ -521,7 +526,7 @@
 ;; memcpy is faster than looping!  For Lispworks this causes
 ;; a string to array conversion, but I don't know how to do
 ;; any better (fli:replace-foreign-array is promising?)
-#-(or cmu sbcl scl openmcl)
+#-(or cmu sbcl scl openmcl allegro)
 (def-function ("copy_buf" copy-str-to-buf)
     ((dest array-or-pointer-char)
      (dest-offset :int)
@@ -566,6 +571,18 @@
     (ccl::%copy-ivector-to-ptr ivector (+ disp src-offset)
 			       dest dest-offset length)))
 
+#+allegro
+(defun copy-str-to-buf (dest dest-offset src src-offset length)
+  "Use build-in unicode handling and copying facilities.
+   NOTE: We need to validate the speed of this vs. default."
+  (declare (optimize (speed 3) (safety 0))
+	   (type string src)
+	   (type array-or-pointer-char dest)
+	   (type fixnum length src-offset dest-offset)
+	   (dynamic-extent src dest length))
+  (excl:string-to-native (subseq src src-offset) :address (offset-char-pointer dest dest-offset)
+			     :external-format :unicode))
+
 ;; Lisp version, for kicks.  this assumes 8-bit chars!
 #+(not (or cmu sbcl scl allegro openmcl lispworks))
 (defun copy-str-to-buf (dest dest-offset src src-offset length)
@@ -752,7 +769,10 @@
 	(resize-buffer-stream bs needed))
 ;; I wonder if the basic problem here is that we are using this
 ;; routine instead of something like "copy-ub8-from-system-area"?
+      #-allegro
       (copy-str-to-buf buf size s 0 str-bytes)
+      #+allegro
+      (excl:string-to-native s :address (offset-char-pointer buf size) :external-format :unicode)
       (setf size needed)
       nil)))
 
@@ -880,7 +900,7 @@
     ;; wide!!!
     #+(and allegro ics)
     (excl:native-to-string 
-     (offset-char-pointer (buffer-stream-buffer bs) position) 
+     (offset-char-pointer (buffer-stream-buffer bs) position)
      :length byte-length
      :external-format :unicode)
     #+lispworks
--- /project/elephant/cvsroot/elephant/src/sql-controller.lisp	2006/01/24 15:42:30	1.3
+++ /project/elephant/cvsroot/elephant/src/sql-controller.lisp	2006/01/29 01:08:32	1.4
@@ -232,8 +232,6 @@
 	  index)
 	(error "Invalid index initargs!"))))
 
-
-
 (defmethod (setf get-value) (value key (bt sql-indexed-btree))
   "Set a key / value pair, and update secondary indices."
   (let* ((sc (check-con (:dbcn-spc-pst bt)))



From ieslick at common-lisp.net  Sun Jan 29 01:08:32 2006
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 28 Jan 2006 19:08:32 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20060129010832.CCECA14986@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory common-lisp:/tmp/cvs-serv30673/tests

Modified Files:
	elephant-tests.lisp testserializer.lisp 
Log Message:
Minor modifications to improve compilation on Mac OS X and test completion under Allegro

--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2006/01/24 18:25:01	1.7
+++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2006/01/29 01:08:32	1.8
@@ -114,17 +114,17 @@
 )
 
 (defvar *test-path-primary*
-  *testpg-path*
+  *testdb-path*  
 )
 (defvar *test-path-secondary*
-  *testdb-path*  
+  *testdb-path2*
 )
 
 
 (defun do-all-tests()
   (progn
     (do-all-tests-spec *testdb-path*)
-    (do-all-tests-spec *testpg-path*)
+    (do-all-tests-spec *testsqlite3-path*)
     ))
 
 (defun do-crazy-pg-tests()
@@ -151,9 +151,10 @@
     ))
 
 (defun do-all-tests-spec(spec)
-  (with-open-store (spec)
-    (let ((*auto-commit* nil))
-      (do-tests))))
+  (when spec
+    (with-open-store (spec)
+      (let ((*auto-commit* nil))
+	(do-tests)))))
 
 (defun find-slot-def (class-name slot-name)
   (find-if #'(lambda (slot-def)
--- /project/elephant/cvsroot/elephant/tests/testserializer.lisp	2005/11/23 17:51:59	1.7
+++ /project/elephant/cvsroot/elephant/tests/testserializer.lisp	2006/01/29 01:08:32	1.8
@@ -196,12 +196,14 @@
 	    (array-element-type 
 	     (in-out-value (make-array '(3 4 5) 
 				       :element-type 
-				       '(unsigned-byte 20)))))
+				       '(unsigned-byte 20)
+				       :initial-element 0))))
      (type= (upgraded-array-element-type 'fixnum)
 	    (array-element-type 
 	     (in-out-value (make-array '(3 4 5) 
 				       :element-type 
-				       'fixnum))))
+				       'fixnum
+				       :initial-element 0))))
      )
   t t t t)
      



From ieslick at common-lisp.net  Sun Jan 29 04:57:20 2006
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 28 Jan 2006 22:57:20 -0600 (CST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20060129045720.C18602A5BD@common-lisp.net>

Update of /project/elephant/cvsroot/elephant
In directory common-lisp:/tmp/cvs-serv15072

Modified Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	elephant-tests.asd 
Log Message:
First pass complete indexing solution including basic tests.

--- /project/elephant/cvsroot/elephant/elephant-tests.asd	2005/11/23 17:51:31	1.4
+++ /project/elephant/cvsroot/elephant/elephant-tests.asd	2006/01/29 04:57:20	1.4.2.1
@@ -59,6 +59,7 @@
 	     (:file "testcollections")
 	     (:file "testsleepycat")
 	     (:file "testmigration")
+	     (:file "testindexing")
 	     )
 	    :serial t)))
  



From ieslick at common-lisp.net  Sun Jan 29 04:57:21 2006
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 28 Jan 2006 22:57:21 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/src
Message-ID: <20060129045721.32BDE2A5BD@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv15072/src

Modified Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	IAN-TODO classes.lisp collections.lisp controller.lisp 
	elephant.lisp indexing.lisp metaclasses.lisp 
Log Message:
First pass complete indexing solution including basic tests.

--- /project/elephant/cvsroot/elephant/src/classes.lisp	2006/01/27 18:52:49	1.16.2.3
+++ /project/elephant/cvsroot/elephant/src/classes.lisp	2006/01/29 04:57:20	1.16.2.4
@@ -120,6 +120,7 @@
     (when (class-finalized-p instance)
       (update-persistent-slots instance (persistent-slot-names instance))
       (update-indexed-record instance (indexed-slot-names-from-defs instance))
+      (set-db-synch instance :class)
       (loop with persistent-slots = (persistent-slots instance)
 	    for slot-def in (class-direct-slots instance)
 	    when (member (slot-definition-name slot-def) persistent-slots)
@@ -133,6 +134,8 @@
       (call-next-method)
     (when (class-finalized-p instance)
       (update-persistent-slots instance (persistent-slot-names instance))
+      (update-indexed-record instance (indexed-slot-names-from-defs instance))
+      (set-db-synch instance :class)
       (make-instances-obsolete instance))))
 
 ;; #+allegro
@@ -153,6 +156,8 @@
 ;; 	(setf (%persistent-slots instance) 
 ;; 	      (cons (persistent-slot-names instance) nil)))))
 
+;; ISE: Not necessary for allegro 7.0?  Initial values are written twice when I traced (setf slot-value-using-class)
+#-allegro
 (defmethod shared-initialize :around ((instance persistent-object) slot-names &rest initargs &key &allow-other-keys)
   "Initializes the persistent slots via initargs or forms.
 This seems to be necessary because it is typical for
@@ -199,18 +204,16 @@
 	  (apply #'call-next-method instance transient-slot-inits initargs))))))
 
 (defmethod update-instance-for-redefined-class :around ((instance persistent-object) added-slots discarded-slots property-list &rest initargs &key &allow-other-keys)
-  ;; probably should delete discarded slots, but we'll worry about that later
+  ;; NOTE: probably should delete discarded slots, but we'll worry about that later
   (declare (ignore property-list discarded-slots added-slots))
   (prog1
       (call-next-method)
-;;    (format t "persisent-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)
 						 (old-persistent-slots class))))
-	   
+      ;; Update new persistent slots, the others we get for free (same oid!)
+      ;; Isn't this done by the default call-next-method?
       (apply #'shared-initialize instance new-persistent-slots initargs))
-;;    (format t "slot-boundp ~A~%" (slot-boundp instance '%persistent-slots))
     )
   )
 
@@ -231,7 +234,9 @@
 				       when (not (persistent-slot-boundp previous slot-name))
 				       collect slot-name))
 	 (retained-persistent-slots (set-difference raw-retained-persistent-slots retained-unbound-slots)))
+    ;; Apply default values for unbound & new slots (updates class index)
     (apply #'shared-initialize current (append new-persistent-slots retained-unbound-slots) initargs)
+    ;; Copy values from old class (NOTE: should delete discarded slots?) (updates class index)
     (loop for slot-def in (class-slots new-class)
 	  when (member (slot-definition-name slot-def) retained-persistent-slots)
 	  do (setf (slot-value-using-class new-class
@@ -240,6 +245,9 @@
 		   (slot-value-using-class old-class
 					   previous
 					   (find-slot-def-by-name old-class (slot-definition-name slot-def)))))
+    ;; Delete this instance from its old class index, if exists
+    (when (indexed old-class)
+      (remove-kv (oid previous) (find-class-index old-class)))
     (call-next-method)))
 
 (defmethod slot-value-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
@@ -248,12 +256,21 @@
   (let ((name (slot-definition-name slot-def)))
     (persistent-slot-reader instance name)))
 
+;; ORIGINAL METHOD
+;; (defmethod (setf slot-value-using-class) :around (new-value (class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
+;;   "Set the slot value in the database."
+;;   (declare (optimize (speed 3)))
+;;   (let ((name (slot-definition-name slot-def)))
+;;     (persistent-slot-writer new-value instance name)))
+
+;; SUPPORT FOR INVERTED INDEXES
 (defmethod (setf slot-value-using-class) :around (new-value (class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Set the slot value in the database."
   (declare (optimize (speed 3)))
-  (let ((name (slot-definition-name slot-def)))
-    (persistent-slot-writer new-value instance name)
-    (update-index-on-write class instance slot-def)))
+  (if (indexed class)
+      (indexed-slot-writer class instance slot-def new-value)
+      (let ((name (slot-definition-name slot-def)))
+	(persistent-slot-writer new-value instance name))))
 
 (defmethod slot-boundp-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Checks if the slot exists in the database."
@@ -275,6 +292,7 @@
 (defmethod slot-makunbound-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Deletes the slot from the database."
   (declare (optimize (speed 3)))
+  ;; NOTE: call remove-indexed-slot here instead?
   (when (indexed slot-def)
     (unregister-indexed-slot class (slot-definition-name slot-def)))
   (if (sql-store-spec-p (:dbcn-spc-pst instance))
@@ -304,14 +322,3 @@
 	finally (if (typep slot 'persistent-slot-definition)
 		    (slot-makunbound-using-class class instance slot)
 		    (call-next-method))))
-
-;; Index update interface (used in functions above)
-
-(defmethod update-index-on-write ((class persistent-metaclass) (instance persistent-object) (slot persistent-slot-definition))
-  "Anything that side effects a persistent-object slot should call this to keep
-   the dependant indices in synch.  Only classes with derived indices need to
-   update on writes to non-persistent slots.  update-class-index is implemented
-   by the subsystem that maintains the index"
-  (when (or (slot-value slot 'indexed)
-	    (> (indexing-record-derived-count (indexed-record class)) 0))
-    (update-class-index class instance)))
--- /project/elephant/cvsroot/elephant/src/collections.lisp	2006/01/26 04:03:44	1.13.2.1
+++ /project/elephant/cvsroot/elephant/src/collections.lisp	2006/01/29 04:57:20	1.13.2.2
@@ -297,6 +297,7 @@
 	     (multiple-value-bind (index? secondary-key)
 		 (funcall (key-fn index) index key value)
 	       (when index?
+		 ;; Manually write value into secondary index
 		 (buffer-write-int (oid index) secondary-buf)
 		 (serialize secondary-key secondary-buf)
 		 ;; should silently do nothing if the key/value already
--- /project/elephant/cvsroot/elephant/src/controller.lisp	2006/01/26 04:03:44	1.14.2.1
+++ /project/elephant/cvsroot/elephant/src/controller.lisp	2006/01/29 04:57:20	1.14.2.2
@@ -130,6 +130,10 @@
    "Close the db handles and environment.  Tries to wipe out
 references to the db handles."))
 
+(defgeneric reset-instance-cache (sc)
+  (:documentation
+   "Creates an empty object cache by replacing the existing cache."))
+
 (defgeneric build-btree (sc)
   (:documentation 
    "Construct a btree of the appropriate type corresponding to this store-controller."))
@@ -345,6 +349,10 @@
 
       sc)))
 
+(defmethod reset-instance-cache ((sc store-controller))
+  (setf (instance-cache sc) 
+	(make-cache-table :test 'eql)))
+
 (defmethod close-controller ((sc bdb-store-controller))
   (when (slot-value sc 'root)
     ;; no root
--- /project/elephant/cvsroot/elephant/src/elephant.lisp	2006/01/25 16:58:25	1.18
+++ /project/elephant/cvsroot/elephant/src/elephant.lisp	2006/01/29 04:57:20	1.18.2.1
@@ -113,6 +113,24 @@
 	   #:db-env-set-timeout #:db-env-get-timeout
 	   #:db-env-set-flags #:db-env-get-flags
 	   #:run-elephant-thread
+
+	   ;; Class indexing management API
+	   #:*default-indexed-class-synch-policy*
+	   #:find-class-index #:find-inverted-index
+	   #:enable-class-indexing #:disable-class-indexing
+	   #:add-class-slot-index #:remove-class-slot-index
+	   #:add-class-derived-index #:remove-class-derived-index
+	   #:describe-db-class-index
+
+	   ;; Low level cursor API
+	   #:make-inverted-cursor #:make-class-cursor
+	   #:with-inverted-cursor #:with-class-cursor
+
+	   ;; Instance query API
+	   #:get-instances-by-class 
+	   #:get-instances-by-value
+	   #:get-instances-by-range
+	   #:drop-instances
 	   )
   #+cmu  
   (:import-from :pcl
--- /project/elephant/cvsroot/elephant/src/metaclasses.lisp	2006/01/27 18:52:49	1.10.2.3
+++ /project/elephant/cvsroot/elephant/src/metaclasses.lisp	2006/01/29 04:57:20	1.10.2.4
@@ -104,8 +104,7 @@
 (defmethod persistent-slots ((class persistent-metaclass))
   (if (slot-boundp class '%persistent-slots)
       (car (%persistent-slots class))
-      nil)
-  (car (%persistent-slots class)))
+      nil))
 
 (defmethod persistent-slots ((class standard-class))
   nil)
@@ -166,8 +165,10 @@
   nil)
 (defmethod indexed-record ((class persistent-metaclass))
   (car (%indexed-slots class)))
+
 (defmethod old-indexed-record ((class persistent-metaclass))
   (cdr (%indexed-slots class)))
+
 (defmethod update-indexed-record ((class persistent-metaclass) new-slot-list)
   (let ((oldrec (if (slot-boundp class '%indexed-slots)
 		    (indexed-record class)



From ieslick at common-lisp.net  Sun Jan 29 04:57:21 2006
From: ieslick at common-lisp.net (ieslick)
Date: Sat, 28 Jan 2006 22:57:21 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20060129045721.744EF2A5BD@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory common-lisp:/tmp/cvs-serv15072/tests

Modified Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	elephant-tests.lisp 
Added Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	testindexing.lisp 
Log Message:
First pass complete indexing solution including basic tests.

--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2006/01/27 00:03:49	1.7.2.1
+++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2006/01/29 04:57:21	1.7.2.2
@@ -116,17 +116,30 @@
 (defvar *test-path-primary*
   *testdb-path*  
 )
+
 (defvar *test-path-secondary*
-  *testpg-path*
+  *testsqlite3-path*
 )
 
-
 (defun do-all-tests()
   (progn
     (do-all-tests-spec *testdb-path*)
-    (do-all-tests-spec *testpg-path*)
+    (do-all-tests-spec *testsqlite3-path*)
     ))
 
+(defun do-all-tests-spec(spec)
+  (when spec
+    (with-open-store (spec)
+      (let ((*auto-commit* nil))
+	(do-tests)))))
+
+(defun do-test-spec (testname &optional (spec *test-path-primary*))
+  "For easy interactive running of tests while debugging"
+  (when spec
+    (with-open-store (spec)
+      (let ((*auto-commit* nil))
+	(do-test testname)))))
+
 (defun do-crazy-pg-tests()
   (open-store *testpg-path*)
   (do-test 'indexed-btree-make)
@@ -149,13 +162,7 @@
       t
       )
     ))
-
-(defun do-all-tests-spec(spec)
-  (when spec
-    (with-open-store (spec)
-      (let ((*auto-commit* nil))
-	(do-tests)))))
-
+      
 (defun find-slot-def (class-name slot-name)
   (find-if #'(lambda (slot-def)
 	       (eq (slot-definition-name slot-def) slot-name))



From ieslick at common-lisp.net  Mon Jan 30 04:55:00 2006
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 29 Jan 2006 22:55:00 -0600 (CST)
Subject: [elephant-cvs] CVS elephant
Message-ID: <20060130045500.1C8502A3CF@common-lisp.net>

Update of /project/elephant/cvsroot/elephant
In directory common-lisp:/tmp/cvs-serv15325

Modified Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	elephant-tests.asd elephant.asd 
Log Message:

Significant rework of portions of the indexing.  Still chasing an odd test interaction
but all tests pass under (do-indexing-tests) but not under (do-all-tests).  Very odd.
This should constitute a first feature set release.  I will add tests incrementally
as I work with the system.


--- /project/elephant/cvsroot/elephant/elephant-tests.asd	2006/01/29 04:57:20	1.4.2.1
+++ /project/elephant/cvsroot/elephant/elephant-tests.asd	2006/01/30 04:54:59	1.4.2.2
@@ -58,8 +58,8 @@
 	     (:file "mop-tests")
 	     (:file "testcollections")
 	     (:file "testsleepycat")
-	     (:file "testmigration")
 	     (:file "testindexing")
+	     (:file "testmigration")
 	     )
 	    :serial t)))
  
--- /project/elephant/cvsroot/elephant/elephant.asd	2006/01/26 04:03:44	1.9.2.1
+++ /project/elephant/cvsroot/elephant/elephant.asd	2006/01/30 04:54:59	1.9.2.2
@@ -63,6 +63,7 @@
 	     (:file "controller")
 	     (:file "collections")
 	     (:file "serializer")
+	     (:file "index-utils")
 	     (:file "indexing"))
 	    #+openmcl
 	    (:file "openmcl-mop-patches")



From ieslick at common-lisp.net  Mon Jan 30 04:55:00 2006
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 29 Jan 2006 22:55:00 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/src
Message-ID: <20060130045500.755832A3CF@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv15325/src

Modified Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	IAN-TODO classes.lisp indexing.lisp metaclasses.lisp 
	sql-collections.lisp 
Log Message:

Significant rework of portions of the indexing.  Still chasing an odd test interaction
but all tests pass under (do-indexing-tests) but not under (do-all-tests).  Very odd.
This should constitute a first feature set release.  I will add tests incrementally
as I work with the system.


--- /project/elephant/cvsroot/elephant/src/classes.lisp	2006/01/29 04:57:20	1.16.2.4
+++ /project/elephant/cvsroot/elephant/src/classes.lisp	2006/01/30 04:55:00	1.16.2.5
@@ -79,6 +79,21 @@
 metaclass.")
   (:metaclass persistent-metaclass))
 
+(defmethod initialize-instance ((instance persistent-object) &rest initargs)
+  (declare (ignore initargs))
+  (if (indexed (class-of instance))
+      (progn
+	(inhibit-indexing (oid instance))
+	(unwind-protect
+	     (progn
+	       (call-next-method)
+	       (uninhibit-indexing (oid instance))
+	       (let ((class-index (find-class-index (class-of instance))))
+		 (with-transaction ()
+		   (setf (get-value (oid instance) class-index) instance))))
+	  (uninhibit-indexing (oid instance))))
+      (call-next-method)))
+
 (defmethod shared-initialize :around ((class persistent-metaclass) slot-names &rest args &key direct-superclasses)
   "Ensures we inherit from persistent-object."
   (let* ((persistent-metaclass (find-class 'persistent-metaclass))
@@ -139,14 +154,14 @@
       (make-instances-obsolete instance))))
 
 ;; #+allegro
-(defmethod finalize-inheritance :around ((class persistent-metaclass))
+(defmethod finalize-inheritance :around ((instance persistent-metaclass))
   (prog1
       (call-next-method)
-    (when (not (slot-boundp class '%persistent-slots))
-	(setf (%persistent-slots class) 
-	      (cons (persistent-slot-names class) nil)))
-    (when (not (slot-boundp class '%indexed-slots))
-      (update-indexed-record class (indexed-slot-names-from-defs class)))))
+    (when (not (slot-boundp instance '%persistent-slots))
+	(setf (%persistent-slots instance) 
+	      (cons (persistent-slot-names instance) nil)))
+    (when (not (slot-boundp instance '%indexed-slots))
+      (update-indexed-record instance (indexed-slot-names-from-defs instance)))))
 
 ;; #+(or cmu sbcl)
 ;; (defmethod finalize-inheritance :around ((instance persistent-metaclass))
@@ -156,8 +171,6 @@
 ;; 	(setf (%persistent-slots instance) 
 ;; 	      (cons (persistent-slot-names instance) nil)))))
 
-;; ISE: Not necessary for allegro 7.0?  Initial values are written twice when I traced (setf slot-value-using-class)
-#-allegro
 (defmethod shared-initialize :around ((instance persistent-object) slot-names &rest initargs &key &allow-other-keys)
   "Initializes the persistent slots via initargs or forms.
 This seems to be necessary because it is typical for
--- /project/elephant/cvsroot/elephant/src/metaclasses.lisp	2006/01/29 04:57:20	1.10.2.4
+++ /project/elephant/cvsroot/elephant/src/metaclasses.lisp	2006/01/30 04:55:00	1.10.2.5
@@ -154,12 +154,12 @@
 ;; This just encapsulates record keeping a bit
 (defclass indexing-record ()
   ((slots :accessor indexing-record-slots :initarg :slots :initform nil)
-   (derived-count :accessor indexing-record-derived-count :initarg :derived-count :initform 0)))
+   (derived-count :accessor indexing-record-derived :initarg :derived :initform 0)))
 
 (defmethod print-object ((obj indexing-record) stream)
   (format stream "#INDEXING-RECORD<islt: ~A dslt: ~A>" 
 	  (length (indexing-record-slots obj))
-	  (indexing-record-derived-count obj)))
+	  (length (indexing-record-derived obj))))
 
 (defmethod indexed-record ((class standard-class)) 
   nil)
@@ -176,7 +176,7 @@
     (setf (%indexed-slots class) 
 	  (cons (make-instance 'indexing-record 
 			       :slots new-slot-list
-			       :derived-count (if oldrec (indexing-record-derived-count oldrec) 0))
+			       :derived (when oldrec (indexing-record-derived oldrec)))
 		(if oldrec oldrec nil)))))
 
 (defun indexed-slot-names-from-defs (class)
@@ -193,10 +193,10 @@
   ;; update record
   (let ((record (indexed-record class)))
     (unless (member slot (car (%persistent-slots class)))
-      (error "Tried to index slot ~A which isn't a persistent slot" slot))
+      (error "Tried to register slot ~A as index which isn't a persistent slot" slot))
     (unless (member slot (indexing-record-slots record))
 ;;      This is a normal startup case, but during other cases we'd like
-;;      the duplicate wraning
+;;      the duplicate warning
 ;;      (warn "Tried to index slot ~A which is already indexed" slot))
       (push slot (indexing-record-slots record))))
   ;; change effective slot def
@@ -223,24 +223,35 @@
 (defmethod register-derived-index (class name)
   "Tell the class that it has derived indices defined against it
    and keep a reference count"
-  (declare (ignore name))
   (let ((record (indexed-record class)))
-    (incf (indexing-record-derived-count record))))
+    (push name (indexing-record-derived record))))
 
 (defmethod unregister-derived-index (class name)
-  (declare (ignore name))
   (let ((record (indexed-record class)))
-    (decf (indexing-record-derived-count record))
-    (assert (>= (indexing-record-derived-count record) 0))))
+    (setf (indexing-record-derived record) (remove name (indexing-record-derived record)))))
 
 (defmethod indexed ((class persistent-metaclass))
   (and (slot-boundp class '%indexed-slots )
        (or (indexing-record-slots (indexed-record class))
-	   (not (= (indexing-record-derived-count (indexed-record class)) 0)))))
+	   (indexing-record-derived (indexed-record class)))))
 
 (defmethod indexed ((slot standard-slot-definition)) nil)
 (defmethod indexed ((class standard-class)) nil)
 
+(defvar *inhibit-indexing-list* nil
+  "Use this to avoid updating an index inside
+   low-level functions that update groups of
+   slots at once.  We may need to rethink this
+   if we go to a cheaper form of update that
+   doesn't batch update all indices")
+
+(defun inhibit-indexing (uid)
+  (pushnew uid *inhibit-indexing-list*))
+
+(defun uninhibit-indexing (uid)
+  (setf *inhibit-indexing-list*
+	(delete uid *inhibit-indexing-list*)))
+
 ;;
 ;; Original support for persistent slot protocol
 ;;
--- /project/elephant/cvsroot/elephant/src/sql-collections.lisp	2005/11/23 17:51:37	1.2
+++ /project/elephant/cvsroot/elephant/src/sql-collections.lisp	2006/01/30 04:55:00	1.2.2.1
@@ -47,7 +47,6 @@
   (:metaclass persistent-metaclass)
   (:documentation "A SQL-based BTree supports secondary indices."))
 
-
 (defmethod get-value (key (bt sql-btree-index))
   "Get the value in the primary DB from a secondary key."
   (declare (optimize (speed 3)))



From ieslick at common-lisp.net  Mon Jan 30 04:55:00 2006
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 29 Jan 2006 22:55:00 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20060130045500.BFA712A3CF@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory common-lisp:/tmp/cvs-serv15325/tests

Modified Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	elephant-tests.lisp testcollections.lisp testindexing.lisp 
Log Message:

Significant rework of portions of the indexing.  Still chasing an odd test interaction
but all tests pass under (do-indexing-tests) but not under (do-all-tests).  Very odd.
This should constitute a first feature set release.  I will add tests incrementally
as I work with the system.


--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2006/01/29 04:57:21	1.7.2.2
+++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2006/01/30 04:55:00	1.7.2.3
@@ -133,13 +133,23 @@
       (let ((*auto-commit* nil))
 	(do-tests)))))
 
-(defun do-test-spec (testname &optional (spec *test-path-primary*))
+(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 ()
+  (setf *old-store* *store-controller*)
+  (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))
+  (close-store)
+  (setf *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/01/25 15:36:32	1.7
+++ /project/elephant/cvsroot/elephant/tests/testcollections.lisp	2006/01/30 04:55:00	1.7.2.1
@@ -204,6 +204,7 @@
 (deftest remove-kv-from-slot1
     (finishes (remove-kv 2 index1))
   t)
+
 (deftest no-key-nor-indices-slot1
     (values
      (get-value (second keys) indexed)
@@ -214,6 +215,7 @@
 (deftest remove-kv-from-slot2
     (finishes (remove-kv 300 index2))
   t)
+
 (deftest no-key-nor-indices-slot2
     (values
      (get-value (third keys) indexed)



From ieslick at common-lisp.net  Mon Jan 30 05:09:12 2006
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 29 Jan 2006 23:09:12 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/src
Message-ID: <20060130050912.CBE5B2A3CF@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv16833/src

Modified Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	indexing.lisp 
Added Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	index-utils.lisp 
Log Message:
Forgot to add a file of utilities for indexing...





From ieslick at common-lisp.net  Mon Jan 30 05:09:13 2006
From: ieslick at common-lisp.net (ieslick)
Date: Sun, 29 Jan 2006 23:09:13 -0600 (CST)
Subject: [elephant-cvs] CVS elephant/tests
Message-ID: <20060130050913.0ABA52A4A2@common-lisp.net>

Update of /project/elephant/cvsroot/elephant/tests
In directory common-lisp:/tmp/cvs-serv16833/tests

Modified Files:
      Tag: ELEPHANT-0-4-1-rc1-IAN
	testindexing.lisp 
Log Message:
Forgot to add a file of utilities for indexing...