Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | merge 8.6 |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | core-8-branch |
| Files: | files | file ages | folders |
| SHA3-256: |
8d5d6408321b802e31a50a99a9a07ba1 |
| User & Date: | dgp 2019-03-08 14:47:45 |
Context
|
2019-03-08
| ||
| 19:54 | Use mp_get_bit() instead of mp_iseven()/mp_isodd(): Those latter functions are macro's currently, bu... check-in: 0d77fb2374 user: jan.nijtmans tags: core-8-branch | |
| 14:56 | merge 8.7 check-in: 1dd923d0cf user: dgp tags: tip-445-api-fix | |
| 14:56 | merge 8.7 check-in: 839cfa7059 user: dgp tags: trunk | |
| 14:47 | merge 8.6 check-in: 8d5d640832 user: dgp tags: core-8-branch | |
| 14:46 | [39fed4dae5] Make sure return value from Tcl_PkgRequire*() survives long enough for caller to use it... check-in: 6bf2a6d132 user: dgp tags: core-8-6-branch | |
|
2019-03-07
| ||
| 21:59 | Fix gcc compiler warning check-in: c6f4b50fbf user: jan.nijtmans tags: core-8-branch | |
Changes
Changes to generic/tclPkg.c.
52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 ... 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 ... 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 ... 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 ... 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 ... 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 ... 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 ... 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 .... 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 .... 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 .... 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 |
* For each package that is known in any way to an interpreter, there is one
* record of the following type. These records are stored in the
* "packageTable" hash table in the interpreter, keyed by package name such as
* "Tk" (no version number).
*/
typedef struct Package {
char *version; /* Version that has been supplied in this
* interpreter via "package provide"
* (malloc'ed). NULL means the package doesn't
* exist in this interpreter yet. */
PkgAvail *availPtr; /* First in list of all available versions of
* this package. */
const void *clientData; /* Client data. */
} Package;
typedef struct Require {
void * clientDataPtr;
................................................................................
{
Package *pkgPtr;
char *pvi, *vi;
int res;
pkgPtr = FindPackage(interp, name);
if (pkgPtr->version == NULL) {
DupString(pkgPtr->version, version);
pkgPtr->clientData = clientData;
return TCL_OK;
}
if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi,
NULL) != TCL_OK) {
return TCL_ERROR;
} else if (CheckVersionAndConvert(interp, version, &vi, NULL) != TCL_OK) {
ckfree(pvi);
return TCL_ERROR;
}
................................................................................
if (clientData != NULL) {
pkgPtr->clientData = clientData;
}
return TCL_OK;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"conflicting versions provided for package \"%s\": %s, then %s",
name, pkgPtr->version, version));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL);
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
................................................................................
/*
* Translate between old and new API, and defer to the new function.
*/
if (version == NULL) {
if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) {
result = Tcl_GetStringResult(interp);
Tcl_ResetResult(interp);
}
} else {
if (exact && TCL_OK
!= CheckVersionAndConvert(interp, version, NULL, NULL)) {
return NULL;
}
ov = Tcl_NewStringObj(version, -1);
if (exact) {
Tcl_AppendStringsToObj(ov, "-", version, NULL);
}
Tcl_IncrRefCount(ov);
if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) {
result = Tcl_GetStringResult(interp);
Tcl_ResetResult(interp);
}
TclDecrRefCount(ov);
}
return result;
}
................................................................................
}
/*
* Ensure that the provided version meets the current requirements.
*/
if (reqc != 0) {
CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pkgVersionI, NULL);
satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);
ckfree(pkgVersionI);
if (!satisfies) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"version conflict for package \"%s\": have %s, need",
name, reqPtr->pkgPtr->version));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
NULL);
AddRequirementsToResult(interp, reqc, reqv);
return TCL_ERROR;
}
}
if (clientDataPtr) {
const void **ptr = (const void **) clientDataPtr;
*ptr = reqPtr->pkgPtr->clientData;
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(reqPtr->pkgPtr->version, -1));
return TCL_OK;
}
static int
PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result) {
ckfree(data[0]);
return result;
................................................................................
" no version of package %s provided",
name, versionToProvide, name));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
NULL);
} else {
char *pvi, *vi;
if (CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pvi,
NULL) != TCL_OK) {
result = TCL_ERROR;
} else if (CheckVersionAndConvert(interp,
versionToProvide, &vi, NULL) != TCL_OK) {
ckfree(pvi);
result = TCL_ERROR;
} else {
int res = CompareVersions(pvi, vi, NULL);
................................................................................
ckfree(vi);
if (res != 0) {
result = TCL_ERROR;
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"attempt to provide package %s %s failed:"
" package %s %s provided instead",
name, versionToProvide,
name, reqPtr->pkgPtr->version));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
"WRONGPROVIDE", NULL);
}
}
}
} else if (result != TCL_ERROR) {
Tcl_Obj *codePtr = Tcl_NewIntObj(result);
................................................................................
* This is consistent with our returning NULL. If we're not
* willing to tell our caller we got a particular version, we
* shouldn't store that version for telling future callers
* either.
*/
if (reqPtr->pkgPtr->version != NULL) {
ckfree(reqPtr->pkgPtr->version);
reqPtr->pkgPtr->version = NULL;
}
reqPtr->pkgPtr->clientData = NULL;
return result;
}
Tcl_NRAddCallback(interp, data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
................................................................................
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
if (hPtr == NULL) {
continue;
}
pkgPtr = Tcl_GetHashValue(hPtr);
Tcl_DeleteHashEntry(hPtr);
if (pkgPtr->version != NULL) {
ckfree(pkgPtr->version);
}
while (pkgPtr->availPtr != NULL) {
availPtr = pkgPtr->availPtr;
pkgPtr->availPtr = availPtr->nextPtr;
Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
if (availPtr->pkgIndex) {
................................................................................
}
argv2 = TclGetString(objv[2]);
if (objc == 3) {
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
if (hPtr != NULL) {
pkgPtr = Tcl_GetHashValue(hPtr);
if (pkgPtr->version != NULL) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj(pkgPtr->version, -1));
}
}
return TCL_OK;
}
argv3 = TclGetString(objv[3]);
if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) {
return TCL_ERROR;
................................................................................
Tcl_HashEntry *hPtr;
PkgAvail *availPtr;
for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
pkgPtr = Tcl_GetHashValue(hPtr);
if (pkgPtr->version != NULL) {
ckfree(pkgPtr->version);
}
while (pkgPtr->availPtr != NULL) {
availPtr = pkgPtr->availPtr;
pkgPtr->availPtr = availPtr->nextPtr;
Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
if (availPtr->pkgIndex) {
|
| < < < > | | | | | | > | | | | | | | | < | |
52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 ... 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 ... 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 ... 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 ... 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 ... 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 ... 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 ... 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 .... 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 .... 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 .... 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 |
* For each package that is known in any way to an interpreter, there is one
* record of the following type. These records are stored in the
* "packageTable" hash table in the interpreter, keyed by package name such as
* "Tk" (no version number).
*/
typedef struct Package {
Tcl_Obj *version;
PkgAvail *availPtr; /* First in list of all available versions of
* this package. */
const void *clientData; /* Client data. */
} Package;
typedef struct Require {
void * clientDataPtr;
................................................................................
{
Package *pkgPtr;
char *pvi, *vi;
int res;
pkgPtr = FindPackage(interp, name);
if (pkgPtr->version == NULL) {
pkgPtr->version = Tcl_NewStringObj(version, -1);
Tcl_IncrRefCount(pkgPtr->version);
pkgPtr->clientData = clientData;
return TCL_OK;
}
if (CheckVersionAndConvert(interp, Tcl_GetString(pkgPtr->version), &pvi,
NULL) != TCL_OK) {
return TCL_ERROR;
} else if (CheckVersionAndConvert(interp, version, &vi, NULL) != TCL_OK) {
ckfree(pvi);
return TCL_ERROR;
}
................................................................................
if (clientData != NULL) {
pkgPtr->clientData = clientData;
}
return TCL_OK;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"conflicting versions provided for package \"%s\": %s, then %s",
name, Tcl_GetString(pkgPtr->version), version));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL);
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
................................................................................
/*
* Translate between old and new API, and defer to the new function.
*/
if (version == NULL) {
if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) {
result = Tcl_GetString(Tcl_GetObjResult(interp));
Tcl_ResetResult(interp);
}
} else {
if (exact && TCL_OK
!= CheckVersionAndConvert(interp, version, NULL, NULL)) {
return NULL;
}
ov = Tcl_NewStringObj(version, -1);
if (exact) {
Tcl_AppendStringsToObj(ov, "-", version, NULL);
}
Tcl_IncrRefCount(ov);
if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) {
result = Tcl_GetString(Tcl_GetObjResult(interp));
Tcl_ResetResult(interp);
}
TclDecrRefCount(ov);
}
return result;
}
................................................................................
}
/*
* Ensure that the provided version meets the current requirements.
*/
if (reqc != 0) {
CheckVersionAndConvert(interp, Tcl_GetString(reqPtr->pkgPtr->version),
&pkgVersionI, NULL);
satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);
ckfree(pkgVersionI);
if (!satisfies) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"version conflict for package \"%s\": have %s, need",
name, Tcl_GetString(reqPtr->pkgPtr->version)));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
NULL);
AddRequirementsToResult(interp, reqc, reqv);
return TCL_ERROR;
}
}
if (clientDataPtr) {
const void **ptr = (const void **) clientDataPtr;
*ptr = reqPtr->pkgPtr->clientData;
}
Tcl_SetObjResult(interp, reqPtr->pkgPtr->version);
return TCL_OK;
}
static int
PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result) {
ckfree(data[0]);
return result;
................................................................................
" no version of package %s provided",
name, versionToProvide, name));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
NULL);
} else {
char *pvi, *vi;
if (TCL_OK != CheckVersionAndConvert(interp,
Tcl_GetString(reqPtr->pkgPtr->version), &pvi, NULL)) {
result = TCL_ERROR;
} else if (CheckVersionAndConvert(interp,
versionToProvide, &vi, NULL) != TCL_OK) {
ckfree(pvi);
result = TCL_ERROR;
} else {
int res = CompareVersions(pvi, vi, NULL);
................................................................................
ckfree(vi);
if (res != 0) {
result = TCL_ERROR;
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"attempt to provide package %s %s failed:"
" package %s %s provided instead",
name, versionToProvide,
name, Tcl_GetString(reqPtr->pkgPtr->version)));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
"WRONGPROVIDE", NULL);
}
}
}
} else if (result != TCL_ERROR) {
Tcl_Obj *codePtr = Tcl_NewIntObj(result);
................................................................................
* This is consistent with our returning NULL. If we're not
* willing to tell our caller we got a particular version, we
* shouldn't store that version for telling future callers
* either.
*/
if (reqPtr->pkgPtr->version != NULL) {
Tcl_DecrRefCount(reqPtr->pkgPtr->version);
reqPtr->pkgPtr->version = NULL;
}
reqPtr->pkgPtr->clientData = NULL;
return result;
}
Tcl_NRAddCallback(interp, data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
................................................................................
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
if (hPtr == NULL) {
continue;
}
pkgPtr = Tcl_GetHashValue(hPtr);
Tcl_DeleteHashEntry(hPtr);
if (pkgPtr->version != NULL) {
Tcl_DecrRefCount(pkgPtr->version);
}
while (pkgPtr->availPtr != NULL) {
availPtr = pkgPtr->availPtr;
pkgPtr->availPtr = availPtr->nextPtr;
Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
if (availPtr->pkgIndex) {
................................................................................
}
argv2 = TclGetString(objv[2]);
if (objc == 3) {
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
if (hPtr != NULL) {
pkgPtr = Tcl_GetHashValue(hPtr);
if (pkgPtr->version != NULL) {
Tcl_SetObjResult(interp, pkgPtr->version);
}
}
return TCL_OK;
}
argv3 = TclGetString(objv[3]);
if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) {
return TCL_ERROR;
................................................................................
Tcl_HashEntry *hPtr;
PkgAvail *availPtr;
for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
pkgPtr = Tcl_GetHashValue(hPtr);
if (pkgPtr->version != NULL) {
Tcl_DecrRefCount(pkgPtr->version);
}
while (pkgPtr->availPtr != NULL) {
availPtr = pkgPtr->availPtr;
pkgPtr->availPtr = availPtr->nextPtr;
Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
if (availPtr->pkgIndex) {
|
Changes to generic/tclTestProcBodyObj.c.
17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 .. 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 ... 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 |
#include "tclInt.h" /* * name and version of this package */ static const char packageName[] = "procbodytest"; static const char packageVersion[] = "1.0"; /* * Name of the commands exported by this package */ static const char procCommand[] = "proc"; /* * this struct describes an entry in the table of command names and command * procs */ typedef struct CmdTable { ................................................................................ } CmdTable; /* * Declarations for functions defined in this file. */ static int ProcBodyTestProcObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe); static int RegisterCommand(Tcl_Interp* interp, const char *namespace, const CmdTable *cmdTablePtr); /* * List of commands to create when the package is loaded; must go after the * declarations of the enable command procedure. */ static const CmdTable commands[] = { { procCommand, ProcBodyTestProcObjCmd, 1 }, { 0, 0, 0 } }; static const CmdTable safeCommands[] = { { procCommand, ProcBodyTestProcObjCmd, 1 }, { 0, 0, 0 } }; /* *---------------------------------------------------------------------- * * Procbodytest_Init -- ................................................................................ myobjv[4] = NULL; result = Tcl_ProcObjCmd(NULL, interp, objc, myobjv); Tcl_DecrRefCount(bodyObjPtr); return result; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > |
17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 .. 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 ... 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 |
#include "tclInt.h" /* * name and version of this package */ static const char packageName[] = "procbodytest"; static const char packageVersion[] = "1.1"; /* * Name of the commands exported by this package */ static const char procCommand[] = "proc"; static const char checkCommand[] = "check"; /* * this struct describes an entry in the table of command names and command * procs */ typedef struct CmdTable { ................................................................................ } CmdTable; /* * Declarations for functions defined in this file. */ static int ProcBodyTestProcObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ProcBodyTestCheckObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe); static int RegisterCommand(Tcl_Interp* interp, const char *namespace, const CmdTable *cmdTablePtr); /* * List of commands to create when the package is loaded; must go after the * declarations of the enable command procedure. */ static const CmdTable commands[] = { { procCommand, ProcBodyTestProcObjCmd, 1 }, { checkCommand, ProcBodyTestCheckObjCmd, 1 }, { 0, 0, 0 } }; static const CmdTable safeCommands[] = { { procCommand, ProcBodyTestProcObjCmd, 1 }, { checkCommand, ProcBodyTestCheckObjCmd, 1 }, { 0, 0, 0 } }; /* *---------------------------------------------------------------------- * * Procbodytest_Init -- ................................................................................ myobjv[4] = NULL; result = Tcl_ProcObjCmd(NULL, interp, objc, myobjv); Tcl_DecrRefCount(bodyObjPtr); return result; } /* *---------------------------------------------------------------------- * * ProcBodyTestCheckObjCmd -- * * Implements the "procbodytest::check" command. Here is the command * description: * procbodytest::check * * Performs an internal check that the Tcl_PkgPresent() command returns * the same version number as was registered when the procbodytest package * was provided. Places a boolean in the interp result indicating the * test outcome. * * Results: * Returns a standard Tcl code. * *---------------------------------------------------------------------- */ static int ProcBodyTestCheckObjCmd( ClientData dummy, /* context; not used */ Tcl_Interp *interp, /* the current interpreter */ int objc, /* argument count */ Tcl_Obj *const objv[]) /* arguments */ { const char *version; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } version = Tcl_PkgPresent(interp, packageName, packageVersion, 1); Tcl_SetObjResult(interp, Tcl_NewBooleanObj( strcmp(version, packageVersion) == 0)); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to tests-perf/timer-event.perf.tcl.
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 |
setup {set le $i; incr i; list $le .. 1; # cancel up to $howmuch events}
{after cancel $ev([incr i -1]); if {$i <= 1} break}
cleanup {update; unset -nocomplain ev}
# cancel forwards "after 0" / $howmuch timer-events in queue:
setup {set i 0; timerate {set ev([incr i]) [after 0 {set foo bar}]} {*}$reptime}
setup {set le $i; set i 0; list 1 .. $le; # cancel up to $howmuch events}
{after cancel $ev([incr i]); if {$i >= $howmuch} break}
cleanup {update; unset -nocomplain ev}
# cancel backwards "after 0" / $howmuch timer-events in queue:
setup {set i 0; timerate {set ev([incr i]) [after 0 {set foo bar}]} {*}$reptime}
setup {set le $i; incr i; list $le .. 1; # cancel up to $howmuch events}
{after cancel $ev([incr i -1]); if {$i <= 1} break}
cleanup {update; unset -nocomplain ev}
|
| |
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 |
setup {set le $i; incr i; list $le .. 1; # cancel up to $howmuch events}
{after cancel $ev([incr i -1]); if {$i <= 1} break}
cleanup {update; unset -nocomplain ev}
# cancel forwards "after 0" / $howmuch timer-events in queue:
setup {set i 0; timerate {set ev([incr i]) [after 0 {set foo bar}]} {*}$reptime}
setup {set le $i; set i 0; list 1 .. $le; # cancel up to $howmuch events}
{after cancel $ev([incr i]); if {$i >= $le} break}
cleanup {update; unset -nocomplain ev}
# cancel backwards "after 0" / $howmuch timer-events in queue:
setup {set i 0; timerate {set ev([incr i]) [after 0 {set foo bar}]} {*}$reptime}
setup {set le $i; incr i; list $le .. 1; # cancel up to $howmuch events}
{after cancel $ev([incr i -1]); if {$i <= 1} break}
cleanup {update; unset -nocomplain ev}
|
Changes to tests/proc.test.
317 318 319 320 321 322 323 324 325 326 327 328 329 330 |
set end [getbytes]
}
set leakedBytes [expr {$end - $tmp}]
} -cleanup {
rename getbytes {}
unset -nocomplain end i tmp leakedBytes
} -result 0
test proc-5.1 {Bytecompiling noop; test for correct argument substitution} -body {
proc p args {} ; # this will be bytecompiled into t
proc t {} {
set res {}
set a 0
set b 0
|
> > > |
317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 |
set end [getbytes]
}
set leakedBytes [expr {$end - $tmp}]
} -cleanup {
rename getbytes {}
unset -nocomplain end i tmp leakedBytes
} -result 0
test proc-4.9 {[39fed4dae5] Valid Tcl_PkgPresent return} procbodytest {
procbodytest::check
} 1
test proc-5.1 {Bytecompiling noop; test for correct argument substitution} -body {
proc p args {} ; # this will be bytecompiled into t
proc t {} {
set res {}
set a 0
set b 0
|