diff options
-rw-r--r-- | jim-aio.c | 2 | ||||
-rw-r--r-- | jim-eventloop.c | 312 | ||||
-rw-r--r-- | jim-eventloop.h | 1 | ||||
-rw-r--r-- | jim.c | 36 | ||||
-rw-r--r-- | jim.h | 5 | ||||
-rw-r--r-- | jim_tcl.txt | 156 | ||||
-rw-r--r-- | tests/event.test | 117 | ||||
-rw-r--r-- | tests/testing.tcl | 15 | ||||
-rw-r--r-- | tests/timer.test | 455 |
9 files changed, 887 insertions, 212 deletions
@@ -4,7 +4,7 @@ * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org> * Copyright 2005 Clemens Hintze <c.hintze@gmx.net> * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net> - * Copyright 2008 oharboe - o/yvind Harboe - oyvind.harboe@zylin.com + * Copyright 2008 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com * Copyright 2008 Andrew Lunn <andrew@lunn.ch> * Copyright 2008 Duane Ellis <openocd@duaneellis.com> * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de> diff --git a/jim-eventloop.c b/jim-eventloop.c index 0f34dd3..992b607 100644 --- a/jim-eventloop.c +++ b/jim-eventloop.c @@ -4,7 +4,7 @@ * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org> * Copyright 2005 Clemens Hintze <c.hintze@gmx.net> * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net> - * Copyright 2008 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com + * Copyright 2008 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com * Copyright 2008 Andrew Lunn <andrew@lunn.ch> * Copyright 2008 Duane Ellis <openocd@duaneellis.com> * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de> @@ -91,8 +91,49 @@ typedef struct Jim_EventLoop jim_wide timeEventNextId; Jim_FileEvent *fileEventHead; Jim_TimeEvent *timeEventHead; + int suppress_bgerror; /* bgerror returned break, so don't call it again */ } Jim_EventLoop; +static void JimAfterTimeHandler(Jim_Interp *interp, void *clientData); +static void JimAfterTimeEventFinalizer(Jim_Interp *interp, void *clientData); + +int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr) +{ + Jim_EventLoop *eventLoop = Jim_GetAssocData(interp, "eventloop"); + Jim_CallFrame *savedFramePtr; + int retval; + + savedFramePtr = interp->framePtr; + interp->framePtr = interp->topFramePtr; + retval = Jim_EvalObj(interp, scriptObjPtr); + interp->framePtr = savedFramePtr; + /* Try to report the error (if any) via the bgerror proc */ + if (retval != JIM_OK && !eventLoop->suppress_bgerror) { + Jim_Obj *objv[2]; + int rc = JIM_ERR; + + objv[0] = Jim_NewStringObj(interp, "bgerror", -1); + objv[1] = Jim_GetResult(interp); + Jim_IncrRefCount(objv[0]); + Jim_IncrRefCount(objv[1]); + if (Jim_GetCommand(interp, objv[0], JIM_NONE) == NULL || (rc = Jim_EvalObjVector(interp, 2, objv)) != JIM_OK) { + if (rc == JIM_BREAK) { + /* No more bgerror calls */ + eventLoop->suppress_bgerror++; + } + else { + /* Report the error to stderr. */ + fprintf(stderr, "Background error:" JIM_NL); + Jim_PrintErrorMessage(interp); + } + } + Jim_DecrRefCount(interp, objv[0]); + Jim_DecrRefCount(interp, objv[1]); + } + return retval; +} + + void Jim_CreateFileHandler(Jim_Interp *interp, FILE * handle, int mask, Jim_FileProc * proc, void *clientData, Jim_EventFinalizerProc * finalizerProc) { @@ -147,7 +188,7 @@ jim_wide Jim_CreateTimeHandler(Jim_Interp *interp, jim_wide milliseconds, { Jim_EventLoop *eventLoop = Jim_GetAssocData(interp, "eventloop"); jim_wide id = eventLoop->timeEventNextId++; - Jim_TimeEvent *te; + Jim_TimeEvent *te, *e, *prev; long cur_sec, cur_ms; JimGetTime(&cur_sec, &cur_ms); @@ -165,61 +206,117 @@ jim_wide Jim_CreateTimeHandler(Jim_Interp *interp, jim_wide milliseconds, te->timeProc = proc; te->finalizerProc = finalizerProc; te->clientData = clientData; + + /* Add to the appropriate place in the list */ + if (eventLoop->timeEventHead) { + prev = NULL; + for (e = eventLoop->timeEventHead; e; e = e->next) { + if (te->when_sec < e->when_sec || (te->when_sec == e->when_sec && te->when_ms < e->when_ms)) { + break; + } + prev = e; + } + if (prev) { + te->next = prev->next; + prev->next = te; + return id; + } + } + te->next = eventLoop->timeEventHead; eventLoop->timeEventHead = te; + return id; } -jim_wide Jim_DeleteTimeHandler(Jim_Interp *interp, jim_wide id) +static jim_wide JimParseAfterId(Jim_Obj *idObj) { - Jim_TimeEvent *te, *prev = NULL; - Jim_EventLoop *eventLoop = Jim_GetAssocData(interp, "eventloop"); - long cur_sec, cur_ms; - jim_wide remain; + int len; + const char *tok = Jim_GetString(idObj, &len); + jim_wide id; - JimGetTime(&cur_sec, &cur_ms); + if (strncmp(tok, "after#", 6) == 0 && Jim_StringToWide(tok + 6, &id, 10) == JIM_OK) { + /* Got an event by id */ + return id; + } + return -1; +} - te = eventLoop->timeEventHead; - if (id >= eventLoop->timeEventNextId) { - return -2; /* wrong event ID */ +static jim_wide JimFindAfterByScript(Jim_EventLoop *eventLoop, Jim_Obj *scriptObj) +{ + Jim_TimeEvent *te; + + for (te = eventLoop->timeEventHead; te; te = te->next) { + /* Is this an 'after' event? */ + if (te->timeProc == JimAfterTimeHandler) { + if (Jim_StringCompareObj(scriptObj, te->clientData, 0) == 0) { + return te->id; + } + } } - while (te) { + return -1; /* NO event with the specified ID found */ +} + +static Jim_TimeEvent *JimFindTimeHandlerById(Jim_EventLoop *eventLoop, jim_wide id) +{ + Jim_TimeEvent *te; + + for (te = eventLoop->timeEventHead; te; te = te->next) { if (te->id == id) { - remain = (te->when_sec - cur_sec) * 1000; - remain += (te->when_ms - cur_ms); - remain = (remain < 0) ? 0 : remain; + return te; + } + } + return NULL; +} + +static Jim_TimeEvent *Jim_RemoveTimeHandler(Jim_EventLoop *eventLoop, jim_wide id) +{ + Jim_TimeEvent *te, *prev = NULL; + for (te = eventLoop->timeEventHead; te; te = te->next) { + if (te->id == id) { if (prev == NULL) eventLoop->timeEventHead = te->next; else prev->next = te->next; - if (te->finalizerProc) - te->finalizerProc(interp, te->clientData); - Jim_Free(te); - return remain; + return te; } prev = te; - te = te->next; } - return -1; /* NO event with the specified ID found */ + return NULL; } -/* Search the first timer to fire. - * This operation is useful to know how many time the select can be - * put in sleep without to delay any event. - * If there are no timers NULL is returned. */ -static Jim_TimeEvent *JimSearchNearestTimer(Jim_EventLoop * eventLoop) +static void Jim_FreeTimeHandler(Jim_Interp *interp, Jim_TimeEvent *te) { - Jim_TimeEvent *te = eventLoop->timeEventHead; - Jim_TimeEvent *nearest = NULL; + if (te->finalizerProc) + te->finalizerProc(interp, te->clientData); + Jim_Free(te); +} - while (te) { - if (!nearest || te->when_sec < nearest->when_sec || - (te->when_sec == nearest->when_sec && te->when_ms < nearest->when_ms)) - nearest = te; - te = te->next; +jim_wide Jim_DeleteTimeHandler(Jim_Interp *interp, jim_wide id) +{ + Jim_TimeEvent *te; + Jim_EventLoop *eventLoop = Jim_GetAssocData(interp, "eventloop"); + + if (id >= eventLoop->timeEventNextId) { + return -2; /* wrong event ID */ } - return nearest; + + te = Jim_RemoveTimeHandler(eventLoop, id); + if (te) { + jim_wide remain; + long cur_sec, cur_ms; + + JimGetTime(&cur_sec, &cur_ms); + + remain = (te->when_sec - cur_sec) * 1000; + remain += (te->when_ms - cur_ms); + remain = (remain < 0) ? 0 : remain; + + Jim_FreeTimeHandler(interp, te); + return remain; + } + return -1; /* NO event with the specified ID found */ } /* --- POSIX version of Jim_ProcessEvents, for now the only available --- */ @@ -282,12 +379,18 @@ int Jim_ProcessEvents(Jim_Interp *interp, int flags) * to fire. */ if (numfd || ((flags & JIM_TIME_EVENTS) && !(flags & JIM_DONT_WAIT))) { int retval; - Jim_TimeEvent *shortest; struct timeval tv, *tvp; jim_wide dt; - shortest = JimSearchNearestTimer(eventLoop); - if (shortest) { + if (flags & JIM_DONT_WAIT) { + /* Wait no time */ + tvp = &tv; + tvp->tv_sec = 0; + tvp->tv_usec = 0; + } + /* The nearest timer is always at the head of the list */ + else if (eventLoop->timeEventHead) { + Jim_TimeEvent *shortest = eventLoop->timeEventHead; long now_sec, now_ms; /* Calculate the time missing for the nearest @@ -364,6 +467,8 @@ int Jim_ProcessEvents(Jim_Interp *interp, int flags) JimGetTime(&now_sec, &now_ms); if (now_sec > te->when_sec || (now_sec == te->when_sec && now_ms >= te->when_ms)) { id = te->id; + /* Remove from the list before executing */ + Jim_RemoveTimeHandler(eventLoop, id); te->timeProc(interp, te->clientData); /* After an event is processed our time event list may * no longer be the same, so we restart from head. @@ -371,8 +476,10 @@ int Jim_ProcessEvents(Jim_Interp *interp, int flags) * by event handlers itself in order to don't loop forever * even in case an [after 0] that continuously register * itself. To do so we saved the max ID we want to handle. */ - Jim_DeleteTimeHandler(interp, id); + Jim_FreeTimeHandler(interp, te); + te = eventLoop->timeEventHead; + processed++; } else { te = te->next; @@ -413,6 +520,7 @@ void JimELAssocDataDeleProc(Jim_Interp *interp, void *data) static int JimELVwaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { + Jim_EventLoop *eventLoop = Jim_CmdPrivData(interp); Jim_Obj *oldValue; if (argc != 2) { @@ -420,8 +528,6 @@ static int JimELVwaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) return JIM_ERR; } - interp->suppress_bgerror = 0; - oldValue = Jim_GetGlobalVariable(interp, argv[1], JIM_NONE); if (oldValue) { Jim_IncrRefCount(oldValue); @@ -434,6 +540,9 @@ static int JimELVwaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) return JIM_ERR; } } + + eventLoop->suppress_bgerror = 0; + while (1) { Jim_Obj *currValue; @@ -456,14 +565,40 @@ static int JimELVwaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) return JIM_OK; } -void JimAfterTimeHandler(Jim_Interp *interp, void *clientData) +static int JimELUpdateCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_EventLoop *eventLoop = Jim_CmdPrivData(interp); + static const char *options[] = { + "idletasks", NULL + }; + enum { UPDATE_IDLE, UPDATE_NONE }; + int option = UPDATE_NONE; + int flags = JIM_TIME_EVENTS; + + if (argc == 1) { + flags = JIM_ALL_EVENTS; + } + else if (argc > 2 || Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) { + Jim_WrongNumArgs(interp, 1, argv, "?idletasks?"); + return JIM_ERR; + } + + eventLoop->suppress_bgerror = 0; + + while (Jim_ProcessEvents(interp, flags | JIM_DONT_WAIT) > 0) { + } + + return JIM_OK; +} + +static void JimAfterTimeHandler(Jim_Interp *interp, void *clientData) { Jim_Obj *objPtr = clientData; Jim_EvalObjBackground(interp, objPtr); } -void JimAfterTimeEventFinalizer(Jim_Interp *interp, void *clientData) +static void JimAfterTimeEventFinalizer(Jim_Interp *interp, void *clientData) { Jim_Obj *objPtr = clientData; @@ -472,23 +607,25 @@ void JimAfterTimeEventFinalizer(Jim_Interp *interp, void *clientData) static int JimELAfterCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - jim_wide ms, id; + Jim_EventLoop *eventLoop = Jim_CmdPrivData(interp); + jim_wide ms = 0, id; Jim_Obj *objPtr, *idObjPtr; const char *options[] = { - "cancel", NULL + "cancel", "info", "idle", NULL }; enum - { AFTER_CANCEL, AFTER_INFO, AFTER_RESTART, AFTER_EXPIRE, AFTER_CREATE }; + { AFTER_CANCEL, AFTER_INFO, AFTER_IDLE, AFTER_RESTART, AFTER_EXPIRE, AFTER_CREATE }; int option = AFTER_CREATE; if (argc < 2) { - Jim_WrongNumArgs(interp, 1, argv, "<after milliseconds> ?script|cancel <id>?"); + Jim_WrongNumArgs(interp, 1, argv, "option ?arg ...?"); return JIM_ERR; } if (Jim_GetWide(interp, argv[1], &ms) != JIM_OK) { - if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG) != JIM_OK) { + if (Jim_GetEnum(interp, argv[1], options, &option, "argument", JIM_ERRMSG) != JIM_OK) { return JIM_ERR; } + Jim_SetEmptyResult(interp); } else if (argc == 2) { /* Simply a sleep */ @@ -496,10 +633,18 @@ static int JimELAfterCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) usleep((ms % 1000) * 1000); return JIM_OK; } + switch (option) { - case AFTER_CREATE: - Jim_IncrRefCount(argv[2]); - id = Jim_CreateTimeHandler(interp, ms, JimAfterTimeHandler, argv[2], + case AFTER_IDLE: + if (argc < 3) { + Jim_WrongNumArgs(interp, 2, argv, "script ?script ...?"); + return JIM_ERR; + } + /* fall through */ + case AFTER_CREATE: { + Jim_Obj *scriptObj = Jim_ConcatObj(interp, argc - 2, argv + 2); + Jim_IncrRefCount(scriptObj); + id = Jim_CreateTimeHandler(interp, ms, JimAfterTimeHandler, scriptObj, JimAfterTimeEventFinalizer); objPtr = Jim_NewStringObj(interp, NULL, 0); Jim_AppendString(interp, objPtr, "after#", -1); @@ -509,21 +654,66 @@ static int JimELAfterCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) Jim_DecrRefCount(interp, idObjPtr); Jim_SetResult(interp, objPtr); return JIM_OK; - case AFTER_CANCEL:{ - int tlen; + } + case AFTER_CANCEL: + if (argc < 3) { + Jim_WrongNumArgs(interp, 2, argv, "id|command"); + return JIM_ERR; + } + else { jim_wide remain = 0; - const char *tok = Jim_GetString(argv[2], &tlen); - if (strncmp(tok, "after#", 6) == 0 && Jim_StringToWide(tok + 6, &id, 10) == JIM_OK) { - remain = Jim_DeleteTimeHandler(interp, id); - if (remain > -2) { - Jim_SetResult(interp, Jim_NewIntObj(interp, remain)); + id = JimParseAfterId(argv[2]); + if (id < 0) { + /* Not an event id, so search by script */ + Jim_Obj *scriptObj = Jim_ConcatObj(interp, argc - 2, argv + 2); + id = JimFindAfterByScript(eventLoop, scriptObj); + Jim_FreeNewObj(interp, scriptObj); + if (id < 0) { + /* Not found */ + break; + } + } + remain = Jim_DeleteTimeHandler(interp, id); + if (remain >= 0) { + Jim_SetResultInt(interp, remain); + } + } + break; + + case AFTER_INFO: + if (argc == 2) { + Jim_TimeEvent *te = eventLoop->timeEventHead; + Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0); + char buf[30]; + + while (te) { + snprintf(buf, sizeof(buf), "after#%" JIM_WIDE_MODIFIER, te->id); + Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, buf, -1)); + te = te->next; + } + Jim_SetResult(interp, listObj); + } + else if (argc == 3) { + jim_wide id = JimParseAfterId(argv[2]); + if (id >= 0) { + Jim_TimeEvent *e = JimFindTimeHandlerById(eventLoop, id); + if (e && e->timeProc == JimAfterTimeHandler) { + Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0); + Jim_ListAppendElement(interp, listObj, e->clientData); + Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, e->initialms ? "timer" : "idle", -1)); + Jim_SetResult(interp, listObj); return JIM_OK; } } - Jim_SetResultString(interp, "invalid event", -1); + Jim_SetResultFormatted(interp, "event \"%#s\" doesn't exist", argv[2]); return JIM_ERR; } + else { + Jim_WrongNumArgs(interp, 2, argv, "?id?"); + return JIM_ERR; + } + break; } return JIM_OK; } @@ -536,10 +726,12 @@ int Jim_eventloopInit(Jim_Interp *interp) eventLoop->fileEventHead = NULL; eventLoop->timeEventHead = NULL; eventLoop->timeEventNextId = 1; + eventLoop->suppress_bgerror = 0; Jim_SetAssocData(interp, "eventloop", JimELAssocDataDeleProc, eventLoop); - Jim_CreateCommand(interp, "vwait", JimELVwaitCommand, NULL, NULL); - Jim_CreateCommand(interp, "after", JimELAfterCommand, NULL, NULL); + Jim_CreateCommand(interp, "vwait", JimELVwaitCommand, eventLoop, NULL); + Jim_CreateCommand(interp, "update", JimELUpdateCommand, eventLoop, NULL); + Jim_CreateCommand(interp, "after", JimELAfterCommand, eventLoop, NULL); return JIM_OK; } diff --git a/jim-eventloop.h b/jim-eventloop.h index 0b81627..42f20c9 100644 --- a/jim-eventloop.h +++ b/jim-eventloop.h @@ -83,6 +83,7 @@ JIM_EXPORT jim_wide Jim_DeleteTimeHandler (Jim_Interp *interp, jim_wide id); #define JIM_DONT_WAIT 4 JIM_EXPORT int Jim_ProcessEvents (Jim_Interp *interp, int flags); +JIM_EXPORT int Jim_EvalObjBackground (Jim_Interp *interp, Jim_Obj *scriptObjPtr); int Jim_eventloopInit(Jim_Interp *interp); @@ -4670,7 +4670,6 @@ Jim_Interp *Jim_CreateInterp(void) i->unknown = Jim_NewStringObj(i, "unknown", -1); i->unknown_called = 0; i->errorProc = i->emptyObj; - i->suppress_bgerror = 0; i->currentScriptObj = Jim_NewEmptyStringObj(i); Jim_IncrRefCount(i->emptyObj); Jim_IncrRefCount(i->result); @@ -9877,41 +9876,6 @@ int Jim_EvalGlobal(Jim_Interp *interp, const char *script) return retval; } -int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr) -{ - Jim_CallFrame *savedFramePtr; - int retval; - - savedFramePtr = interp->framePtr; - interp->framePtr = interp->topFramePtr; - retval = Jim_EvalObj(interp, scriptObjPtr); - interp->framePtr = savedFramePtr; - /* Try to report the error (if any) via the bgerror proc */ - if (retval != JIM_OK && !interp->suppress_bgerror) { - Jim_Obj *objv[2]; - int rc = JIM_ERR; - - objv[0] = Jim_NewStringObj(interp, "bgerror", -1); - objv[1] = Jim_GetResult(interp); - Jim_IncrRefCount(objv[0]); - Jim_IncrRefCount(objv[1]); - if (Jim_GetCommand(interp, objv[0], JIM_NONE) == NULL || (rc = Jim_EvalObjVector(interp, 2, objv)) != JIM_OK) { - if (rc == JIM_BREAK) { - /* No more bgerror calls */ - interp->suppress_bgerror++; - } - else { - /* Report the error to stderr. */ - fprintf(stderr, "Background error:" JIM_NL); - Jim_PrintErrorMessage(interp); - } - } - Jim_DecrRefCount(interp, objv[0]); - Jim_DecrRefCount(interp, objv[1]); - } - return retval; -} - #include <sys/stat.h> int Jim_EvalFile(Jim_Interp *interp, const char *filename) @@ -541,7 +541,6 @@ typedef struct Jim_Interp { Jim_Obj *unknown; /* Unknown command cache */ int unknown_called; /* The unknown command has been invoked */ int errorFlag; /* Set if an error occurred during execution. */ - int suppress_bgerror; /* bgerror returned break, so don't call it again */ void *cmdPrivData; /* Used to pass the private data pointer to a command. It is set to what the user specified via Jim_CreateCommand(). */ @@ -623,8 +622,6 @@ JIM_EXPORT int Jim_Eval_Named(Jim_Interp *interp, const char *script,const char JIM_EXPORT int Jim_EvalGlobal(Jim_Interp *interp, const char *script); JIM_EXPORT int Jim_EvalFile(Jim_Interp *interp, const char *filename); JIM_EXPORT int Jim_EvalObj (Jim_Interp *interp, Jim_Obj *scriptObjPtr); -JIM_EXPORT int Jim_EvalObjBackground (Jim_Interp *interp, - Jim_Obj *scriptObjPtr); JIM_EXPORT int Jim_EvalObjVector (Jim_Interp *interp, int objc, Jim_Obj *const *objv); JIM_EXPORT int Jim_SubstObj (Jim_Interp *interp, Jim_Obj *substObjPtr, @@ -695,6 +692,8 @@ JIM_EXPORT Jim_Obj * Jim_ScanString (Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags); JIM_EXPORT int Jim_CompareStringImmediate (Jim_Interp *interp, Jim_Obj *objPtr, const char *str); +JIM_EXPORT int Jim_StringCompareObj(Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, + int nocase); /* reference object */ JIM_EXPORT Jim_Obj * Jim_NewReference (Jim_Interp *interp, diff --git a/jim_tcl.txt b/jim_tcl.txt index 9deb38a..d76b6c9 100644 --- a/jim_tcl.txt +++ b/jim_tcl.txt @@ -53,8 +53,8 @@ The major differences are: 16. Support for "static" variables in procedures 17. Significantly faster for many scripts/operations 18. Support for tail-call optimisation, 'tailcall' -20. Variable traces are not supported -21. The history command is not supported +19. Variable traces are not supported +20. The history command is not supported CHANGES ------- @@ -79,7 +79,7 @@ Since v0.62: 17. 'exec' now sets $::errorCode, and catch sets opts(-errorcode) for exit status 18. Command pipelines via open "|..." are now supported 19. Add 'info references' -20. Add support for 'after *ms*' +20. Add support for 'after *ms*', 'after idle', 'after info', 'update' Since v0.61: @@ -1552,7 +1552,7 @@ the key +-level+ will be the current return level (see 'return if {[catch {...} msg opts]} { ...maybe do something with the error... - incr opts(-level) + incr opts(-level) return {*}$opts $msg } @@ -1892,30 +1892,30 @@ If the command fails, the global $::errorCode (and the -errorcode option in 'catch') will be set to a list, as follows: +*CHILDKILLED* 'pid sigName msg'+:: - This format is used when a child process has been killed - because of a signal. The pid element will be the process's - identifier (in decimal). The sigName element will be the - symbolic name of the signal that caused the process to - terminate; it will be one of the names from the include - file signal.h, such as SIGPIPE. The msg element will be a - short human-readable message describing the signal, such - as "write on pipe with no readers" for SIGPIPE. + This format is used when a child process has been killed + because of a signal. The pid element will be the process's + identifier (in decimal). The sigName element will be the + symbolic name of the signal that caused the process to + terminate; it will be one of the names from the include + file signal.h, such as SIGPIPE. The msg element will be a + short human-readable message describing the signal, such + as "write on pipe with no readers" for SIGPIPE. +*CHILDSUSP* 'pid sigName msg'+:: - This format is used when a child process has been suspended - because of a signal. The pid element will be the process's - identifier, in decimal. The sigName element will be the - symbolic name of the signal that caused the process to - suspend; this will be one of the names from the include - file signal.h, such as SIGTTIN. The msg element will be a - short human-readable message describing the signal, such - as "background tty read" for SIGTTIN. + This format is used when a child process has been suspended + because of a signal. The pid element will be the process's + identifier, in decimal. The sigName element will be the + symbolic name of the signal that caused the process to + suspend; this will be one of the names from the include + file signal.h, such as SIGTTIN. The msg element will be a + short human-readable message describing the signal, such + as "background tty read" for SIGTTIN. +*CHILDSTATUS* 'pid code'+:: - This format is used when a child process has exited with a - non-zero exit status. The pid element will be the process's - identifier (in decimal) and the code element will be the - exit code returned by the process (also in decimal). + This format is used when a child process has exited with a + non-zero exit status. The pid element will be the process's + identifier (in decimal) and the code element will be the + exit code returned by the process (also in decimal). exit ~~~~ @@ -2400,8 +2400,8 @@ The legal *option*'s (which may be abbreviated) are: 'string match'. +*info references*+:: - Returns a list of all references which have not yet been garbage - collected. + Returns a list of all references which have not yet been garbage + collected. +*info returncodes* ?'code'?+:: Returns a list representing the mapping of standard return codes @@ -2523,28 +2523,28 @@ In this example, a local procedure is created. Note that the procedure continues to have global scope while it is active. proc outer {} { - # proc ... returns "inner" which is marked local + # proc ... returns "inner" which is marked local local proc inner {} { - # will be deleted when 'outer' exits - } + # will be deleted when 'outer' exits + } - inner - ... - } + inner + ... + } In this example, the lambda is deleted at the end of the procedure rather than waiting until garbage collection. proc outer {} { set x [lambda inner {args} { - # will be deleted when 'outer' exits - }] - # Use 'function' here which simply returns $x - local function $x + # will be deleted when 'outer' exits + }] + # Use 'function' here which simply returns $x + local function $x - $x ... - ... - } + $x ... + ... + } lindex ~~~~~~ @@ -4041,8 +4041,8 @@ aio If *addrvar* is specified, the sending address of the message is stored in the named variable in the form 'addr:port'. See 'socket' for details. -eventloop: after, vwait -~~~~~~~~~~~~~~~~~~~~~~~ +eventloop: after, vwait, update +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The following commands allow a script to be invoked when the given condition occurs. If no script is given, returns the current script. If the given script is the empty, the @@ -4057,22 +4057,49 @@ handler is removed. +$handle *onexception* '?exception-script?'+:: Sets or returns the script for when when oob data received. -Time-based execution is also available via the eventloop API. +For compatibility with 'Tcl', these may be prefixed with 'fileevent'. e.g. -+*after* 'time'+:: - Sleeps for the given number of milliseconds. No events are processed during this time. + :: + +fileevent $handle *readable* '...'+ -+*after* 'time script'+:: - The script is executed after the given number of milliseconds have elapsed. - Returns an event id. +Time-based execution is also available via the eventloop API. -+*after cancel* 'id'+:: - Cancels an 'after' event with the given event id. ++*after* 'ms'+:: + Sleeps for the given number of milliseconds. No events are + processed during this time. + ++*after* 'ms|*idle* script ?script ...?'+:: + The scripts are concatenated and executed after the given + number of milliseconds have elapsed. If 'idle' is specified, + the script will run the next time the event loop is processed + with 'vwait' or 'update'. The script is only run once and + then removed. Returns an event id. + ++*after cancel* 'id|command'+:: + Cancels an 'after' event with the given event id or matching + command (script). Returns the number of milliseconds + remaining until the event would have fired. Returns the + empty string if no matching event is found. + ++*after info* '?id?'+:: + If *id* is not given, returns a list of current 'after' + events. If *id* is given, returns a list containing the + associated script and either 'timer' or 'idle' to indicated + the type of the event. An error occurs if *id* does not + match an event. +*vwait* 'variable'+:: - A call to 'vwait' is required to enter the eventloop. 'vwait' processes events until - the named (global) variable changes. The variable need not exist beforehand. - If there are no event handlers defined, 'vwait' returns immediately. + A call to 'vwait' is enters the eventloop. 'vwait' processes + events until the named (global) variable changes or all + event handlers are removed. The variable need not exist + beforehand. If there are no event handlers defined, 'vwait' + returns immediately. + ++*update ?idletasks?*+:: + A call to 'update' enters the eventloop to process expired events, but + no new events. If 'idletasks' is specified, only expired time events are handled, + not file events. + Returns once handlers have been run for all expired events. Scripts are executed at the global scope. If an error occurs during a handler script, an attempt is made to call (the user-defined command) 'bgerror' with the details of the error. @@ -4082,8 +4109,7 @@ If a file event handler script generates an error, the handler is automatically to prevent infinite errors. (A time event handler is always removed after execution). +*bgerror* 'error'+:: - Called when an event handler script generates an error. - + Called when an event handler script generates an error. socket ~~~~~~ @@ -4188,7 +4214,7 @@ may be specified before priority to control these parameters: Use given string instead of argv0 variable for ident string. +*-options* 'integer'+:: - Set syslog options such as LOG_CONS, LOG_NDELAY You should + Set syslog options such as +LOG_CONS+, +LOG_NDELAY+. You should use numeric values of those from your system syslog.h file, because I haven't got time to implement yet another hash table. @@ -4212,16 +4238,16 @@ by the Tcl library. It contains {. /lib/jim} by default. +*errorCode*+:: - This variable holds the value of the -errorcode return - option set by the most recent error that occurred in this - interpreter. This list value represents additional information - about the error in a form that is easy to process with - programs. The first element of the list identifies a general - class of errors, and determines the format of the rest of - the list. The following formats for -errorcode return options - are used by the Tcl core; individual applications may define - additional formats. Currently only 'exec' sets this variable. - Otherwise it will be *NONE*. + This variable holds the value of the -errorcode return + option set by the most recent error that occurred in this + interpreter. This list value represents additional information + about the error in a form that is easy to process with + programs. The first element of the list identifies a general + class of errors, and determines the format of the rest of + the list. The following formats for -errorcode return options + are used by the Tcl core; individual applications may define + additional formats. Currently only 'exec' sets this variable. + Otherwise it will be *NONE*. The following global variables are set by jimsh. diff --git a/tests/event.test b/tests/event.test index 9f14f6d..0374539 100644 --- a/tests/event.test +++ b/tests/event.test @@ -1,35 +1,35 @@ +# This file contains a collection of tests for the procedures in the file +# tclEvent.c, which includes the "update", and "vwait" Tcl +# commands. Sourcing this file into Tcl runs the tests and generates +# output for errors. No output means no errors were found. +# +# Copyright (c) 1995-1997 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. + source testing.tcl test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} { catch {rename bgerror {}} proc bgerror msg { - lappend ::x $msg + lappend ::x $msg } - after 100 {error "a simple error"} - after 200 {open non_existent} + after idle {error "a simple error"} + after idle {open non_existent} + after idle {set errorInfo foobar; set errorCode xyzzy} set x {} - vwait dummy + update idletasks rename bgerror {} set x } {{a simple error} {non_existent: No such file or directory}} -test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} { - proc bgerror msg { - lappend ::x $msg - return -code break - } - after 100 {error "a simple error"} - after 200 {open non_existent} - set x {} - vwait dummy - rename bgerror {} - set x -} {{a simple error}} - test event-7.1 {bgerror / regular} { set errRes {} proc bgerror {err} { - set ::errRes $err; + global errRes; + set errRes $err; } after 0 {error err1} vwait errRes; @@ -39,31 +39,40 @@ test event-7.1 {bgerror / regular} { test event-7.2 {bgerror / accumulation} { set errRes {} proc bgerror {err} { - lappend ::errRes $err; + global errRes; + lappend errRes $err; } after 0 {error err1} - after 1 {error err2} - after 2 {error err3} - vwait dummy + after 0 {error err2} + after 0 {error err3} + update set errRes; } {err1 err2 err3} test event-7.3 {bgerror / accumulation / break} { set errRes {} proc bgerror {err} { - lappend ::errRes $err; - return -code break "skip!"; + global errRes; + lappend errRes $err; + return -code break "skip!"; } after 0 {error err1} - after 1 {error err2} - after 2 {error err3} - vwait dummy - set errRes + after 0 {error err2} + after 0 {error err3} + update + set errRes; } err1 # end of bgerror tests catch {rename bgerror {}} + +test event-10.1 {Tcl_Exit procedure} { + set cmd [list exec [info nameofexecutable] "<<exit 3"] + list [catch $cmd msg] [lindex $errorCode 0] \ + [lindex $errorCode 2] +} {1 CHILDSTATUS 3} + test event-11.1 {Tcl_VwaitCmd procedure} { list [catch {vwait} msg] $msg } {1 {wrong # args: should be "vwait name"}} @@ -75,20 +84,23 @@ test event-11.3 {Tcl_VwaitCmd procedure} { set x 1 list [catch {vwait x(1)} msg] $msg } {1 {can't read "x(1)": variable isn't array}} - test event-11.4 {Tcl_VwaitCmd procedure} { - vwait dummy - lappend ids [after 100 {set x x-done}] - lappend ids [after 200 {set y y-done}] - lappend ids [after 300 {set z z-done}] + foreach i [after info] { + after cancel $i + } + after 10; update; # On Mac make sure update won't take long + after 100 {set x x-done} + after 200 {set y y-done} + after 300 {set z z-done} + after idle {set q q-done} set x before set y before set z before set q before list [vwait y] $x $y $z $q -} {{} x-done y-done before before} +} {{} x-done y-done before q-done} -foreach i $ids { +foreach i [after info] { after cancel $i } @@ -115,7 +127,6 @@ test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} { file delete test1 test2 list $x $y $z } {3 3 done} - test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} { file delete test1 test2 set f1 [open test1 w] @@ -123,7 +134,7 @@ test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} { set x 0 set y 0 set z 0 - vwait dummy + update $f1 writable { incr x; if { $y == 3 } { set z done } } $f2 writable { incr y; if { $x == 3 } { set z done } } vwait z @@ -134,17 +145,41 @@ test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} { } {3 3 done} +test event-12.1 {Tcl_UpdateCmd procedure} { + list [catch {update a b} msg] $msg +} {1 {wrong # args: should be "update ?idletasks?"}} test event-12.3 {Tcl_UpdateCmd procedure} { + foreach i [after info] { + after cancel $i + } after 500 {set x after} - after 1 {set y after} - after 2 {set z "after, y = $y"} + after idle {set y after} + after idle {set z "after, y = $y"} set x before set y before set z before - vwait z + update idletasks list $x $y $z } {before after {after, y = after}} +test event-12.4 {Tcl_UpdateCmd procedure} { + foreach i [after info] { + after cancel $i + } + after 10; update; # On Mac make sure update won't take long + after 200 {set x x-done} + after 600 {set y y-done} + after idle {set z z-done} + set x before + set y before + set z before + after 300 + update + list $x $y $z +} {x-done before z-done} -vwait dummy +# cleanup +foreach i [after info] { + after cancel $i +} testreport diff --git a/tests/testing.tcl b/tests/testing.tcl index 9c0b4ec..5e6b395 100644 --- a/tests/testing.tcl +++ b/tests/testing.tcl @@ -4,8 +4,11 @@ proc makeFile {contents name} { close $f } -proc info_source {script} { - join [info source $script] : +proc error_source {} { + lassign [info stacktrace] p f l + if {$f ne ""} { + puts "At : $f:$l" + } } catch { @@ -14,8 +17,7 @@ catch { proc errorInfo {msg} { return $::errorInfo } - proc info_source {script} { - return "" + proc error_source {} { } } @@ -33,7 +35,8 @@ proc test {id descr script expected} { if {!$::testquiet} { puts -nonewline "$id " } - set rc [catch {uplevel 1 $script} result] + set rc [catch {uplevel 1 $script} result opts] + # Note that rc=2 is return if {($rc == 0 || $rc == 2) && $result eq $expected} { if {!$::testquiet} { @@ -45,7 +48,7 @@ proc test {id descr script expected} { puts -nonewline "$id " } puts "ERR $descr" - puts "At : [info_source $script]" + error_source puts "Expected: '$expected'" puts "Got : '$result'" incr ::testresults(numfail) diff --git a/tests/timer.test b/tests/timer.test new file mode 100644 index 0000000..d1c7e1f --- /dev/null +++ b/tests/timer.test @@ -0,0 +1,455 @@ +# This file contains a collection of tests for the procedures in the +# file tclTimer.c, which includes the "after" Tcl command. Sourcing +# this file into Tcl runs the tests and generates output for errors. +# No output means no errors were found. +# +# 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) 1997 by 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. +# +# RCS: @(#) $Id: timer.test,v 1.7.2.1 2001/10/13 01:14:19 hobbs Exp $ + +source testing.tcl + +test timer-1.1 {Tcl_CreateTimerHandler procedure} { + foreach i [after info] { + after cancel $i + } + set x "" + foreach i {100 200 1000 50 150} { + after $i lappend x $i + } + after 210 + update + set x +} {50 100 150 200} + +test timer-2.1 {Tcl_DeleteTimerHandler procedure} { + foreach i [after info] { + after cancel $i + } + set x "" + foreach i {100 200 300 50 150} { + after $i lappend x $i + } + after cancel lappend x 150 + after cancel lappend x 50 + after 210 + update + set x +} {100 200} + +# No tests for Tcl_ServiceTimer or ResetTimer, since it is already tested +# above. + +test timer-3.1 {TimerHandlerEventProc procedure: event masks} { + set x start + after 100 { set x fired } + update idletasks + set result $x + after 200 + update + lappend result $x +} {start fired} +test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} { + foreach i [after info] { + after cancel $i + } + foreach i {200 600 1000} { + after $i lappend x $i + } + after 210 + set result "" + set x "" + update + lappend result $x + after 400 + update + lappend result $x + after 400 + update + lappend result $x +} {200 {200 600} {200 600 1000}} +test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} { + foreach i [after info] { + after cancel $i + } + set x {} + after 100 lappend x 100 + set i [after 300 lappend x 300] + after 200 after cancel $i + after 400 + update + set x +} 100 +test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} { + foreach i [after info] { + after cancel $i + } + set x {} + after 100 lappend x a + after 200 lappend x b + after 300 lappend x c + after 310 + vwait x + set x +} {a b c} +test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} { + foreach i [after info] { + after cancel $i + } + set x {} + after 100 {lappend x a; after 0 lappend x b} + after 100 + vwait x + set x +} a +test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} { + foreach i [after info] { + after cancel $i + } + set x {} + after 100 {lappend x a; after 100 lappend x b; after 100} + after 100 + vwait x + set result $x + vwait x + lappend result $x +} {a {a b}} + +# No tests for Tcl_DoWhenIdle: it's already tested by other tests +# below. + +test timer-4.1 {Tcl_CancelIdleCall procedure} { + foreach i [after info] { + after cancel $i + } + set x before + set y before + set z before + after idle set x after1 + after idle set y after2 + after idle set z after3 + after cancel set y after2 + update idletasks + concat $x $y $z +} {after1 before after3} +test timer-4.2 {Tcl_CancelIdleCall procedure} { + foreach i [after info] { + after cancel $i + } + set x before + set y before + set z before + after idle set x after1 + after idle set y after2 + after idle set z after3 + after cancel set x after1 + update idletasks + concat $x $y $z +} {before after2 after3} + +test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} { + foreach i [after info] { + after cancel $i + } + set x 1 + set y 23 + after idle {incr x; after idle {incr x; after idle {incr x}}} + after idle {incr y} + vwait x + set result "$x $y" + update idletasks + lappend result $x +} {2 24 4} + +test timer-6.1 {Tcl_AfterCmd procedure, basics} { + list [catch {after} msg] $msg +} {1 {wrong # args: should be "after option ?arg ...?"}} +test timer-6.2 {Tcl_AfterCmd procedure, basics} { + list [catch {after 2x} msg] $msg +} {1 {bad argument "2x": must be cancel, idle, or info}} +test timer-6.3 {Tcl_AfterCmd procedure, basics} { + list [catch {after gorp} msg] $msg +} {1 {bad argument "gorp": must be cancel, idle, or info}} +test timer-6.4 {Tcl_AfterCmd procedure, ms argument} { + set x before + after 400 {set x after} + after 200 + update + set y $x + after 400 + update + list $y $x +} {before after} +test timer-6.5 {Tcl_AfterCmd procedure, ms argument} { + set x before + after 300 {set x after} + after 200 + update + set y $x + after 200 + update + list $y $x +} {before after} +test timer-6.6 {Tcl_AfterCmd procedure, cancel option} { + list [catch {after cancel} msg] $msg +} {1 {wrong # args: should be "after cancel id|command"}} +test timer-6.7 {Tcl_AfterCmd procedure, cancel option} { + after cancel after#1 +} {} +test timer-6.8 {Tcl_AfterCmd procedure, cancel option} { + after cancel {foo bar} +} {} +test timer-6.9 {Tcl_AfterCmd procedure, cancel option} { + foreach i [after info] { + after cancel $i + } + set x before + set y [after 100 set x after] + after cancel $y + after 200 + update + set x +} {before} +test timer-6.10 {Tcl_AfterCmd procedure, cancel option} { + foreach i [after info] { + after cancel $i + } + set x before + after 100 set x after + after cancel set x after + after 200 + update + set x +} {before} +test timer-6.11 {Tcl_AfterCmd procedure, cancel option} { + foreach i [after info] { + after cancel $i + } + set x before + after 100 set x after + set id [after 300 set x after] + after cancel $id + after 200 + update + set y $x + set x cleared + after 200 + update + list $y $x +} {after cleared} +test timer-6.12 {Tcl_AfterCmd procedure, cancel option} { + foreach i [after info] { + after cancel $i + } + set x first + after idle lappend x second + after idle lappend x third + set i [after idle lappend x fourth] + after cancel {lappend x second} + after cancel $i + update idletasks + set x +} {first third} +test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for command} { + foreach i [after info] { + after cancel $i + } + set x first + after idle lappend x second + after idle lappend x third + set i [after idle lappend x fourth] + after cancel lappend x second + after cancel $i + update idletasks + set x +} {first third} +test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, used to dump core} { + foreach i [after info] { + after cancel $i + } + set id [ + after 100 { + set x done + after cancel $id + } + ] + vwait x +} {} +test timer-6.16 {Tcl_AfterCmd procedure, idle option} { + list [catch {after idle} msg] $msg +} {1 {wrong # args: should be "after idle script ?script ...?"}} +test timer-6.17 {Tcl_AfterCmd procedure, idle option} { + set x before + after idle {set x after} + set y $x + update idletasks + list $y $x +} {before after} +test timer-6.18 {Tcl_AfterCmd procedure, idle option} { + set x before + after idle set x after + set y $x + update idletasks + list $y $x +} {before after} +set event1 [after idle event 1] +set event2 [after 1000 event 2] + +test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NULL} { + foreach i [after info] { + after cancel $i + } + set x "hello world" + after 1 "set x ab\0cd" + after 10 + update + string length $x +} {5} +test timer-6.24 {Tcl_AfterCmd procedure, no option, script with NULL} { + foreach i [after info] { + after cancel $i + } + set x "hello world" + after 1 set x ab\0cd + after 10 + update + string length $x +} {5} +test timer-6.25 {Tcl_AfterCmd procedure, cancel option, script with NULL} { + foreach i [after info] { + after cancel $i + } + set x "hello world" + after 1 set x ab\0cd + after cancel "set x ab\0ef" + set x [llength [after info]] + foreach i [after info] { + after cancel $i + } + set x +} {1} +test timer-6.26 {Tcl_AfterCmd procedure, cancel option, script with NULL} { + foreach i [after info] { + after cancel $i + } + set x "hello world" + after 1 set x ab\0cd + after cancel set x ab\0ef + set y [llength [after info]] + foreach i [after info] { + after cancel $i + } + set y +} {1} +test timer-6.27 {Tcl_AfterCmd procedure, idle option, script with NULL} { + foreach i [after info] { + after cancel $i + } + set x "hello world" + after idle "set x ab\0cd" + update + string length $x +} {5} +test timer-6.28 {Tcl_AfterCmd procedure, idle option, script with NULL} { + foreach i [after info] { + after cancel $i + } + set x "hello world" + after idle set x ab\0cd + update + string length $x +} {5} +test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NULL} { + foreach i [after info] { + after cancel $i + } + set x "hello world" + set id junk + set id [after 10 set x ab\0cd] + update + set y [string length [lindex [lindex [after info $id] 0] 2]] + foreach i [after info] { + after cancel $i + } + set y +} {5} + +set event [after idle foo bar] +scan $event after#%d id + +test timer-7.1 {GetAfterEvent procedure} { + list [catch {after info xfter#$id} msg] $msg +} "1 {event \"xfter#$id\" doesn't exist}" +test timer-7.2 {GetAfterEvent procedure} { + list [catch {after info afterx$id} msg] $msg +} "1 {event \"afterx$id\" doesn't exist}" +test timer-7.3 {GetAfterEvent procedure} { + list [catch {after info after#ab} msg] $msg +} {1 {event "after#ab" doesn't exist}} +test timer-7.4 {GetAfterEvent procedure} { + list [catch {after info after#} msg] $msg +} {1 {event "after#" doesn't exist}} +test timer-7.5 {GetAfterEvent procedure} { + list [catch {after info after#${id}x} msg] $msg +} "1 {event \"after#${id}x\" doesn't exist}" +test timer-7.6 {GetAfterEvent procedure} { + list [catch {after info afterx[expr $id+1]} msg] $msg +} "1 {event \"afterx[expr $id+1]\" doesn't exist}" +after cancel $event + +test timer-8.1 {AfterProc procedure} { + set x before + proc foo {} { + set x untouched + after 100 {set x after} + after 200 + update + return $x + } + list [foo] $x +} {untouched after} +test timer-8.2 {AfterProc procedure} { + catch {rename bgerror {}} + proc bgerror msg { + set ::x $msg + } + set x empty + after 100 {error "After error"} + after 200 + set y $x + update + catch {rename bgerror {}} + list $y $x +} {empty {After error}} + +test timer-8.4 {AfterProc procedure, deleting handler from itself} { + foreach i [after info] { + after cancel $i + } + proc foo {} { + global x + set x {} + foreach i [after info] { + lappend x [after info $i] + } + after cancel foo + } + after 1000 {error "I shouldn't ever have executed"} + after idle foo + update idletasks + set x +} {{{error "I shouldn't ever have executed"} timer}} + +foreach i [after info] { + after cancel $i +} + +testreport |