>From dee52f34a68a37aab0f9613b29ac81951f79e82f Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Wed, 18 Jul 2012 20:26:27 +0200
Subject: [PATCH 1/4] Fix hang in irregex-fold caused by patterns matching the
 empty string (upstream changeset ba70feace1dd)

---
 irregex-core.scm       |   28 ++++++++++++++++++----------
 tests/test-irregex.scm |    5 +++++
 2 files changed, 23 insertions(+), 10 deletions(-)

diff --git a/irregex-core.scm b/irregex-core.scm
index 982f57e..54413bf 100644
--- a/irregex-core.scm
+++ b/irregex-core.scm
@@ -1485,7 +1485,7 @@
            (map (lambda (_)
                   `(/ ,(integer->char #x80) ,(integer->char #xFF)))
                 (zero-to (+ i lo-len))))))
-       (zero-to (- (length hi-ls) lo-len 1)))
+       (zero-to (- (length hi-ls) (+ lo-len 1))))
       (list
        (sre-sequence
         (cons `(/ ,(integer->char
@@ -3752,10 +3752,13 @@
                     matches)))
             (if (not m)
                 (finish i acc)
-                (let* ((end (%irregex-match-end-index m 0))
-                       (acc (kons i m acc)))
-                  (irregex-reset-matches! matches)
-                  (lp end acc))))))))
+                (let ((end (%irregex-match-end-index m 0)))
+                  (if (= end i)
+                      ;; skip one char forward if we match the empty string
+                      (lp (+ end 1) acc)
+                      (let ((acc (kons i m acc)))
+                        (irregex-reset-matches! matches)
+                        (lp end acc))))))))))
 
 (define (irregex-fold irx kons . args)
   (if (not (procedure? kons)) (%irregex-error 'irregex-fold "not a procedure" kons))
@@ -3777,11 +3780,16 @@
           (let ((m (irregex-search/matches irx cnk start i matches)))
             (if (not m)
                 (finish start i acc)
-                (let* ((acc (kons start i m acc))
-                       (end-src (%irregex-match-end-chunk m 0))
-                       (end-index (%irregex-match-end-index m 0)))
-                  (irregex-reset-matches! matches)
-                  (lp end-src end-index acc))))))))
+                (let ((end-src (%irregex-match-end-chunk m 0))
+                      (end-index (%irregex-match-end-index m 0)))
+                  (if (and (eq? end-src start) (= end-index i))
+                      (if (>= end-index ((chunker-get-end cnk) end-src ))
+                          (let ((next ((chunker-get-next cnk) end-src)))
+                            (lp next ((chunker-get-start cnk) next) acc))
+                          (lp end-src (+ end-index 1) acc))
+                      (let ((acc (kons start i m acc)))
+                        (irregex-reset-matches! matches)
+                        (lp end-src end-index acc))))))))))
 
 (define (irregex-fold/chunked irx kons . args)
   (if (not (procedure? kons)) (%irregex-error 'irregex-fold/chunked "not a procedure" kons))
diff --git a/tests/test-irregex.scm b/tests/test-irregex.scm
index a06bc6b..11bf225 100644
--- a/tests/test-irregex.scm
+++ b/tests/test-irregex.scm
@@ -358,6 +358,11 @@
        rope-chunker
        (rope "address@hidden and address@hidden")
        (lambda (src i s) (reverse s))))
+  (test-equal '("poo poo ")
+      (irregex-fold '(* "poo ")
+                    (lambda (i m s) (cons (irregex-match-substring m) s))
+                    '()
+                    "poo poo platter"))
   )
 
 
-- 
1.7.9.1