Implemented [string reverse].

Finalizes basic TIP#272 implementation.

5 files changed, 56 insertions, 15 deletions

diff --git a/ChangeLog b/ChangeLog
index 1af7060..f3770c7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2006-11-09  Donal K. Fellows  <donal.k.fellows@manchester.ac.uk>
 
+	TIP#272 IMPLEMENTATION
+
+	* generic/tclCmdMZ.c (Tcl_StringObjCmd):    Implementation of the
+	* tests/string.test, tests/stringComp.test: [string reverse] command
+	* doc/string.n:				    from TIP#272.
+
 	* generic/tclCmdIL.c (Tcl_LreverseObjCmd): Implementation of the
 	* generic/tclBasic.c, generic/tclInt.h:	   [lreverse] command from
 	* tests/cmdIL.test (cmdIL-7.*):		   TIP#272.
diff --git a/doc/string.n b/doc/string.n
index 8620b50..a54091d 100644
--- a/doc/string.n
+++ b/doc/string.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: string.n,v 1.30 2006/04/26 04:41:10 dgp Exp $
+'\" RCS: @(#) $Id: string.n,v 1.31 2006/11/09 15:37:56 dkf Exp $
 '\" 
 .so man.macros
 .TH string n 8.1 Tcl "Tcl Built-In Commands"
@@ -277,6 +277,12 @@ and if \fIlast\fR is greater than or equal to the length of the string
 then it is treated as if it were \fBend\fR.  If \fIfirst\fR is greater
 than \fIlast\fR or the length of the initial string, or \fIlast\fR is
 less than 0, then the initial string is returned untouched.
+.VS 8.5
+.TP
+\fBstring reverse \fIstring\fR
+Returns a string that is the same length as \fIstring\fR but with its
+characters in the reverse order.
+.VE 8.5
 .TP
 \fBstring tolower \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR?
 Returns a value equal to \fIstring\fR except that all upper (or title)
@@ -353,7 +359,8 @@ if {$length == 0} {
 expr(n), list(n)
 
 .SH KEYWORDS
-case conversion, compare, index, match, pattern, string, word, equal, ctype
+case conversion, compare, index, match, pattern, string, word, equal,
+ctype, character, reverse
 
 '\" Local Variables:
 '\" mode: nroff
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 4a47d0f..474f90f 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,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.138 2006/11/02 16:39:06 dkf Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.139 2006/11/09 15:37:55 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -1133,16 +1133,16 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 	"bytelength",	"compare",	"equal",	"first",
 	"index",	"is",		"last",		"length",
 	"map",		"match",	"range",	"repeat",
-	"replace",	"tolower",	"toupper",	"totitle",
-	"trim",		"trimleft",	"trimright",
+	"replace",	"reverse",	"tolower",	"toupper",
+	"totitle",	"trim",		"trimleft",	"trimright",
 	"wordend",	"wordstart",	NULL
     };
     enum options {
 	STR_BYTELENGTH,	STR_COMPARE,	STR_EQUAL,	STR_FIRST,
 	STR_INDEX,	STR_IS,		STR_LAST,	STR_LENGTH,
 	STR_MAP,	STR_MATCH,	STR_RANGE,	STR_REPEAT,
-	STR_REPLACE,	STR_TOLOWER,	STR_TOUPPER,	STR_TOTITLE,
-	STR_TRIM,	STR_TRIMLEFT,	STR_TRIMRIGHT,
+	STR_REPLACE,	STR_REVERSE,	STR_TOLOWER,	STR_TOUPPER,
+	STR_TOTITLE,	STR_TRIM,	STR_TRIMLEFT,	STR_TRIMRIGHT,
 	STR_WORDEND,	STR_WORDSTART
     };
 
@@ -2195,6 +2195,26 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 	}
 	break;
     }
