Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv10228 Modified Files: base-test.lisp base.lisp Log Message: A few more com-re-search* related bug fixes. Date: Sun Aug 28 00:07:48 2005 Author: abakic Index: climacs/base-test.lisp diff -u climacs/base-test.lisp:1.15 climacs/base-test.lisp:1.16 --- climacs/base-test.lisp:1.15 Fri Aug 5 00:07:44 2005 +++ climacs/base-test.lisp Sun Aug 28 00:07:45 2005 @@ -1108,30 +1108,38 @@ (a1 (automaton::determinize (regexp-automaton (string-regexp "i[mac]+s")))) (a2 (automaton::determinize - (regexp-automaton (string-regexp "[^aeiou][aeiou]"))))) + (regexp-automaton (string-regexp "[^aeiou][aeiou]")))) + (a3 (regexp-automaton (string-regexp "imacs")))) (insert-buffer-sequence buffer 0 " climacs") - (values - (buffer-re-search-forward a1 buffer 0) - (buffer-re-search-forward a2 buffer 1) - (buffer-re-search-forward a1 buffer 4) - (buffer-re-search-forward a2 buffer 6))) - 3 2 nil nil) + (multiple-value-call + #'list + (buffer-re-search-forward a1 buffer 0) + (buffer-re-search-forward a2 buffer 1) + (buffer-re-search-forward a3 buffer 1) + (buffer-re-search-forward a1 buffer 4) + (buffer-re-search-forward a2 buffer 6) + (buffer-re-search-forward a3 buffer 6))) + (3 8 2 4 3 8 nil nil nil)) (defmultitest buffer-re-search-backward.test-1 (let ((buffer (make-instance %%buffer)) (a1 (climacs-base::reversed-deterministic-automaton (regexp-automaton (string-regexp "i[ma]+c")))) (a2 (climacs-base::reversed-deterministic-automaton - (regexp-automaton (string-regexp "[^aeiou][aeiou]"))))) + (regexp-automaton (string-regexp "[^aeiou][aeiou]")))) + (a3 (regexp-automaton (string-regexp "cami")))) (insert-buffer-sequence buffer 0 " climacs") - (values - (buffer-re-search-backward a1 buffer 7) - (buffer-re-search-backward a2 buffer 7) - (buffer-re-search-backward a1 buffer 5) - (buffer-re-search-backward a2 buffer 2))) - 3 4 nil nil) + (multiple-value-call + #'list + (buffer-re-search-backward a1 buffer 7) + (buffer-re-search-backward a2 buffer 7) + (buffer-re-search-backward a3 buffer 7) + (buffer-re-search-backward a1 buffer 5) + (buffer-re-search-backward a2 buffer 2) + (buffer-re-search-backward a3 buffer 5))) + (3 7 4 6 3 7 nil nil nil)) (defmultitest search-forward.test-1 (let ((buffer (make-instance %%buffer))) Index: climacs/base.lisp diff -u climacs/base.lisp:1.44 climacs/base.lisp:1.45 --- climacs/base.lisp:1.44 Sat Aug 27 22:29:08 2005 +++ climacs/base.lisp Sun Aug 28 00:07:45 2005 @@ -624,13 +624,14 @@ returns nil. If the first value is non-nil, the second value is the offset after the matched contents." (if (automaton::singleton a) - (let ((result (buffer-search-forward buffer offset (automaton::singleton a)))) + (let ((result (buffer-search-forward + buffer offset (automaton::singleton a)))) (when result (values result (+ result (length (automaton::singleton a)))))) (loop for i from offset below (size buffer) do (let ((j (non-greedy-match-forward a buffer i))) (when j (return (values i j)))) - finally (return nil)))) + finally (return nil)))) (defun reversed-deterministic-automaton (a) "Reverses and determinizes A, then returns it." @@ -659,13 +660,14 @@ otherwise, returns nil. If the first value is non-nil, the second value is the offset after the matched contents." (if (automaton::singleton a) - (let ((result (buffer-search-backward buffer offset - (nreverse (automaton::singleton a))))) - (values result result)) + (let ((result (buffer-search-backward + buffer offset (nreverse (automaton::singleton a))))) + (when result + (values result (+ result (length (automaton::singleton a)))))) (loop for i downfrom (min offset (1- (size buffer))) to 0 do (let ((j (non-greedy-match-backward a buffer i))) - (when j (return (values j i)))) - finally (return nil)))) + (when j (return (values j (1+ i))))) + finally (return nil)))) (defun search-forward (mark vector &key (test #'eql)) "move MARK forward after the first occurence of VECTOR after MARK" @@ -699,7 +701,7 @@ (automaton::regexp-automaton (automaton::string-regexp re))))) (multiple-value-bind (i j) - (buffer-re-search-backward a (buffer mark) (offset mark)) + (buffer-re-search-backward a (buffer mark) (1- (offset mark))) (declare (ignorable j)) (when i (setf (offset mark) i)))))