Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch tip-523 Excluding Merge-Ins
This is equivalent to a diff from 0a84e79434 to 02d45a4442
2018-11-06
| ||
11:14 | Implement TIP 523 check-in: 631b118fda user: dkf tags: core-8-branch | |
2018-10-24
| ||
22:15 | Simplify to only accept index arguemnts. No index list. Added manual page. Closed-Leaf check-in: 02d45a4442 user: pspjuth tags: tip-523 | |
2018-10-22
| ||
20:12 | Merge changes in libtommath's latest "develop" branch check-in: 1333ab8fdb user: jan.nijtmans tags: core-8-branch | |
18:43 | Implement TIP 523, New lpop command check-in: 00c6ed2b91 user: pspjuth tags: tip-523 | |
18:36 | Missing ',' in documentation (discovered by MacOSX help processing). Some whitespacing check-in: 0a84e79434 user: jan.nijtmans tags: core-8-branch | |
18:21 | Fix error-message on MacOS: the __LINKEDIT segment does not cover the end of the file. Reason: We ap... check-in: 517d7010fc user: jan.nijtmans tags: core-8-branch | |
Added doc/lpop.n.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | '\" '\" Copyright (c) 2018 by Peter Spjuth. All rights reserved. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH lpop n 8.7 Tcl "Tcl Built-In Commands" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME lpop \- Get and remove an element in a list .SH SYNOPSIS \fBlpop \fIvarName ?index ...?\fR .BE .SH DESCRIPTION .PP The \fBlpop\fR command accepts a parameter, \fIvarName\fR, which it interprets as the name of a variable containing a Tcl list. It also accepts one or more \fIindices\fR into the list. If no indices are presented, it defaults to "end". .PP When presented with a single index, the \fBlpop\fR command addresses the \fIindex\fR'th element in it, removes if from the list and returns the element. .PP If \fIindex\fR is negative or greater or equal than the number of elements in \fI$varName\fR, then an error occurs. .PP The interpretation of each simple \fIindex\fR value is the same as for the command \fBstring index\fR, supporting simple index arithmetic and indices relative to the end of the list. .PP If additional \fIindex\fR arguments are supplied, then each argument is used in turn to address an element within a sublist designated by the previous indexing operation, allowing the script to remove elements in sublists. The command, .PP .CS \fBlpop\fR a 1 2 .CE .PP gets and removes element 2 of sublist 1. .PP .SH EXAMPLES .PP In each of these examples, the initial value of \fIx\fR is: .PP .CS set x [list [list a b c] [list d e f] [list g h i]] \fI\(-> {a b c} {d e f} {g h i}\fR .CE .PP The indicated value becomes the new value of \fIx\fR (except in the last case, which is an error which leaves the value of \fIx\fR unchanged.) .PP .CS \fBlpop\fR x 0 \fI\(-> {d e f} {g h i}\fR \fBlpop\fR x 2 \fI\(-> {a b c} {d e f}\fR \fBlpop\fR x end \fI\(-> {a b c} {d e f}\fR \fBlpop\fR x end-1 \fI\(-> {a b c} {g h i}\fR \fBlpop\fR x 2 1 \fI\(-> {a b c} {d e f} {g i}\fR \fBlpop\fR x 2 3 j \fI\(-> list index out of range\fR .CE .PP In the following examples, the initial value of \fIx\fR is: .PP .CS set x [list [list [list a b] [list c d]] \e [list [list e f] [list g h]]] \fI\(-> {{a b} {c d}} {{e f} {g h}}\fR .CE .PP The indicated value becomes the new value of \fIx\fR. .PP .CS \fBlpop\fR x 1 1 0 \fI\(-> {{a b} {c d}} {{e f} h}\fR .CE .SH "SEE ALSO" list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), lsort(n), lrange(n), lreplace(n), lset(n) string(n) .SH KEYWORDS element, index, list, remove, pop, stack, queue '\"Local Variables: '\"mode: nroff '\"End: |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
256 257 258 259 260 261 262 263 264 265 266 267 268 269 | {"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, CMD_IS_SAFE}, {"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, CMD_IS_SAFE}, {"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, CMD_IS_SAFE}, {"linsert", Tcl_LinsertObjCmd, TclCompileLinsertCmd, NULL, CMD_IS_SAFE}, {"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED}, {"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, CMD_IS_SAFE}, {"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE}, {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE}, {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE}, {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, | > | 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 | {"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, CMD_IS_SAFE}, {"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, CMD_IS_SAFE}, {"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, CMD_IS_SAFE}, {"linsert", Tcl_LinsertObjCmd, TclCompileLinsertCmd, NULL, CMD_IS_SAFE}, {"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED}, {"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, CMD_IS_SAFE}, {"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE}, {"lpop", Tcl_LpopObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE}, {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE}, {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, |
︙ | ︙ |
Changes to generic/tclCmdIL.c.
︙ | ︙ | |||
2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 | /* * Set the interpreter's object result to an integer object holding the * length. */ Tcl_SetObjResult(interp, Tcl_NewIntObj(listLen)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_LrangeObjCmd -- | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 | /* * Set the interpreter's object result to an integer object holding the * length. */ Tcl_SetObjResult(interp, Tcl_NewIntObj(listLen)); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_LpopObjCmd -- * * This procedure is invoked to process the "lpop" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl object result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_LpopObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ register Tcl_Obj *const objv[]) /* Argument objects. */ { int listLen, result; Tcl_Obj *elemPtr; Tcl_Obj *listPtr, **elemPtrs; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "listvar ?index?"); return TCL_ERROR; } listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); if (listPtr == NULL) { return TCL_ERROR; } result = TclListObjGetElements(interp, listPtr, &listLen, &elemPtrs); if (result != TCL_OK) { return result; } /* * First, extract the element to be returned. * TclLindexFlat adds a ref count which is handled. */ if (objc == 2) { elemPtr = elemPtrs[listLen - 1]; Tcl_IncrRefCount(elemPtr); } else { elemPtr = TclLindexFlat(interp, listPtr, objc-2, objv+2); if (elemPtr == NULL) { return TCL_ERROR; } } Tcl_SetObjResult(interp, elemPtr); Tcl_DecrRefCount(elemPtr); /* * Second, remove the element. */ if (objc == 2) { if (Tcl_IsShared(listPtr)) { listPtr = TclListObjCopy(NULL, listPtr); } result = Tcl_ListObjReplace(interp, listPtr, listLen - 1, 1, 0, NULL); if (result != TCL_OK) { return result; } } else { listPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL); if (listPtr == NULL) { return TCL_ERROR; } } listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG); if (listPtr == NULL) { return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_LrangeObjCmd -- |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 | Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LmapObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LoadObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LrangeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LrepeatObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); | > > > | 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 | Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LmapObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LoadObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LpopObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LrangeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LrepeatObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); |
︙ | ︙ |
Changes to generic/tclListObj.c.
︙ | ︙ | |||
1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 | /* *---------------------------------------------------------------------- * * TclLsetList -- * * Core of the 'lset' command when objc == 4. Objv[2] may be either a * scalar index or a list of indices. * * Results: * Returns the new value of the list variable, or NULL if there was an * error. The returned object includes one reference count for the * pointer returned. * * Side effects: | > | 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 | /* *---------------------------------------------------------------------- * * TclLsetList -- * * Core of the 'lset' command when objc == 4. Objv[2] may be either a * scalar index or a list of indices. * It also handles 'lpop' when given a NULL value. * * Results: * Returns the new value of the list variable, or NULL if there was an * error. The returned object includes one reference count for the * pointer returned. * * Side effects: |
︙ | ︙ | |||
1376 1377 1378 1379 1380 1381 1382 | */ Tcl_Obj * TclLsetList( Tcl_Interp *interp, /* Tcl interpreter. */ Tcl_Obj *listPtr, /* Pointer to the list being modified. */ Tcl_Obj *indexArgPtr, /* Index or index-list arg to 'lset'. */ | | | 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 | */ Tcl_Obj * TclLsetList( Tcl_Interp *interp, /* Tcl interpreter. */ Tcl_Obj *listPtr, /* Pointer to the list being modified. */ Tcl_Obj *indexArgPtr, /* Index or index-list arg to 'lset'. */ Tcl_Obj *valuePtr) /* Value arg to 'lset' or NULL to 'lpop'. */ { int indexCount = 0; /* Number of indices in the index list. */ Tcl_Obj **indices = NULL; /* Vector of indices in the index list. */ Tcl_Obj *retValuePtr; /* Pointer to the list to be returned. */ int index; /* Current index in the list - discarded. */ Tcl_Obj *indexListCopy; |
︙ | ︙ | |||
1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 | /* *---------------------------------------------------------------------- * * TclLsetFlat -- * * Core engine of the 'lset' command. * * Results: * Returns the new value of the list variable, or NULL if an error * occurred. The returned object includes one reference count for the * pointer returned. * * Side effects: | > | 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 | /* *---------------------------------------------------------------------- * * TclLsetFlat -- * * Core engine of the 'lset' command. * It also handles 'lpop' when given a NULL value. * * Results: * Returns the new value of the list variable, or NULL if an error * occurred. The returned object includes one reference count for the * pointer returned. * * Side effects: |
︙ | ︙ | |||
1471 1472 1473 1474 1475 1476 1477 | Tcl_Obj * TclLsetFlat( Tcl_Interp *interp, /* Tcl interpreter. */ Tcl_Obj *listPtr, /* Pointer to the list being modified. */ int indexCount, /* Number of index args. */ Tcl_Obj *const indexArray[], /* Index args. */ | | > > | > | 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 | Tcl_Obj * TclLsetFlat( Tcl_Interp *interp, /* Tcl interpreter. */ Tcl_Obj *listPtr, /* Pointer to the list being modified. */ int indexCount, /* Number of index args. */ Tcl_Obj *const indexArray[], /* Index args. */ Tcl_Obj *valuePtr) /* Value arg to 'lset' or NULL to 'lpop'. */ { int index, result, len; Tcl_Obj *subListPtr, *retValuePtr, *chainPtr; /* * If there are no indices, simply return the new value. (Without * indices, [lset] is a synonym for [set]. * [lpop] does not use this but protect for NULL valuePtr just in case. */ if (indexCount == 0) { if (valuePtr != NULL) { Tcl_IncrRefCount(valuePtr); } return valuePtr; } /* * If the list is shared, make a copy we can modify (copy-on-write). We * use Tcl_DuplicateObj() instead of TclListObjCopy() for a few reasons: * 1) we have not yet confirmed listPtr is actually a list; 2) We make a |
︙ | ︙ | |||
1542 1543 1544 1545 1546 1547 1548 | /* ...the index we're trying to use isn't an index at all. */ result = TCL_ERROR; indexArray++; break; } indexArray++; | | > | > | 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 | /* ...the index we're trying to use isn't an index at all. */ result = TCL_ERROR; indexArray++; break; } indexArray++; if (index < 0 || index > elemCount || (valuePtr == NULL && index >= elemCount)) { /* ...the index points outside the sublist. */ if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", valuePtr == NULL ? "LPOP" : "LSET", "BADINDEX", NULL); } result = TCL_ERROR; break; } /* |
︙ | ︙ | |||
1657 1658 1659 1660 1661 1662 1663 | * Store valuePtr in proper sublist and return. The -1 is to avoid a * compiler warning (not a problem because we checked that we have a * proper list - or something convertible to one - above). */ len = -1; TclListObjLength(NULL, subListPtr, &len); | > > | | 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 | * Store valuePtr in proper sublist and return. The -1 is to avoid a * compiler warning (not a problem because we checked that we have a * proper list - or something convertible to one - above). */ len = -1; TclListObjLength(NULL, subListPtr, &len); if (valuePtr == NULL) { Tcl_ListObjReplace(NULL, subListPtr, index, 1, 0, NULL); } else if (index == len) { Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr); } else { TclListObjSetElement(NULL, subListPtr, index, valuePtr); } TclInvalidateStringRep(subListPtr); Tcl_IncrRefCount(retValuePtr); return retValuePtr; |
︙ | ︙ |
Added tests/lpop.test.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 | # Commands covered: lpop # # 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) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } test lpop-1.1 {error conditions} -returnCodes error -body { lpop no } -result {can't read "no": no such variable} test lpop-1.2 {error conditions} -returnCodes error -body { lpop no 0 } -result {can't read "no": no such variable} test lpop-1.3 {error conditions} -returnCodes error -body { set no "x {}x" lpop no } -result {list element in braces followed by "x" instead of space} test lpop-1.4 {error conditions} -returnCodes error -body { set no "x y" lpop no -1 } -result {list index out of range} test lpop-1.5 {error conditions} -returnCodes error -body { set no "x y z" lpop no 3 } -result {list index out of range} ;#-errorCode {TCL OPERATION LPOP BADINDEX} test lpop-1.6 {error conditions} -returnCodes error -body { set no "x y" lpop no end+1 } -result {list index out of range} test lpop-1.7 {error conditions} -returnCodes error -body { set no "x y" lpop no {} } -match glob -result {bad index *} test lpop-1.8 {error conditions} -returnCodes error -body { set no "x y" lpop no 0 0 0 0 1 } -result {list index out of range} test lpop-1.9 {error conditions} -returnCodes error -body { set no "x y" lpop no {1 0} } -match glob -result {bad index *} test lpop-2.1 {basic functionality} -body { set l "x y z" list [lpop l 0] $l } -result {x {y z}} test lpop-2.2 {basic functionality} -body { set l "x y z" list [lpop l 1] $l } -result {y {x z}} test lpop-2.3 {basic functionality} -body { set l "x y z" list [lpop l] $l } -result {z {x y}} test lpop-2.4 {basic functionality} -body { set l "x y z" set l2 $l list [lpop l] $l $l2 } -result {z {x y} {x y z}} test lpop-3.1 {nested} -body { set l "x y" set l2 $l list [lpop l 0 0 0 0] $l $l2 } -result {x {{{{}}} y} {x y}} test lpop-3.2 {nested} -body { set l "{x y} {a b}" list [lpop l 0 1] $l } -result {y {x {a b}}} test lpop-3.3 {nested} -body { set l "{x y} {a b}" list [lpop l 1 0] $l } -result {a {{x y} b}} test lpop-99.1 {performance} -constraints perf -body { set l [lrepeat 10000 x] set l2 $l set t1 [time { while {[llength $l] >= 2} { lpop l end } }] set l [lrepeat 30000 x] set l2 $l set t2 [time { while {[llength $l] >= 2} { lpop l end } }] regexp {\d+} $t1 ms1 regexp {\d+} $t2 ms2 set ratio [expr {double($ms2)/$ms1}] # Deleting from end should have linear performance expr {$ratio > 4 ? $ratio : 4} } -result {4} test lpop-99.2 {performance} -constraints perf -body { set l [lrepeat 10000 x] set l2 $l set t1 [time { while {[llength $l] >= 2} { lpop l 1 } }] set l [lrepeat 30000 x] set l2 $l set t2 [time { while {[llength $l] >= 2} { lpop l 1 } }] regexp {\d+} $t1 ms1 regexp {\d+} $t2 ms2 set ratio [expr {double($ms2)/$ms1}] expr {$ratio > 10 ? $ratio : 10} } -result {10} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: |