+    case STR_REVERSE: {
+	Tcl_UniChar *ustring1, *ustring2;
+	int i, j;
+
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "string");
+	    return TCL_ERROR;
+	}
+
+	ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
+	ustring2 = (Tcl_UniChar *)
+		ckalloc(sizeof(Tcl_UniChar) * (unsigned)length1);
+
+	for (i=0,j=length1-1 ; i<length1 ; i++,j--) {
+	    ustring2[j] = ustring1[i];
+	}
+	Tcl_SetObjResult(interp, Tcl_NewUnicodeObj(ustring2, length1));
+	ckfree((char *) ustring2);
+	break;
+    }
     case STR_TOLOWER:
     case STR_TOUPPER:
     case STR_TOTITLE:
diff --git a/tests/string.test b/tests/string.test
index 6dc7bd1..e0a96ee 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: string.test,v 1.57 2006/01/23 12:15:52 msofer Exp $
+# RCS: @(#) $Id: string.test,v 1.58 2006/11/09 15:37:56 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -26,7 +26,7 @@ testConstraint testindexobj [expr {[info commands testindexobj] != {}}]
 
 test string-1.1 {error conditions} {
     list [catch {string gorp a b} msg] $msg
-} {1 {bad option "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
+} {1 {bad option "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
 test string-1.2 {error conditions} {
     list [catch {string} msg] $msg
 } {1 {wrong # args: should be "string option arg ?arg ...?"}}
@@ -1351,7 +1351,7 @@ test string-20.1 {string trimright errors} {
 } {1 {wrong # args: should be "string trimright string ?chars?"}}
 test string-20.2 {string trimright errors} {
     list [catch {string trimg a} msg] $msg
-} {1 {bad option "trimg": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
+} {1 {bad option "trimg": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
 test string-20.3 {string trimright} {
     string trimright "    XYZ      "
 } {    XYZ}
@@ -1407,7 +1407,7 @@ test string-21.14 {string wordend, unicode} {
 
 test string-22.1 {string wordstart} {
     list [catch {string word a} msg] $msg
-} {1 {ambiguous option "word": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
+} {1 {ambiguous option "word": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
 test string-22.2 {string wordstart} {
     list [catch {string wordstart a} msg] $msg
 } {1 {wrong # args: should be "string wordstart string index"}}
@@ -1450,7 +1450,6 @@ test string-23.0 {string is boolean, Bug 1187123} testindexobj {
     catch {testindexobj $x foo bar soom}
     string is boolean $x
 } 0
-
 test string-23.1 {string is command with empty string} {
     set s ""
     list \
@@ -1474,7 +1473,6 @@ test string-23.1 {string is command with empty string} {
         [string is xdigit $s] \
 
 } {1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1}
-
 test string-23.2 {string is command with empty string} {
     set s ""
     list \
@@ -1499,6 +1497,16 @@ test string-23.2 {string is command with empty string} {
 
 } {0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
 
+test string-24.1 {string reverse command} -body {
+    string reverse
+} -returnCodes error -result "wrong # args: should be \"string reverse string\""
+test string-24.2 {string reverse command} -body {
+    string reverse a b
+} -returnCodes error -result "wrong # args: should be \"string reverse string\""
+test string-24.3 {string reverse command} {
+    string reverse abcde
+} edcba
+
 # cleanup
 ::tcltest::cleanupTests
 return
diff --git a/tests/stringComp.test b/tests/stringComp.test
index 2580d0a..08adebe 100644
--- a/tests/stringComp.test
+++ b/tests/stringComp.test
@@ -15,7 +15,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: stringComp.test,v 1.10 2005/05/10 18:35:24 kennykb Exp $
+# RCS: @(#) $Id: stringComp.test,v 1.11 2006/11/09 15:37:56 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -29,7 +29,7 @@ testConstraint testobj [expr {[info commands testobj] != {}}]
 test stringComp-1.1 {error conditions} {
     proc foo {} {string gorp a b}
     list [catch {foo} msg] $msg
-} {1 {bad option "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
+} {1 {bad option "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
 test stringComp-1.2 {error conditions} {
     proc foo {} {string}
     list [catch {foo} msg] $msg