Use the error messages generated by the variable management code rather than

creating our own in [regexp] and [regsub].

4 files changed, 57 insertions, 46 deletions

diff --git a/ChangeLog b/ChangeLog
index 23b91b7..703dc72 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,10 +1,16 @@
+2011-03-28  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclCmdMZ.c (Tcl_RegexpObjCmd, Tcl_RegsubObjCmd): Use the
+	error messages generated by the variable management code rather than
+	creating our own.
+
 2011-03-27  Miguel Sofer  <msofer@users.sf.net>
 
 	* generic/tclBasic.c (TclNREvalObjEx): fix performance issue,
 	notably apparent in tclbench's "LIST lset foreach". Many thanks to
 	twylite for patiently researching the issue and explaining it to
 	me: a missing Tcl_ResetObjResult that causes unwanted sharing of
-	the current result Tcl_Obj. 
+	the current result Tcl_Obj.
 
 2011-03-26  Donal K. Fellows  <dkf@users.sf.net>
 
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 05f2e5d..e39ae06 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -383,12 +383,8 @@ Tcl_RegexpObjCmd(
 		    return TCL_ERROR;
 		}
 	    } else {
-		Tcl_Obj *valuePtr;
-
-		valuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, 0);
-		if (valuePtr == NULL) {
-		    Tcl_AppendResult(interp, "couldn't set variable \"",
-			    TclGetString(objv[i]), "\"", NULL);
+		if (Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr,
+			TCL_LEAVE_ERR_MSG) == NULL) {
 		    return TCL_ERROR;
 		}
 	    }
