summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog10
-rw-r--r--doc/list.n11
-rw-r--r--doc/lrepeat.n37
-rw-r--r--generic/tclBasic.c4
-rw-r--r--generic/tclCmdIL.c90
-rw-r--r--generic/tclInt.h4
-rw-r--r--tests/lrepeat.test79
7 files changed, 226 insertions, 9 deletions
diff --git a/ChangeLog b/ChangeLog
index 603d7b2..e66869e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2003-08-11 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ TIP #136 IMPLEMENTATION from Simon Geard <simon.geard@ntlworld.com>
+ * generic/tclCmdIL.c (Tcl_LrepeatObjCmd): Adapted version of Simon's
+ * doc/lrepeat.n: patch, updated to the HEAD
+ * tests/lrepeat.test: and matching the core style.
+ * generic/tclBasic.c (buildIntCmds): Splice into core.
+ * generic/tclInt.h:
+ * doc/list.n: Cross-reference.
+
2003-08-06 Jeff Hobbs <jeffh@ActiveState.com>
* win/tclWinInit.c: recognize amd64 and ia32_on_win64 cpus.
diff --git a/doc/list.n b/doc/list.n
index 19a9034..ec32108 100644
--- a/doc/list.n
+++ b/doc/list.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: list.n,v 1.7 2001/12/05 22:26:43 dgp Exp $
+'\" RCS: @(#) $Id: list.n,v 1.8 2003/08/11 13:26:13 dkf Exp $
'\"
.so man.macros
.TH list n "" Tcl "Tcl Built-In Commands"
@@ -43,12 +43,11 @@ while \fBconcat\fR with the same arguments will return
.CE
.SH "SEE ALSO"
-lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
-.VS 8.4
-lset(n),
+lappend(n), lindex(n), linsert(n), llength(n),
+.VS 8.5
+lrepeat(n),
.VE
-lsort(n),
-lrange(n), lreplace(n)
+lrange(n), lreplace(n), lsearch(n), lset(n), lsort(n)
.SH KEYWORDS
element, list
diff --git a/doc/lrepeat.n b/doc/lrepeat.n
new file mode 100644
index 0000000..d5c6d9a
--- /dev/null
+++ b/doc/lrepeat.n
@@ -0,0 +1,37 @@
+'\"
+'\" Copyright (c) 2003 by Simon Geard. 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: lrepeat.n,v 1.1 2003/08/11 13:26:13 dkf Exp $
+'\"
+.so man.macros
+.TH lrepeat n 8.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+lrepeat \- Build a list by repeating elements
+.SH SYNOPSIS
+\fBlrepeat \fInumber element1 \fR?\fIelement2 element3 ...\fR?
+.BE
+.SH DESCRIPTION
+.PP
+The \fBlrepeat\fP command creates a list of size \fInumber * number of
+elements\fP by repeating \fInumber\fR times the sequence of elements
+\fIelement1 element2 ...\fR. \fInumber\fP must be a positive integer,
+\fIelementn\fP can be any Tcl value. Note that \fBlrepeat 1 arg ...\fR
+is identical to \fBlist arg ...\fR, though the \fIarg\fR is required
+with \fBlrepeat\fR.
+.SH EXAMPLES
+.CS
+lrepeat 3 a => a a a
+lrepeat 3 [lrepeat 3 0] => {0 0 0} {0 0 0} {0 0 0}
+lrepeat 3 a b c => a b c a b c a b c
+lrepeat 3 [lrepeat 2 a] b c => {a a} b c {a a} b c {a a} b c
+.CE
+.SH "SEE ALSO"
+list(n), lappend(n), linsert(n), llength(n), lset(n)
+
+.SH KEYWORDS
+element, index, list
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index cf8a758..30e2165 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.85 2003/06/25 23:02:11 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.86 2003/08/11 13:26:13 dkf Exp $
*/
#include "tclInt.h"
@@ -126,6 +126,8 @@ static CmdInfo builtInCmds[] = {
(CompileProc *) NULL, 0},
{"lrange", (Tcl_CmdProc *) NULL, Tcl_LrangeObjCmd,
(CompileProc *) NULL, 1},
+ {"lrepeat", (Tcl_CmdProc *) NULL, Tcl_LrepeatObjCmd,
+ (CompileProc *) NULL, 1},
{"lreplace", (Tcl_CmdProc *) NULL, Tcl_LreplaceObjCmd,
(CompileProc *) NULL, 1},
{"lsearch", (Tcl_CmdProc *) NULL, Tcl_LsearchObjCmd,
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 89c05af..467241d 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.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: tclCmdIL.c,v 1.51 2003/07/15 15:42:05 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.52 2003/08/11 13:26:13 dkf Exp $
*/
#include "tclInt.h"
@@ -2637,6 +2637,94 @@ Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
+ * Tcl_LrepeatObjCmd --
+ *
+ * This procedure is invoked to process the "lrepeat" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl object result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tcl_LrepeatObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ register int objc; /* Number of arguments. */
+ register Tcl_Obj *CONST objv[]; /* The argument objects. */
+{
+ int elementCount, i, j, k, result;
+ Tcl_Obj **dataArray;
+
+ /*
+ * Check arguments for legality:
+ * lrepeat posInt value ?value ...?
+ */
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "positiveCount value ?value ...?");
+ return TCL_ERROR;
+ }
+ elementCount = 0;
+ result = Tcl_GetIntFromObj(interp, objv[1], &elementCount);
+ if (result == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (elementCount < 1) {
+ Tcl_AppendResult(interp, "must have a count of at least 1", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Skip forward to the interesting arguments now we've finished
+ * parsing.
+ */
+
+ objc -= 2;
+ objv += 2;
+
+ /*
+ * Create workspace array large enough to hold each init value
+ * elementCount times. Note that we don't bother with stack
+ * allocation for this, as we expect this function to be used
+ * mainly when stack allocation would be inappropriate anyway.
+ *
+ * POSSIBLE FUTURE ENHANCEMENT: Build the resulting list object
+ * directly and avoid a copy.
+ */
+
+ dataArray = (Tcl_Obj **) ckalloc(elementCount * objc * sizeof(Tcl_Obj));
+
+ /*
+ * Set the elements. Note that this ends up setting k to the
+ * total number of elements.
+ */
+
+ k = 0;
+ for (i=0 ; i<elementCount ; i++) {
+ for (j=0 ; j<objc ; j++) {
+ dataArray[k++] = objv[j];
+ }
+ }
+
+ /*
+ * Build the result list, clean up and return.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_NewListObj(k, dataArray));
+ ckfree((char*) dataArray);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_LreplaceObjCmd --
*
* This object-based procedure is invoked to process the "lreplace"
diff --git a/generic/tclInt.h b/generic/tclInt.h
index e25d632..0da497b 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.130 2003/07/24 18:16:30 mdejong Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.131 2003/08/11 13:26:13 dkf Exp $
*/
#ifndef _TCLINT
@@ -1893,6 +1893,8 @@ EXTERN int Tcl_LoadObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_LrangeObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tcl_LrepeatObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_LreplaceObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_LsearchObjCmd _ANSI_ARGS_((ClientData clientData,
diff --git a/tests/lrepeat.test b/tests/lrepeat.test
new file mode 100644
index 0000000..5478d7b
--- /dev/null
+++ b/tests/lrepeat.test
@@ -0,0 +1,79 @@
+# Commands covered: lrepeat
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 2003 by Simon Geard.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: lrepeat.test,v 1.1 2003/08/11 13:26:14 dkf Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+## Arg errors
+test lrepeat-1.1 {error cases} {
+ -body {
+ lrepeat
+ }
+ -returnCodes 1
+ -result {wrong # args: should be "lrepeat positiveCount value ?value ...?"}
+}
+test lrepeat-1.2 {error cases} {
+ -body {
+ lrepeat 1
+ }
+ -returnCodes 1
+ -result {wrong # args: should be "lrepeat positiveCount value ?value ...?"}
+}
+test lrepeat-1.3 {error cases} {
+ -body {
+ lrepeat a 1
+ }
+ -returnCodes 1
+ -result {expected integer but got "a"}
+}
+test lrepeat-1.4 {error cases} {
+ -body {
+ lrepeat -3 1
+ }
+ -returnCodes 1
+ -result {must have a count of at least 1}
+}
+test lrepeat-1.5 {error cases} {
+ -body {
+ lrepeat 0
+ }
+ -returnCodes 1
+ -result {wrong # args: should be "lrepeat positiveCount value ?value ...?"}
+}
+test lrepeat-1.6 {error cases} {
+ -body {
+ lrepeat 3.5 1
+ }
+ -returnCodes 1
+ -result {expected integer but got "3.5"}
+}
+
+## Okay
+test lrepeat-2.1 {normal cases} {
+ lrepeat 10 a
+} {a a a a a a a a a a}
+test lrepeat-2.2 {normal cases} {
+ lrepeat 3 [lrepeat 3 0]
+} {{0 0 0} {0 0 0} {0 0 0}}
+test lrepeat-2.3 {normal cases} {
+ lrepeat 3 a b c
+} {a b c a b c a b c}
+test lrepeat-2.4 {normal cases} {
+ lrepeat 3 [lrepeat 2 a] b c
+} {{a a} b c {a a} b c {a a} b c}
+
+# cleanup
+::tcltest::cleanupTests
+return