[rucksack-cvs] CVS rucksack

[alemmens]

Update of /project/rucksack/cvsroot/rucksack
In directory clnet:/tmp/cvs-serv2005

Modified Files:
	done.txt objects.lisp package.lisp rucksack.asd 
Log Message:
Version 0.1.13:

Add Brad Beveridge's basic unit test suite (modified to work
with lisp-unit instead of 5am).

Add Chris Riesbeck's lisp-unit library to help with creating unit test suites.

--- /project/rucksack/cvsroot/rucksack/done.txt	2008/01/22 17:02:07	1.13
+++ /project/rucksack/cvsroot/rucksack/done.txt	2008/01/23 15:43:42	1.14
@@ -1,3 +1,18 @@
+* 2008-01-23 - version 0.1.13
+
+- Add Brad Beveridge's basic unit test suite (modified to work
+  with lisp-unit instead of 5am).
+
+- Add Chris Riesbeck's lisp-unit library to help with creating
+  unit test suites.
+
+- Move all tests to their own directory.
+
+- Add P-NREVERSE and P-POSITION for persistent lists.
+
+- Fix bugs in P-REPLACE and P-MAPCAR.
+
+
 * 2008-01-22 - version 0.1.12
 
 - Use (ARRAY-DIMENSION buffer 0) instead of LENGTH in
@@ -5,8 +20,6 @@
   here.  Thanks to Sean Ross.
 
 
-
-
 * 2008-01-22 - version 0.1.11
 
 - Fix bug caused by LEAF-DELETE-KEY.  Reported and fixed by
--- /project/rucksack/cvsroot/rucksack/objects.lisp	2007/01/20 18:17:55	1.18
+++ /project/rucksack/cvsroot/rucksack/objects.lisp	2008/01/23 15:43:42	1.19
@@ -1,4 +1,4 @@
-;; $Id: objects.lisp,v 1.18 2007/01/20 18:17:55 alemmens Exp $
+;; $Id: objects.lisp,v 1.19 2008/01/23 15:43:42 alemmens Exp $
 
 (in-package :rucksack)
 
@@ -119,7 +119,8 @@
 (defmethod persistent-data-write (function (data persistent-data) value
                                            &rest args)
   (apply function value (contents data) args)
-  (cache-touch-object data (cache data)))
+  (cache-touch-object data (cache data))
+  value)
 
 (defun make-persistent-data (class contents
                                    &optional (rucksack (current-rucksack)))
@@ -231,7 +232,7 @@
           (setq result (p-cons (funcall function (p-car list))
                                result)
                 list (p-cdr list)))
-    result))
+    (p-nreverse result)))
 
 (defun p-mapc (function list)
   ;; DO: Accept more than one list argument.
@@ -247,7 +248,7 @@
     (loop while list do
           (setq result (p-cons (funcall function list) result)
                 list (p-cdr list)))
-    result))
+    (p-nreverse result)))
 
 (defun p-mapl (function list)
   ;; DO: Accept more than one list argument.
@@ -333,6 +334,25 @@
   ;; Return nil if not found
   nil)
 
+
+(defmethod p-position (value (list persistent-cons)
+                             &key (key #'identity) (test #'p-eql)
+                             (start 0) (end nil))
+  ;; Move list to start position.
+  (loop repeat start
+        do (setq list (p-cdr list)))
+  ;; The real work.
+  (loop for i from start do
+        (if (or (p-endp list) (and end (= i end)))
+            (return-from p-position nil)
+          (let ((elt (funcall key (p-car list))))
+            (if (funcall test value elt)
+                (return-from p-position i)
+              (setq list (p-cdr list))))))
+  ;; Return nil if not found.
+  nil)
+
+
 (defmethod p-replace ((vector-1 persistent-array)
                       (vector-2 persistent-array)
                       &key (start1 0) end1 (start2 0) end2)
@@ -385,6 +405,23 @@
   list)
 
 
+(defmethod p-nreverse ((object (eql nil)))
+  nil)
+
+(defmethod p-nreverse ((object persistent-cons))
+  (let* ((previous object)
+         (current (p-cdr previous)))
+    (setf (p-cdr previous) '())
+    (loop until (p-endp current)
+          do (let ((next (p-cdr current)))
+               (setf (p-cdr current) previous
+                     previous current
+                     current next)))
+    previous))
+
+;; DO: Implement P-NREVERSE for persistent vectors.
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Full fledged persistent objects
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--- /project/rucksack/cvsroot/rucksack/package.lisp	2007/01/20 18:17:55	1.11
+++ /project/rucksack/cvsroot/rucksack/package.lisp	2008/01/23 15:43:42	1.12
@@ -1,4 +1,4 @@
-;; $Id: package.lisp,v 1.11 2007/01/20 18:17:55 alemmens Exp $
+;; $Id: package.lisp,v 1.12 2008/01/23 15:43:42 alemmens Exp $
 
 #-(or allegro lispworks sbcl openmcl)
   (error "Unsupported implementation: ~A" (lisp-implementation-type))
@@ -97,15 +97,6 @@
    ;; Conditions
    #:btree-error #:btree-search-error #:btree-insertion-error
    #:btree-key-already-present-error #:btree-type-error
-   #:btree-error-btree #:btree-error-key #:btree-error-value
-))
+   #:btree-error-btree #:btree-error-key #:btree-error-value))
 
 
-
-(defpackage :rucksack-test
-  (:nicknames :rs-test)
-  (:use :common-lisp :rucksack))
-
-(defpackage :rucksack-test-schema-update
-  (:nicknames :rs-tsu)
-  (:use :common-lisp :rucksack))
\ No newline at end of file
--- /project/rucksack/cvsroot/rucksack/rucksack.asd	2008/01/22 17:02:07	1.14
+++ /project/rucksack/cvsroot/rucksack/rucksack.asd	2008/01/23 15:43:42	1.15
@@ -1,9 +1,9 @@
-;;; $Id: rucksack.asd,v 1.14 2008/01/22 17:02:07 alemmens Exp $
+;;; $Id: rucksack.asd,v 1.15 2008/01/23 15:43:42 alemmens Exp $
 
 (in-package :cl-user)
 
 (asdf:defsystem :rucksack
-  :version "0.1.12"
+  :version "0.1.13"
   :serial t
   :components ((:file "queue")
                (:file "package")
@@ -20,4 +20,5 @@
                (:file "index")
                (:file "rucksack")
                (:file "transactions")
-               (:file "test")))
+               (:file "import-export")))
+