2010-02-09  Mo DeJong  <mdejong@users.sourceforge.net>

        Tcl Bug 2826551 regexp bugs related to
        -all -line and -start and newlines

	* generic/tclCmdMZ.c (Tcl_RegexpObjCmd):
        If -offset is given, treat it as the start
        of the line if the previous character was
        a newline. Fix nasty edge case where a zero
        length match would not advance the index.
        * tests/regexp.test: Add regression tests back
        ported from Jacl. Checks for a number of issues
        related to -line and newline handling. A few
        of tests were broken before the patch and
        continue to be broken, marked as knownBug.

Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.198
diff -u -r1.198 tclCmdMZ.c
--- generic/tclCmdMZ.c	25 Dec 2009 22:45:05 -0000	1.198
+++ generic/tclCmdMZ.c	9 Feb 2010 11:14:20 -0000
@@ -108,7 +108,7 @@
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int i, indices, match, about, offset, all, doinline, numMatchesSaved;
-    int cflags, eflags, stringLength;
+    int cflags, eflags, stringLength, matchLength;
     Tcl_RegExp regExpr;
     Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL;
     Tcl_RegExpInfo info;
@@ -250,15 +250,6 @@
 	return TCL_ERROR;
     }
 
-    if (offset > 0) {
-	/*
-	 * Add flag if using offset (string is part of a larger string), so
-	 * that "^" won't match.
-	 */
-
-	eflags |= TCL_REG_NOTBOL;
-    }
-
     objc -= 2;
     objv += 2;
 
@@ -286,11 +277,25 @@
      */
 
     while (1) {
+        /*
+         * Pass either 0 or TCL_REG_NOTBOL in the eflags. Passing 
+         * TCL_REG_NOTBOL indicates that the character at offset
+         * should not be considered the start of the line. If
+         * for example the pattern {^} is passed and -start is positive,
+         * then the pattern will not match the start of the string
+         * unless the previous character is a newline.
+         */
+
+        if ((offset == 0) ||
+            ((offset > 0) &&
+                (Tcl_GetUniChar(objPtr,offset-1) == (Tcl_UniChar)'\n'))) {
+	    eflags = 0;
+        } else {
+	    eflags = TCL_REG_NOTBOL;
+        }
+
 	match = Tcl_RegExpExecObj(interp, regExpr, objPtr,
-		offset /* offset */, numMatchesSaved, eflags
-		| ((offset > 0 &&
-		(Tcl_GetUniChar(objPtr,offset-1) != (Tcl_UniChar)'\n'))
-		? TCL_REG_NOTBOL : 0));
+		offset, numMatchesSaved, eflags);
 
 	if (match < 0) {
 	    return TCL_ERROR;
@@ -408,12 +413,19 @@
 	 * offset never changes).
 	 */
 
