[elephant-devel] Start of 0.6.1 Beta Cycle

[Henrik Hjelte]

Great work.
It seems that one of my changes yesterday introduced a bug, so Ian fixed
that bug and my change disappeared in the process. It suits me right,
because I really should have made a testcase showing the bug before
fixing it. Better later than never though.

I modify the test indexing-basic in testindexing.lisp:
(get-instances-by-value 'idx-one 'slot1 nil) should return zero
instances, right? Now it returns three which is wrong.

I had to modify the map-index method in collections.lisp some more to
get this right without breaking other tests. Get-instances-by-value
calls collections with start equal to end, so I do a special check for
this, and that also makes it possible to use the cursor-pset function
instead of cursor-pset-range which could be a speedup at least in
theory.

/Henrik Hjelte

Changes:
{
hunk ./tests/testindexing.lisp 101
-               (length (get-instances-by-range 'idx-one 'slot1 n (+ 1
n))))
+               (length (get-instances-by-range 'idx-one 'slot1 n (+ 1
n)))
+                (length (get-instances-by-value 'idx-one 'slot1 nil)))
hunk ./tests/testindexing.lisp 104
-  3 2 1 t 3)
+  3 2 1 t 3 0)
hunk ./src/elephant/collections.lisp 377
-                          (next-range))))))
+                          (next-range)))))
+                 (same-start-and-end ()
+                   (when (and start-supplied-p end-supplied-p)
+                     (or (and (null start) (null end))
+                         (and start end (lisp-compare<= start end)
(lisp-compare<= end start))))))
hunk ./src/elephant/collections.lisp 384
-             (if (and start-supplied-p (not (null start)))
-                 (cursor-pset-range cur start)
-                 (cursor-pfirst cur))
+              (cond
+                ((same-start-and-end)
+                 (cursor-pset cur start))
+                ((and start-supplied-p (not (null start)))
+                 (cursor-pset-range cur start))
+                (t (cursor-pfirst cur)))
}

The whole new map-index method:

(defmethod map-index (fn (index btree-index) &rest args &key (start nil
start-supplied-p) (end nil end-supplied-p))
  "Like map-btree, but takes a function of three arguments key, value
and primary key
   if you want to get at the primary key value, otherwise use map-btree"
  (declare (dynamic-extent args)
	   (ignorable args))
  (let ((sc (get-con index)))
    (ensure-transaction (:store-controller sc)
      (with-btree-cursor (cur index)
	(labels ((next-range ()
		   (multiple-value-bind (exists? skey val pkey) (cursor-pnext-nodup
cur)
		     (if (and exists? 
			      (or (not end-supplied-p)
				  (null end)
				  (lisp-compare<= skey end)))
		       (progn
			 (funcall fn skey val pkey)
			 (next-in-range skey))
		       (return-from map-index nil))))
		 (next-in-range (key)
		   (multiple-value-bind (exists? skey val pkey) (cursor-pnext-dup cur)
		     (if exists?
			 (progn
			   (funcall fn skey val pkey)
			   (next-in-range key))
			 (progn
			   (cursor-pset-range cur key)
			   (next-range)))))
                 (same-start-and-end ()
                   (when (and start-supplied-p end-supplied-p)
                     (or (and (null start) (null end))
                         (and start end (lisp-compare<= start end)
(lisp-compare<= end start))))))
	  (declare (dynamic-extent next-range next-in-range))
	  (multiple-value-bind (exists? skey val pkey)
              (cond
                ((same-start-and-end)
                 (cursor-pset cur start))
                ((and start-supplied-p (not (null start)))
                 (cursor-pset-range cur start))
                (t (cursor-pfirst cur)))
	    (if (and exists? 
		     (or (not end-supplied-p)
			 (null end)
			 (lisp-compare<= skey end)))
		(progn
		  (funcall fn skey val pkey)
		  (next-in-range skey))
		nil)))))))