From b07bb89f2a73a18a69b6666c3484f3e2271f53bf Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 9 Nov 2006 15:19:01 +0000
Subject: Implemented [lreverse] from TIP#272

---
 ChangeLog          |  7 +++++++
 doc/lreverse.n     | 31 +++++++++++++++++++++++++++++++
 generic/tclBasic.c |  3 ++-
 generic/tclCmdIL.c | 52 +++++++++++++++++++++++++++++++++++++++++++++++++++-
 generic/tclInt.h   |  5 ++++-
 tests/cmdIL.test   | 15 ++++++++++++++-
 6 files changed, 109 insertions(+), 4 deletions(-)
 create mode 100644 doc/lreverse.n

diff --git a/ChangeLog b/ChangeLog
index 6f9ec3b..1af7060 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2006-11-09  Donal K. Fellows  <donal.k.fellows@manchester.ac.uk>
+
+	* generic/tclCmdIL.c (Tcl_LreverseObjCmd): Implementation of the
+	* generic/tclBasic.c, generic/tclInt.h:	   [lreverse] command from
+	* tests/cmdIL.test (cmdIL-7.*):		   TIP#272.
+	* doc/lreverse.n:
+
 2006-11-08  Donal K. Fellows  <dkf@users.sf.net>
 
 	* generic/tclIO.c, generic/tclPkg.c: Style & clarity rewrites.
diff --git a/doc/lreverse.n b/doc/lreverse.n
new file mode 100644
index 0000000..6c10274
--- /dev/null
+++ b/doc/lreverse.n
@@ -0,0 +1,31 @@
+'\" -*- nroff -*-
+'\" Copyright (c) 2006 by Donal K. Fellows.  All rights reserved.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\" 
+'\" RCS: @(#) $Id: lreverse.n,v 1.1 2006/11/09 15:19:03 dkf Exp $
+'\" 
+.so man.macros
+.TH lreverse n 8.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+lreverse \- Reverse the order of a list
+.SH SYNOPSIS
+\fBlreverse \fIlist\fR
+.BE
+.SH DESCRIPTION
+.PP
+The \fBlreverse\fP command returns a list that has the same elements as its
+input list, \fIlist\fP, except with the elements in the reverse order.
+.SH EXAMPLES
+.CS
+\fBlreverse\fP {a a b c}        => c b a a
+\fBlreverse\fP {a b {c d} e f}  => f e {c d} b a
+.CE
+.SH "SEE ALSO"
+list(n), lsearch(n), lsort(n)
+
+.SH KEYWORDS
+element, list, reverse
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 40cc7fb..22b715a 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.216 2006/11/04 00:09:33 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.217 2006/11/09 15:19:02 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -139,6 +139,7 @@ static CmdInfo builtInCmds[] = {
     {"lrange",		Tcl_LrangeObjCmd,	NULL,			1},
     {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			1},
     {"lreplace",	Tcl_LreplaceObjCmd,	NULL,			1},
+    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			1},
     {"lsearch",		Tcl_LsearchObjCmd,	NULL,			1},
     {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	1},
     {"lsort",		Tcl_LsortObjCmd,	NULL,			1},
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index fdbc293..6f9d9ac 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdIL.c,v 1.92 2006/11/02 15:58:05 dgp Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.93 2006/11/09 15:19:03 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -3158,6 +3158,56 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
  */
 
 int
+Tcl_LreverseObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument values. */
+{
+    Tcl_Obj *resultObj, **dataArray, **elemv;
+    int elemc, i, j;
+    List *listPtr;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list");
+	return TCL_ERROR;
+    }
+    if (Tcl_ListObjGetElements(interp, objv[1], &elemc, &elemv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    resultObj = Tcl_NewListObj(elemc, NULL);
+    listPtr = (List *) resultObj->internalRep.twoPtrValue.ptr1;
+    listPtr->elemCount = elemc;
+    dataArray = &listPtr->elements;
+
+    for (i=0,j=elemc-1 ; i<elemc ; i++,j--) {
+	dataArray[j] = elemv[i];
+	Tcl_IncrRefCount(elemv[i]);
+    }
+
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LsearchObjCmd --
+ *
+ *	This procedure is invoked to process the "lsearch" Tcl command. See
+ *	the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
 Tcl_LsearchObjCmd(clientData, interp, objc, objv)
     ClientData clientData;	/* Not used. */
     Tcl_Interp *interp;		/* Current interpreter. */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 54a27bc..796ae21 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.292 2006/11/02 16:57:54 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.293 2006/11/09 15:19:03 dkf Exp $
  */
 
 #ifndef _TCLINT
@@ -2426,6 +2426,9 @@ MODULE_SCOPE int	Tcl_LrepeatObjCmd(ClientData clientData,
 MODULE_SCOPE int	Tcl_LreplaceObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[]);
+MODULE_SCOPE int	Tcl_LreverseObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]);
 MODULE_SCOPE int	Tcl_LsearchObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[]);
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index a4099a8..c2fd650 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -8,7 +8,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: cmdIL.test,v 1.28 2006/10/09 19:15:44 msofer Exp $
+# RCS: @(#) $Id: cmdIL.test,v 1.29 2006/11/09 15:19:03 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -724,6 +724,19 @@ test cmdIL-6.26 {lassign command - shimmering protection} -body {
     rename testLassign {}
 }
 
+test cmdIL-7.1 {lreverse command} -body {
+    lreverse
+} -returnCodes error -result "wrong # args: should be \"lreverse list\""
+test cmdIL-7.2 {lreverse command} -body {
+    lreverse a b
+} -returnCodes error -result "wrong # args: should be \"lreverse list\""
+test cmdIL-7.3 {lreverse command} -body {
+    lreverse "not \{a list"
+} -returnCodes error -result {unmatched open brace in list}
+test cmdIL-7.4 {lreverse command} {
+    lreverse {a b {c d} e f}
+} {f e {c d} b a}
+
 # cleanup
 ::tcltest::cleanupTests
 return
-- 
cgit v0.12