* generic/regc_nfa.c: Fixed infinite loop in the regexp compiler.

        [Bug 1810038].

3 files changed, 50 insertions, 1 deletions

diff --git a/ChangeLog b/ChangeLog
index be66f21..3d3b73d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2007-11-15  Don Porter	<dgp@users.sourceforge.net>
 
+	* generic/regc_nfa.c:	Fixed infinite loop in the regexp compiler.
+	[Bug 1810038].
+
 	* generic/regc_nfa.c:	Corrected looping logic in fixempties() to
 	avoid wasting time walking a list of dead states. [Bug 1832612]
 
diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c
index c5d7bc9..741887f 100644
--- a/generic/regc_nfa.c
+++ b/generic/regc_nfa.c
@@ -859,6 +859,25 @@ pull(
     }
 
     /*
+     * DGP 2007-11-15: Cloning a state with a circular constraint on its list
+     * of outs can lead to trouble [Bug 1810038], so get rid of them first.
+     */
+
+    for (a = from->outs; a != NULL; a = nexta) {
+	nexta = a->outchain;
+	switch (a->type) {
+	case '^':
+	case '$':
+	case BEHIND:
+	case AHEAD:
+	    if (from == a->to) {
+		freearc(nfa, a);
+	    }
+	    break;
+	}
+    }
+
+    /*
      * First, clone from state if necessary to avoid other outarcs.
      */
 
@@ -997,6 +1016,28 @@ push(
     }
 
     /*
+     * DGP 2007-11-15: Here we duplicate the same protections as appear
+     * in pull() above to avoid troubles with cloning a state with a
+     * circular constraint on its list of ins.  It is not clear whether
+     * this is necessary, or is protecting against a "can't happen".
+     * Any test case that actually leads to a freearc() call here would
+     * be a welcome addition to the test suite.
+     */
+
+    for (a = to->ins; a != NULL; a = nexta) {
+	nexta = a->inchain;
+	switch (a->type) {
+	case '^':
+	case '$':
+	case BEHIND:
+	case AHEAD:
+	    if (a->from == to) {
+		freearc(nfa, a);
+	    }
+	    break;
+	}
+    }
+    /*
      * First, clone to state if necessary to avoid other inarcs.
      */
 
diff --git a/tests/regexp.test b/tests/regexp.test
index 03efa04..d0413c8 100644
--- a/tests/regexp.test
+++ b/tests/regexp.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: regexp.test,v 1.27 2005/05/10 18:35:23 kennykb Exp $
+# RCS: @(#) $Id: regexp.test,v 1.28 2007/11/15 21:38:50 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -655,6 +655,11 @@ test regexp-21.13 {multiple matches handle newlines} {
 } {{0 -1} {2 1} {4 3}}
 
 
+test regexp-22.1 {Bug 1810038} {
+    regexp ($|^X)* {}
+} 1
+
+
 # cleanup
 ::tcltest::cleanupTests
 return