@@ -816,9 +812,8 @@ Tcl_RegsubObjCmd(
 	Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
     }
     if (objc == 4) {
-	if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, 0) == NULL) {
-	    Tcl_AppendResult(interp, "couldn't set variable \"",
-		    TclGetString(objv[3]), "\"", NULL);
+	if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr,
+		TCL_LEAVE_ERR_MSG) == NULL) {
 	    result = TCL_ERROR;
 	} else {
 	    /*
diff --git a/tests/regexp.test b/tests/regexp.test
index 632a19d..7cafd1b 100644
--- a/tests/regexp.test
+++ b/tests/regexp.test
@@ -11,12 +11,12 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-catch {unset foo}
+unset -nocomplain foo
 
 testConstraint exec [llength [info commands exec]]
 
@@ -196,7 +196,7 @@ set x $x$x$x$x$x$x$x$x$x$x$x$x
 test regexp-4.4 {case conversion in regexp} {
     list [regexp -nocase $x $x foo] $foo
 } "1 $x"
-catch {unset x}
+unset -nocomplain x
 
 test regexp-5.1 {exercise cache of compiled expressions} {
     regexp .*a b
@@ -260,11 +260,12 @@ test regexp-6.6 {regexp errors} {
 test regexp-6.7 {regexp errors} {
     list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg
 } {0 0}
-test regexp-6.8 {regexp errors} {
-    catch {unset f1}
+test regexp-6.8 {regexp errors} -setup {
+    unset -nocomplain f1
+} -body {
     set f1 44
-    list [catch {regexp abc abc f1(f2)} msg] $msg
-} {1 {couldn't set variable "f1(f2)"}}
+    regexp abc abc f1(f2)
+} -returnCodes error -result {can't set "f1(f2)": variable isn't array}
 test regexp-6.9 {regexp errors, -start bad int check} {
     list [catch {regexp -start bogus {^$} {}} msg] $msg
 } {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
@@ -456,11 +457,12 @@ test regexp-11.5 {regsub errors} {
 test regexp-11.6 {regsub errors} {
     list [catch {regsub -nocase a( b c d} msg] $msg
 } {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
-test regexp-11.7 {regsub errors} {
-    catch {unset f1}
+test regexp-11.7 {regsub errors} -setup {
+    unset -nocomplain f1
+} -body {
     set f1 44
-    list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
-} {1 {couldn't set variable "f1(f2)"}}
+    regsub -nocase aaa aaa xxx f1(f2)
+} -returnCodes error -result {can't set "f1(f2)": variable isn't array}
 test regexp-11.8 {regsub errors, -start bad int check} {
     list [catch {regsub -start bogus pattern string rep var} msg] $msg
 } {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
@@ -527,23 +529,23 @@ test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} -co
 } -result 1
 
 test regexp-15.1 {regexp -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start -10 {\d} 1abc2de3 x] $x
 } {1 1}
 test regexp-15.2 {regexp -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start 2 {\d} 1abc2de3 x] $x
 } {1 2}
 test regexp-15.3 {regexp -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start 4 {\d} 1abc2de3 x] $x
 } {1 2}
 test regexp-15.4 {regexp -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start 5 {\d} 1abc2de3 x] $x
 } {1 3}
 test regexp-15.5 {regexp -start, over end of string} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x]
 } {0 0}
 test regexp-15.6 {regexp -start, loss of ^$ behavior} {
@@ -556,11 +558,11 @@ test regexp-15.8 {regexp -start, double option} {
     regexp -start 0 -start 2 a abc
 } 0
 test regexp-15.9 {regexp -start, end relative index} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start end {\d} 1abc2de3 x] [info exists x]
 } {0 0}
 test regexp-15.10 {regexp -start, end relative index} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start end-1 {\d} 1abc2de3 x] [info exists x] $x
 } {1 1 3}
 test regexp-15.11 {regexp -start, over end of string} {
@@ -569,15 +571,15 @@ test regexp-15.11 {regexp -start, over end of string} {
 } {1 {}}
 
 test regexp-16.1 {regsub -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
 } {4 a1b/2c/3d/4e/5}
 test regexp-16.2 {regsub -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regsub -all -start -25 {z} hello {/&} x] $x
 } {0 hello}
 test regexp-16.3 {regsub -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regsub -all -start 3 {z} hello {/&} x] $x
 } {0 hello}
 test regexp-16.4 {regsub -start, \A behavior} {
@@ -1065,3 +1067,6 @@ test regexp-26.13 {regexp without -line option} {
 ::tcltest::cleanupTests
 return
 
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/regexpComp.test b/tests/regexpComp.test
index 6f0b688..94fb90e 100644
--- a/tests/regexpComp.test
+++ b/tests/regexpComp.test
@@ -29,7 +29,8 @@ proc evalInProc { script } {
     #return [list $status $result]
 }
 
-catch {unset foo}
+unset -nocomplain foo
+
 test regexpComp-1.1 {basic regexp operation} {
     evalInProc {
 	regexp ab*c abbbc
@@ -258,7 +259,7 @@ test regexpComp-4.4 {case conversion in regexp} {
 	list [regexp -nocase $::x $::x foo] $foo
     }
 } "1 $x"
-catch {unset ::x}
+unset -nocomplain ::x
 
 test regexpComp-5.1 {exercise cache of compiled expressions} {
     evalInProc {
@@ -348,11 +349,11 @@ test regexpComp-6.7 {regexp errors} {
 } {0 0}
 test regexpComp-6.8 {regexp errors} {
     evalInProc {
-	catch {unset f1}
+	unset -nocomplain f1
 	set f1 44
 	list [catch {regexp abc abc f1(f2)} msg] $msg
     }
-} {1 {couldn't set variable "f1(f2)"}}
+} {1 {can't set "f1(f2)": variable isn't array}}
 test regexpComp-6.9 {regexp errors, -start bad int check} {
     evalInProc {
 	list [catch {regexp -start bogus {^$} {}} msg] $msg
@@ -589,11 +590,11 @@ test regexpComp-11.6 {regsub errors} {
 } {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
 test regexpComp-11.7 {regsub errors} {
     evalInProc {
-	catch {unset f1}
+	unset -nocomplain f1
 	set f1 44
 	list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
     }
-} {1 {couldn't set variable "f1(f2)"}}
+} {1 {can't set "f1(f2)": variable isn't array}}
 test regexpComp-11.8 {regsub errors, -start bad int check} {
     evalInProc {
 	list [catch {regsub -start bogus pattern string rep var} msg] $msg
@@ -660,23 +661,23 @@ test regexpComp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache}
 } -result 1
 
 test regexpComp-15.1 {regexp -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start -10 {\d} 1abc2de3 x] $x
 } {1 1}
 test regexpComp-15.2 {regexp -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start 2 {\d} 1abc2de3 x] $x
 } {1 2}
 test regexpComp-15.3 {regexp -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start 4 {\d} 1abc2de3 x] $x
 } {1 2}
 test regexpComp-15.4 {regexp -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start 5 {\d} 1abc2de3 x] $x
 } {1 3}
 test regexpComp-15.5 {regexp -start, over end of string} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x]
 } {0 0}
 test regexpComp-15.6 {regexp -start, loss of ^$ behavior} {
@@ -684,15 +685,15 @@ test regexpComp-15.6 {regexp -start, loss of ^$ behavior} {
 } {0}
 
 test regexpComp-16.1 {regsub -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
 } {4 a1b/2c/3d/4e/5}
 test regexpComp-16.2 {regsub -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regsub -all -start -25 {z} hello {/&} x] $x
 } {0 hello}
 test regexpComp-16.3 {regsub -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regsub -all -start 3 {z} hello {/&} x] $x
 } {0 hello}
 test regexpComp-16.4 {regsub -start, \A behavior} {
@@ -981,7 +982,11 @@ test regexpComp-24.11 {regexp command compiling tests} {
 	regexp -- $re $text
     }
 } 1
-
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End: