aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--jim-aio.c2
-rw-r--r--jim-eventloop.c312
-rw-r--r--jim-eventloop.h1
-rw-r--r--jim.c36
-rw-r--r--jim.h5
-rw-r--r--jim_tcl.txt156
-rw-r--r--tests/event.test117
-rw-r--r--tests/testing.tcl15
-rw-r--r--tests/timer.test455
9 files changed, 887 insertions, 212 deletions
diff --git a/jim-aio.c b/jim-aio.c
index 666cc1e..6f08993 100644
--- a/jim-aio.c
+++ b/jim-aio.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 - 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);
diff --git a/jim.c b/jim.c
index 732253f..b083473 100644
--- a/jim.c
+++ b/jim.c
@@ -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)
diff --git a/jim.h b/jim.h
index b8d5d1d..038d62f 100644
--- a/jim.h
+++ b/jim.h
@@ -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
generated by cgit v1.1 at 2024-09-07 22:16:34 +0000