-	if (info.matches[0].end == 0) {
+	matchLength = (info.matches[0].end - info.matches[0].start);
+
+	offset += info.matches[0].end;
+
+        /*
+         * A match of length zero could happen for {^} {$} or {.*}
+         * and in these cases we always want to bump the index up one.
+         */
+
+	if (matchLength == 0) {
 	    offset++;
 	}
-	offset += info.matches[0].end;
 	all++;
-	eflags |= TCL_REG_NOTBOL;
 	if (offset >= stringLength) {
 	    break;
 	}
Index: tests/regexp.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/regexp.test,v
retrieving revision 1.34
diff -u -r1.34 regexp.test
--- tests/regexp.test	21 Sep 2009 21:30:41 -0000	1.34
+++ tests/regexp.test	9 Feb 2010 11:14:21 -0000
@@ -311,12 +311,39 @@
 test regexp-7.18 {basic regsub replacement} {
     list [regsub a+ aaa {&} foo] $foo
 } {1 aaa}
-test regexp-7.19 {basic regsub backslash replacement} {
+test regexp-7.19 {basic regsub replacement} {
+    list [regsub a+ aaa {\&} foo] $foo
+} {1 &}
+test regexp-7.20 {basic regsub replacement} {
+    list [regsub a+ aaa {\\&} foo] $foo
+} {1 {\aaa}}
+test regexp-7.21 {basic regsub replacement} {
+    list [regsub a+ aaa {\\\&} foo] $foo
+} {1 {\&}}
+test regexp-7.22 {basic regsub replacement} {
     list [regsub a+ aaa {\0} foo] $foo
 } {1 aaa}
-test regexp-7.20 {basic regsub backslash replacement} {
+test regexp-7.23 {basic regsub replacement} {
+    list [regsub a+ aaa {\\0} foo] $foo
+} {1 {\0}}
+test regexp-7.24 {basic regsub replacement} {
     list [regsub a+ aaa {\\\0} foo] $foo
 } {1 {\aaa}}
+test regexp-7.25 {basic regsub replacement} {
+    list [regsub a+ aaa {\\\\0} foo] $foo
+} {1 {\\0}}
+test regexp-7.26 {dollar zero is not a backslash replacement} {
+    list [regsub a+ aaa {$0} foo] $foo
+} {1 {$0}}
+test regexp-7.27 {dollar zero is not a backslash replacement} {
+    list [regsub a+ aaa {\0$0} foo] $foo
+} {1 {aaa$0}}
+test regexp-7.28 {dollar zero is not a backslash replacement} {
+    list [regsub a+ aaa {\$0} foo] $foo
+} {1 {\$0}}
+test regexp-7.29 {dollar zero is not a backslash replacement} {
+    list [regsub a+ aaa {\\} foo] $foo
+} {1 \\}
 
 test regexp-8.1 {case conversion in regsub} {
     list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
@@ -700,6 +727,337 @@
     regexp -- {([bc])\1} bb
 } 1
 
+test regexp-23.1 {regexp -all and -line} {
+    set string ""
+    list \
+        [regexp -all -inline -indices -line -- {^} $string] \
+        [regexp -all -inline -indices -line -- {^$} $string] \
+        [regexp -all -inline -indices -line -- {$} $string]
+} [list \
+    [list {0 -1}] \
+    [list {0 -1}] \
+    [list {0 -1}] \
+  ]
+
+test regexp-23.2 {regexp -all and -line} {
+    set string "\n"
+    list \
+        [regexp -all -inline -indices -line -- {^} $string] \
+        [regexp -all -inline -indices -line -- {^$} $string] \
+        [regexp -all -inline -indices -line -- {$} $string]
+} [list \
+    [list {0 -1}] \
+    [list {0 -1}] \
+    [list {0 -1}] \
+  ]
+
+test regexp-23.3 {regexp -all and -line} {
+    set string "\n\n"
+    list \
+        [regexp -all -inline -indices -line -- {^} $string] \
+        [regexp -all -inline -indices -line -- {^$} $string] \
+        [regexp -all -inline -indices -line -- {$} $string]
+} [list \
+    [list {0 -1} {1 0}] \
+    [list {0 -1} {1 0}] \
+    [list {0 -1} {1 0}] \
+  ]
+
+test regexp-23.4 {regexp -all and -line} {
+    set string "a"
+    list \
+        [regexp -all -inline -indices -line -- {^} $string] \
+        [regexp -all -inline -indices -line -- {^.*$} $string] \
+        [regexp -all -inline -indices -line -- {$} $string]
+} [list \
+    [list {0 -1}] \
+    [list {0 0}] \
+    [list {1 0}] \
+  ]
+
+test regexp-23.5 {regexp -all and -line} {knownBug} {
+    set string "a\n"
+    list \
+        [regexp -all -inline -indices -line -- {^} $string] \
+        [regexp -all -inline -indices -line -- {^.*$} $string] \
+        [regexp -all -inline -indices -line -- {$} $string]
+} [list \
+    [list {0 -1} {2 1}] \
+    [list {0 0} {2 1}] \
+    [list {1 0} {2 1}] \
+  ]
+
+test regexp-23.6 {regexp -all and -line} {
+    set string "\na"
+    list \
+        [regexp -all -inline -indices -line -- {^} $string] \
+        [regexp -all -inline -indices -line -- {^.*$} $string] \
+        [regexp -all -inline -indices -line -- {$} $string]
+} [list \
+    [list {0 -1} {1 0}] \
+    [list {0 -1} {1 1}] \
+    [list {0 -1} {2 1}] \
+  ]
+
+test regexp-23.7 {regexp -all and -line} {knownBug} {
+    set string "ab\n"
+    list \
+        [regexp -all -inline -indices -line -- {^} $string] \
+        [regexp -all -inline -indices -line -- {^.*$} $string] \
+        [regexp -all -inline -indices -line -- {$} $string]
+} [list \
+    [list {0 -1} {3 2}] \
+    [list {0 1} {3 2}] \
+    [list {2 1} {3 2}] \
+  ]
+
+test regexp-23.8 {regexp -all and -line} {
+    set string "a\nb"
+    list \
+        [regexp -all -inline -indices -line -- {^} $string] \
+        [regexp -all -inline -indices -line -- {^.*$} $string] \
+        [regexp -all -inline -indices -line -- {$} $string]
+} [list \
+    [list {0 -1} {2 1}] \
+    [list {0 0} {2 2}] \
+    [list {1 0} {3 2}] \
+  ]
+
+test regexp-23.9 {regexp -all and -line} {knownBug} {
+    set string "a\nb\n"
+    list \
+        [regexp -all -inline -indices -line -- {^} $string] \
+        [regexp -all -inline -indices -line -- {^.*$} $string] \
+        [regexp -all -inline -indices -line -- {$} $string]
+} [list \
+    [list {0 -1} {2 1} {4 3}] \
+    [list {0 0} {2 2} {4 3}] \
+    [list {1 0} {3 2} {4 3}] \
+  ]
+
+test regexp-23.10 {regexp -all and -line} {
+    set string "a\nb\nc"
+    list \
+        [regexp -all -inline -indices -line -- {^} $string] \
+        [regexp -all -inline -indices -line -- {^.*$} $string] \
+        [regexp -all -inline -indices -line -- {$} $string]
+} [list \
+    [list {0 -1} {2 1} {4 3}] \
+    [list {0 0} {2 2} {4 4}] \
+    [list {1 0} {3 2} {5 4}] \
+  ]
+
+test regexp-23.11 {regexp -all and -line} {
+    regexp -all -inline -indices -line -- {b} "abb\nb"
+} {{1 1} {2 2} {4 4}}
+
+
+test regexp-24.1 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string ""
+    list \
+        [regsub -line -all {^} $string {<&>} v1] $v1 \
+        [regsub -line -all {^$} $string {<&>} v2] $v2 \
+        [regsub -line -all {$} $string {<&>} v3] $v3
+} {1 <> 1 <> 1 <>}
+
+test regexp-24.2 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "\n"
+    list \
+        [regsub -line -all {^} $string {<&>} v1] $v1 \
+        [regsub -line -all {^$} $string {<&>} v2] $v2 \
+        [regsub -line -all {$} $string {<&>} v3] $v3
+} [list 2 "<>\n<>" 2 "<>\n<>" 2 "<>\n<>"]
+
+test regexp-24.3 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "\n\n"
+    list \
+        [regsub -line -all {^} $string {<&>} v1] $v1 \
+        [regsub -line -all {^$} $string {<&>} v2] $v2 \
+        [regsub -line -all {$} $string {<&>} v3] $v3
+} [list 3 "<>\n<>\n<>" 3 "<>\n<>\n<>" 3 "<>\n<>\n<>"]
+
+test regexp-24.4 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "a"
+    list \
+        [regsub -line -all {^} $string {<&>} v1] $v1 \
+        [regsub -line -all {^.*$} $string {<&>} v2] $v2 \
+        [regsub -line -all {$} $string {<&>} v3] $v3
+} [list 1 "<>a" 1 "<a>" 1 "a<>"]
+
+test regexp-24.5 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "a\n"
+    list \
+        [regsub -line -all {^} $string {<&>} v1] $v1 \
+        [regsub -line -all {^.*$} $string {<&>} v2] $v2 \
+        [regsub -line -all {$} $string {<&>} v3] $v3
+} [list 2 "<>a\n<>" 2 "<a>\n<>" 2 "a<>\n<>"]
+
+test regexp-24.6 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "\na"
+    list \
+        [regsub -line -all {^} $string {<&>} v1] $v1 \
+        [regsub -line -all {^.*$} $string {<&>} v2] $v2 \
+        [regsub -line -all {$} $string {<&>} v3] $v3
+} [list 2 "<>\n<>a" 2 "<>\n<a>" 2 "<>\na<>"]
+
+test regexp-24.7 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "ab\n"
+    list \
+        [regsub -line -all {^} $string {<&>} v1] $v1 \
+        [regsub -line -all {^.*$} $string {<&>} v2] $v2 \
+        [regsub -line -all {$} $string {<&>} v3] $v3
+} [list 2 "<>ab\n<>" 2 "<ab>\n<>" 2 "ab<>\n<>"]
+
+test regexp-24.8 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "a\nb"
+    list \
+        [regsub -line -all {^} $string {<&>} v1] $v1 \
+        [regsub -line -all {^.*$} $string {<&>} v2] $v2 \
+        [regsub -line -all {$} $string {<&>} v3] $v3
+} [list 2 "<>a\n<>b" 2 "<a>\n<b>" 2 "a<>\nb<>"]
+
+test regexp-24.9 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "a\nb\n"
+    list \
+        [regsub -line -all {^} $string {<&>} v1] $v1 \
+        [regsub -line -all {^.*$} $string {<&>} v2] $v2 \
+        [regsub -line -all {$} $string {<&>} v3] $v3
+} [list 3 "<>a\n<>b\n<>" 3 "<a>\n<b>\n<>" 3 "a<>\nb<>\n<>"]
+
+test regexp-24.10 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "a\nb\nc"
+    list \
+        [regsub -line -all {^} $string {<&>} v1] $v1 \
+        [regsub -line -all {^.*$} $string {<&>} v2] $v2 \
+        [regsub -line -all {$} $string {<&>} v3] $v3
+} [list 3 "<>a\n<>b\n<>c" 3 "<a>\n<b>\n<c>" 3 "a<>\nb<>\nc<>"]
+
+test regexp-24.11 {regsub -all and -line} {
+    regsub -line -all {b} "abb\nb" {<&>}
+} "a<b><b>\n<b>"
+
+
+test regexp-25.1 {regexp without -line option} {
+    set foo ""
+    list [regexp {a.*b} "dabc\naxyb\n" foo] $foo
+} [list 1 abc\naxyb]
+
+test regexp-25.2 {regexp without -line option} {
+    set foo ""
+    list [regexp {^a.*b$} "dabc\naxyb\n" foo] $foo
+} {0 {}}
+
+test regexp-25.3 {regexp with -line option} {
+    set foo ""
+    list [regexp -line {^a.*b$} "dabc\naxyb\n" foo] $foo
+} {1 axyb}
+
+test regexp-25.4 {regexp with -line option} {
+    set foo ""
+    list [regexp -line {^a.*b$} "dabc\naxyb\nxb" foo] $foo
+} {1 axyb}
+
+test regexp-25.5 {regexp without -line option} {
+    set foo ""
+    list [regexp {^a.*b$} "dabc\naxyb\nxb" foo] $foo
+} {0 {}}
+
+test regexp-25.6 {regexp without -line option} {
+    set foo ""
+    list [regexp {a.*b$} "dabc\naxyb\nxb" foo] $foo
+} "1 {abc\naxyb\nxb}"
+
+test regexp-25.7 {regexp with -lineanchor option} {
+    set foo ""
+    list [regexp -lineanchor {^a.*b$} "dabc\naxyb\nxb" foo] $foo
+} "1 {axyb\nxb}"
+
+test regexp-25.8 {regexp with -lineanchor and -linestop option} {
+    set foo ""
+    list [regexp -lineanchor -linestop {^a.*b$} "dabc\naxyb\nxb" foo] $foo
+} {1 axyb}
+
+test regexp-25.9 {regexp with -linestop option} {
+    set foo ""
+    list [regexp -linestop {a.*b} "ab\naxyb\nxb" foo] $foo
+} {1 ab}
+
+test regexp-26.1 {matches start of line 1 time} {
+    regexp -all -inline -- {^a+} "aab\naaa"
+} {aa}
+
+test regexp-26.2 {matches start of line(s) 2 times} {
+    regexp -all -inline -line -- {^a+} "aab\naaa"
+} {aa aaa}
+
+test regexp-26.3 {effect of -line -all and -start} {
+    list \
+    [regexp -all -inline -line -start 0 -- {^a+} "aab\naaa"] \
+    [regexp -all -inline -line -start 1 -- {^a+} "aab\naaa"] \
+    [regexp -all -inline -line -start 3 -- {^a+} "aab\naaa"] \
+    [regexp -all -inline -line -start 4 -- {^a+} "aab\naaa"] \
+} {{aa aaa} aaa aaa aaa}
+
+test regexp-26.5 {match length 0, match length 1} {
+    regexp -all -inline -line -- {^b*} "a\nb"
+} {{} b}
+
+test regexp-26.6 {non reporting capture group} {
+    regexp -all -inline -line -- {^(?:a+|b)} "aab\naaa"
+} {aa aaa}
+
+test regexp-26.7 {Tcl bug 2826551: -line sensitive regexp and -start} {
+    set match1 {}
+    set match2 {}
+    list \
+      [regexp -start 0 -indices -line {^a} "\nab" match1] $match1 \
+      [regexp -start 1 -indices -line {^a} "\nab" match2] $match2
+} {1 {1 1} 1 {1 1}}
+
+test regexp-26.8 {Tcl bug 2826551: diff regexp with -line option} {
+    set data "@1\n2\n+3\n@4\n-5\n+6\n7\n@8\n9\n"
+    regexp -all -inline -line {^@.*\n(?:[^@].*\n?)*} $data
+} [list \
+    "@1\n2\n+3\n" \
+    "@4\n-5\n+6\n7\n" \
+    "@8\n9\n" \
+  ]
+
+test regexp-26.9 {Tcl bug 2826551: diff regexp with embedded -line option} {
+    set data "@1\n2\n+3\n@4\n-5\n+6\n7\n@8\n9\n"
+    regexp -all -inline {(?n)^@.*\n(?:[^@].*\n?)*} $data
+} [list \
+    "@1\n2\n+3\n" \
+    "@4\n-5\n+6\n7\n" \
+    "@8\n9\n" \
+  ]
+
+test regexp-26.10 {regexp with -line option} {
+    regexp -all -inline -line -- {a*} "a\n"
+} {a {}}
+
+test regexp-26.11 {regexp without -line option} {
+    regexp -all -inline -- {a*} "a\n"
+} {a {}}
+
+test regexp-26.12 {regexp with -line option} {
+    regexp -all -inline -line -- {a*} "b\n"
+} {{} {}}
+
+test regexp-26.13 {regexp without -line option} {
+    regexp -all -inline -- {a*} "b\n"
+} {{} {}}
+
 # cleanup
 ::tcltest::cleanupTests
 return
