Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv6500 Modified Files: flexicursor.lisp rtester.lisp Log Message: Fixed a bug where (setf cursor-pos) did not modify the skiplist. Used the new version of (setf cursor-pos) to make move> and move< much shorter than before. Fixed a problem in the new random tester where the name of the function to be applied was not recorded correctly. Date: Thu Sep 2 08:23:50 2004 Author: rstrandh Index: gsharp/Flexichain/flexicursor.lisp diff -u gsharp/Flexichain/flexicursor.lisp:1.6 gsharp/Flexichain/flexicursor.lisp:1.7 --- gsharp/Flexichain/flexicursor.lisp:1.6 Wed Sep 1 07:55:11 2004 +++ gsharp/Flexichain/flexicursor.lisp Thu Sep 2 08:23:50 2004 @@ -171,7 +171,12 @@ (assert (<= 0 position (nb-elements (chain cursor))) () 'flexi-position-error :chain (chain cursor) :position position) (with-slots (chain index) cursor - (setf index (position-index chain (1- position))))) + (with-slots (cursors) chain + (setf (skiplist-find cursors index) + (delete cursor (skiplist-find cursors index) + :key #'wp-value :test #'eq)) + (setf index (position-index chain (1- position))) + (push (make-wp cursor) (skiplist-find cursors index))))) (defmethod cursor-pos ((cursor right-sticky-flexicursor)) (index-position (chain cursor) (slot-value cursor 'index))) @@ -180,7 +185,12 @@ (assert (<= 0 position (nb-elements (chain cursor))) () 'flexi-position-error :chain (chain cursor) :position position) (with-slots (chain index) cursor - (setf index (position-index chain position)))) + (with-slots (cursors) chain + (setf (skiplist-find cursors index) + (delete cursor (skiplist-find cursors index) + :key #'wp-value :test #'eq)) + (setf index (position-index chain position)) + (push (make-wp cursor) (skiplist-find cursors index))))) (defmethod at-beginning-p ((cursor standard-flexicursor)) (zerop (cursor-pos cursor))) @@ -189,32 +199,10 @@ (= (cursor-pos cursor) (nb-elements (chain cursor)))) (defmethod move> ((cursor standard-flexicursor) &optional (n 1)) - (cond ((minusp n) (move< cursor (- n))) - ((zerop n) nil) - (t (let ((cursor-pos (cursor-pos cursor))) - (assert (<= (+ n cursor-pos) (nb-elements (chain cursor))) () - 'at-end-error :cursor cursor) - (with-slots (cursors) (chain cursor) - (with-slots (index) cursor - (setf (skiplist-find cursors index) - (delete cursor (skiplist-find cursors index) - :key #'wp-value :test #'eq)) - (setf (cursor-pos cursor) (+ cursor-pos n)) - (push (make-wp cursor) (skiplist-find cursors index)))))))) + (incf (cursor-pos cursor) n)) (defmethod move< ((cursor standard-flexicursor) &optional (n 1)) - (cond ((minusp n) (move> cursor (- n))) - ((zerop n) nil) - (t (let ((cursor-pos (cursor-pos cursor))) - (assert (>= cursor-pos n) () - 'at-beginning-error :cursor cursor) - (with-slots (cursors) (chain cursor) - (with-slots (index) cursor - (setf (skiplist-find cursors index) - (delete cursor (skiplist-find cursors index) - :key #'wp-value :test #'eq)) - (setf (cursor-pos cursor) (- cursor-pos n)) - (push (make-wp cursor) (skiplist-find cursors index)))))))) + (decf (cursor-pos cursor) n)) (defmethod insert ((cursor standard-flexicursor) object) (insert* (chain cursor) (cursor-pos cursor) object)) Index: gsharp/Flexichain/rtester.lisp diff -u gsharp/Flexichain/rtester.lisp:1.1 gsharp/Flexichain/rtester.lisp:1.2 --- gsharp/Flexichain/rtester.lisp:1.1 Wed Sep 1 07:55:11 2004 +++ gsharp/Flexichain/rtester.lisp Thu Sep 2 08:23:50 2004 @@ -80,7 +80,7 @@ (unless pos (setf pos (random (flexichain:nb-elements *fc-real*)) elem (random 1000000))) - (add-inst `(setf element* ,pos ,elem)) + (add-inst `(se* ,pos ,elem)) (setf (flexichain:element* *fc-real* pos) elem) (setf (stupid:element* *fc-fake* pos) elem))) @@ -182,6 +182,7 @@ (randomcase (m<) (m>))) (defun test-step () + (compare) (when (zerop (random 200)) (setf *ins-del-state* (not *ins-del-state*))) (randomcase (i-or-d) (setel) (mc) (cc) (scp) (mov))) @@ -195,6 +196,7 @@ (setf *fc-fake* (make-instance 'stupid:standard-cursorchain))) (defun tester () + (reset-all) (mlc) (mrc) (loop repeat 100000