diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | doc/list.n | 11 | ||||
| -rw-r--r-- | doc/lrepeat.n | 37 | ||||
| -rw-r--r-- | generic/tclBasic.c | 4 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 90 | ||||
| -rw-r--r-- | generic/tclInt.h | 4 | ||||
| -rw-r--r-- | tests/lrepeat.test | 79 |
7 files changed, 226 insertions, 9 deletions
@@ -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. @@ -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 |