Added TIP#76 implementation, docs + tests.

4 files changed, 62 insertions, 27 deletions

diff --git a/ChangeLog b/ChangeLog
index 9cc9ef8..e1cf9fa 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2002-02-22  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
 
+	--- TIP#76 CHANGES ---
+	* generic/tclCmdMZ.c (Tcl_RegsubObjCmd): Final-argument-less
+	[regsub] returns the modified string.
+	* doc/regsub.n: Updated docs.
+	* tests/regexp.test: Updated and added tests.
+
 	* compat/strtoll.c (strtoll): 
 	* compat/strtoull.c (strtoull): 
 	* unix/tclUnixPort.h:
diff --git a/doc/regsub.n b/doc/regsub.n
index 9fe54ab..6fa4bd0 100644
--- a/doc/regsub.n
+++ b/doc/regsub.n
@@ -6,7 +6,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: regsub.n,v 1.7 2001/11/28 13:15:31 dkf Exp $
+'\" RCS: @(#) $Id: regsub.n,v 1.8 2002/02/22 14:52:45 dkf Exp $
 '\" 
 .so man.macros
 .TH regsub n 8.3 Tcl "Tcl Built-In Commands"
@@ -15,18 +15,26 @@
 .SH NAME
 regsub \- Perform substitutions based on regular expression pattern matching
 .SH SYNOPSIS
-\fBregsub \fR?\fIswitches\fR? \fIexp string subSpec varName\fR
+.VS 8.4
+\fBregsub \fR?\fIswitches\fR? \fIexp string subSpec \fR?\fIvarName\fR?
+.VE 8.4
 .BE
 
 .SH DESCRIPTION
 .PP
 This command matches the regular expression \fIexp\fR against
 \fIstring\fR,
-and it copies \fIstring\fR to the variable whose name is
-given by \fIvarName\fR.
+.VS 8.4
+and either copies \fIstring\fR to the variable whose name is
+given by \fIvarName\fR or returns \fIstring\fR if \fIvarName\fR is not
+present.
+.VE 8.4
 (Regular expression matching is described in the \fBre_syntax\fR
 reference page.)
 If there is a match, then while copying \fIstring\fR to \fIvarName\fR
+.VS 8.4
+(or to the result of this command if \fIvarName\fR is not present)
+.VE 8.4
 the portion of \fIstring\fR that
 matched \fIexp\fR is replaced with \fIsubSpec\fR.
 If \fIsubSpec\fR contains a ``&'' or ``\e0'', then it is replaced
@@ -87,7 +95,6 @@ manual page).
 Upper-case characters in \fIstring\fR will be converted to lower-case
 before matching against \fIexp\fR;  however, substitutions specified
 by \fIsubSpec\fR use the original unconverted form of \fIstring\fR.
-.VS 8.3
 .TP 10
 \fB\-start\fR \fIindex\fR
 Specifies a character index offset into the string to start
@@ -95,14 +102,16 @@ matching the regular expression at.  When using this switch, `^'
 will not match the beginning of the line, and \\A will still
 match the start of the string at \fIindex\fR.
 \fIindex\fR will be constrained to the bounds of the input string.
-.VE 8.3
 .TP 10
 \fB\-\|\-\fR
 Marks the end of switches.  The argument following this one will
 be treated as \fIexp\fR even if it starts with a \fB\-\fR.
 .PP
-The command returns a count of the number of matching ranges that
-were found and replaced.
+.VS 8.4
+If \fIvarName\fR is supplied, the command returns a count of the
+number of matching ranges that were found and replaced, otherwise the
+string after replacement is returned.
+.VE 8.4
 See the manual entry for \fBregexp\fR for details on the interpretation
 of regular expressions.
 
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index af2e214..04c6a6c 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.60 2002/02/15 14:28:48 dkf Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.61 2002/02/22 14:52:45 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -548,12 +548,13 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
 	}
     }
     endOfForLoop:
-    if (objc - idx != 4) {
+    if (objc-idx < 3 || objc-idx > 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"?switches? exp string subSpec varName");
+		"?switches? exp string subSpec ?varName?");
 	return TCL_ERROR;
     }
 
+    objc -= idx;
     objv += idx;
 
     if (all && (offset == 0)
@@ -781,17 +782,24 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
     } else if (offset < wlen) {
 	Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
     }
-    if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, 0) == NULL) {
-	Tcl_AppendResult(interp, "couldn't set variable \"",
-		Tcl_GetString(objv[3]), "\"", (char *) NULL);
-	result = TCL_ERROR;
+    if (objc == 4) {
+	if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, 0) == NULL) {
+	    Tcl_AppendResult(interp, "couldn't set variable \"",
+		    Tcl_GetString(objv[3]), "\"", (char *) NULL);
+	    result = TCL_ERROR;
+	} else {
+	    /*
+	     * Set the interpreter's object result to an integer object
+	     * holding the number of matches. 
+	     */
+
+	    Tcl_SetIntObj(Tcl_GetObjResult(interp), numMatches);
+	}
     } else {
 	/*
-	 * Set the interpreter's object result to an integer object
-	 * holding the number of matches. 
+	 * No varname supplied, so just return the modified string.
 	 */
-
-	Tcl_SetIntObj(Tcl_GetObjResult(interp), numMatches);
+	Tcl_SetObjResult(interp, resultPtr);
     }
 
     done:
diff --git a/tests/regexp.test b/tests/regexp.test
index 3e06061..f2a6de3 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.18 2002/02/07 00:52:25 hobbs Exp $
+# RCS: @(#) $Id: regexp.test,v 1.19 2002/02/22 14:52:45 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -343,17 +343,17 @@ test regexp-10.5 {inverse partial newline sensitivity in regsub} {
 } "1 {da\nb123\nxb}"
 
 test regexp-11.1 {regsub errors} {
-    list [catch {regsub a b c} msg] $msg
-} {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}}
+    list [catch {regsub a b} msg] $msg
+} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
 test regexp-11.2 {regsub errors} {
-    list [catch {regsub -nocase a b c} msg] $msg
-} {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}}
+    list [catch {regsub -nocase a b} msg] $msg
+} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
 test regexp-11.3 {regsub errors} {
-    list [catch {regsub -nocase -all a b c} msg] $msg
-} {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}}
+    list [catch {regsub -nocase -all a b} msg] $msg
+} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
 test regexp-11.4 {regsub errors} {
     list [catch {regsub a b c d e f} msg] $msg
-} {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}}
+} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
 test regexp-11.5 {regsub errors} {
     list [catch {regsub -gorp a b c} msg] $msg
 } {1 {bad switch "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}}
@@ -368,6 +368,18 @@ test regexp-11.7 {regsub errors} {
 test regexp-11.8 {regsub errors, -start bad int check} {
     list [catch {regsub -start bogus pattern string rep var} msg] $msg
 } {1 {expected integer but got "bogus"}}
+test regexp-11.9 {regsub without final variable name returns value} {
+    regsub b abaca X
+} {aXaca}
+test regexp-11.10 {regsub without final variable name returns value} {
+    regsub -all a abaca X
+} {XbXcX}
+test regexp-11.11 {regsub without final variable name returns value} {
+    regsub b(.*?)d abcdeabcfde {,&,\1,}
+} {a,bcd,c,eabcfde}
+test regexp-11.12 {regsub without final variable name returns value} {
+    regsub -all b(.*?)d abcdeabcfde {,&,\1,}
+} {a,bcd,c,ea,bcfd,cf,e}
 
 # This test crashes on the Mac unless you increase the Stack Space to about 1
 # Meg.  This is probably bigger than most users want...