[climacs-cvs] CVS update: climacs/base-test.lisp climacs/base.lisp

[Aleksandar Bakic]

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)))))