From d2d76748809298daff2f10a63b2999d559d129dd Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 3 Jul 2017 13:24:53 +0000 Subject: [enhancement] extend "vwait" with same options as "update", new syntax "vwait ?options? ?timeout? varname". some small improvements and fixing: - Tcl_DoOneEvent can wait for block time that was set with Tcl_SetMaxBlockTime outside an event source traversal, and stop waiting if Tcl_SetMaxBlockTime was called outside an event source (another event occurs and interrupt waiting loop), etc; - safer more precise pre-lookup by options (use TclObjIsIndexOfTable instead of simply comparison of type with tclIndexType); test cases extended to cover conditional "vwait" usage; --- generic/tclEvent.c | 90 +++++++++++++++++++++++++-------------------------- generic/tclIndexObj.c | 37 +++++++++++++++++++++ generic/tclInt.h | 6 ++++ generic/tclNotify.c | 54 +++++++++++++++---------------- generic/tclTimer.c | 2 +- tests/event.test | 51 ++++++++++++++++++++--------- 6 files changed, 151 insertions(+), 89 deletions(-) diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 6413d10..84e4637 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1300,6 +1300,17 @@ TclInThreadExit(void) } +static CONST char *updateEventOptions[] = { + "-idle", "-noidle", /* new options */ + "-timer", "-notimer", + "-file", "-nofile", + "-window", "-nowindow", + "-async", "-noasync", + "-nowait", "-wait", + "idletasks", /* backwards compat. */ + NULL +}; + static int GetEventFlagsFromOpts( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ @@ -1309,15 +1320,6 @@ GetEventFlagsFromOpts( { int i, optionIndex, result = TCL_ERROR; int flags = *flagsPtr; /* default flags */ - static CONST char *updateOptions[] = { - "-idle", "-noidle", /* new options */ - "-timer", "-notimer", - "-file", "-nofile", - "-window", "-nowindow", - "-async", "-noasync", - "-nowait", "-wait", - "idletasks", /* backwards compat. */ - NULL}; static CONST struct { int mask; int flags; @@ -1334,7 +1336,7 @@ GetEventFlagsFromOpts( }; for (i = 0; i < objc; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], updateOptions, + if (Tcl_GetIndexFromObj(interp, objv[i], updateEventOptions, "option", 0, &optionIndex) != TCL_OK) { goto done; } @@ -1354,14 +1356,6 @@ GetEventFlagsFromOpts( return result; } -static void -VwaitTimeOutProc( - ClientData clientData) -{ - int *donePtr = (int *) clientData; - - *donePtr = -1; -} /* *---------------------------------------------------------------------- * @@ -1387,27 +1381,26 @@ Tcl_VwaitObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { - int done = 0, foundEvent; + int done = 0, foundEvent = 1; int flags = TCL_ALL_EVENTS; /* default flags */ char *nameString; int opti = 1, /* start option index (and index of varname later) */ optc = objc - 2; /* options count without cmd and varname */ - TimerEntry *timerEvent = NULL; Tcl_WideInt ms = -1; + Tcl_Time wakeup; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "?options? name ?timeout?"); + Tcl_WrongNumArgs(interp, 1, objv, "?options? ?timeout? name"); return TCL_ERROR; } /* if arguments available - wrap options to flags */ if (objc >= 3) { /* first try to recognize options up to the possible end, thereby - * we assume that varname is not integer, try to get numeric timeout, - * (just assume precidence of option fewer as timeout) + * we assume that option is not an integer, try to get numeric timeout */ - if (Tcl_GetWideIntFromObj(NULL, objv[objc-1], &ms) == TCL_OK) { - objc--; + if (!TclObjIsIndexOfTable(objv[optc], updateEventOptions) + && Tcl_GetWideIntFromObj(NULL, objv[optc], &ms) == TCL_OK) { optc--; } @@ -1417,16 +1410,12 @@ Tcl_VwaitObjCmd( ) { return TCL_ERROR; } - /* opti points to varname */ - opti += optc; } done = 0; /* if timeout specified - create timer event or no-wait by 0ms */ if (ms != -1) { - Tcl_Time wakeup; - if (ms > 0) { Tcl_GetTime(&wakeup); wakeup.sec += (long)(ms / 1000); @@ -1435,26 +1424,38 @@ Tcl_VwaitObjCmd( wakeup.sec++; wakeup.usec -= 1000000; } - timerEvent = TclCreateAbsoluteTimerHandlerEx(&wakeup, VwaitTimeOutProc, NULL, 0); - timerEvent->clientData = &done; } else if (ms == 0) { flags |= TCL_DONT_WAIT; } } - nameString = Tcl_GetString(objv[opti]); + nameString = Tcl_GetString(objv[objc-1]); if (Tcl_TraceVar(interp, nameString, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, (ClientData) &done) != TCL_OK) { - - /* if timeout-timer and no timeout fired, cancel timer event */ - if (timerEvent && done != -1) { - TclDeleteTimerEntry(timerEvent); - } return TCL_ERROR; }; do { + /* if wait - set blocking time */ + if (ms > 0) { + Tcl_Time blockTime; + Tcl_GetTime(&blockTime); + blockTime.sec = wakeup.sec - blockTime.sec; + blockTime.usec = wakeup.usec - blockTime.usec; + if (blockTime.usec < 0) { + blockTime.sec -= 1; + blockTime.usec += 1000000; + } + if ( blockTime.sec < 0 + || (blockTime.sec == 0 && blockTime.usec <= 0) + ) { + /* timeout occurs */ + done = -1; + break; + } + Tcl_SetMaxBlockTime(&blockTime); + } if ((foundEvent = Tcl_DoOneEvent(flags)) == 0) { /* * If don't wait flag set - no error, and two cases: @@ -1463,14 +1464,16 @@ Tcl_VwaitObjCmd( */ if (flags & TCL_DONT_WAIT) { foundEvent = 1; - if (ms != 0) { - goto checkLimit; /* continue waiting */ - } done = -2; } + if (ms > 0) { + foundEvent = 1; + goto checkWait; /* continue waiting */ + } break; } - checkLimit: + checkWait: + /* check interpreter limit exceeded */ if (Tcl_LimitExceeded(interp)) { foundEvent = -1; break; @@ -1481,11 +1484,6 @@ Tcl_VwaitObjCmd( TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, (ClientData) &done); - /* if timeout-timer and no timeout fired, cancel timer event */ - if (timerEvent && done != -1) { - TclDeleteTimerEntry(timerEvent); - } - /* if timeout specified (and no errors) */ if (ms != -1 && foundEvent > 0) { Tcl_Obj *objPtr; diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index ced7bd9..4caba7a 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -63,6 +63,43 @@ typedef struct { /* *---------------------------------------------------------------------- * + * TclObjIsIndexOfStruct -- + * + * This function looks up an object's is a index of given table. + * + * Used for fast lookup by dynamic options count to check for other + * object types. + * + * Results: + * 1 if object is an option of table, otherwise 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +int +TclObjIsIndexOfStruct( + Tcl_Obj *objPtr, /* Object containing the string to lookup. */ + const void *tablePtr) /* Array of strings to compare against the + * value of objPtr; last entry must be NULL + * and there must not be duplicate entries. */ +{ + IndexRep *indexRep; + if (objPtr->typePtr != &tclIndexType) { + return 0; + } + indexRep = objPtr->internalRep.twoPtrValue.ptr1; + + if (indexRep->tablePtr != (void *) tablePtr) { + return 0; + } + return 1; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_GetIndexFromObj -- * * This function looks up an object's value in a table of strings and diff --git a/generic/tclInt.h b/generic/tclInt.h index dd73eac..42223e4 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2561,6 +2561,12 @@ MODULE_SCOPE char tclEmptyString; *---------------------------------------------------------------- */ +MODULE_SCOPE int TclObjIsIndexOfStruct(Tcl_Obj *objPtr, + const void *tablePtr); +#define TclObjIsIndexOfTable(objPtr, tablePtr) \ + ((objPtr->typePtr == &tclIndexType) \ + && TclObjIsIndexOfStruct(objPtr, tablePtr)) + MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, const unsigned char *bytes, int len); MODULE_SCOPE void TclAdvanceContinuations(int* line, int** next, int loc); diff --git a/generic/tclNotify.c b/generic/tclNotify.c index f13fca3..fb251b7 100644 --- a/generic/tclNotify.c +++ b/generic/tclNotify.c @@ -989,14 +989,18 @@ Tcl_SetMaxBlockTime( * Results: * The return value is 1 if the function actually found an event to * process. If no processing occurred, then 0 is returned (this can - * happen if the TCL_DONT_WAIT flag is set or if there are no event - * handlers to wait for in the set specified by flags). + * happen if the TCL_DONT_WAIT flag is set or block time was set using + * Tcl_SetMaxBlockTime before or if there are no event handlers to wait + * for in the set specified by flags). * * Side effects: * May delay execution of process while waiting for an event, unless * TCL_DONT_WAIT is set in the flags argument. Event sources are invoked * to check for and queue events. Event handlers may produce arbitrary * side effects. + * If block time was set (Tcl_SetMaxBlockTime) but another event occurs + * and interrupt wait, the function can return early, thereby it resets + * the block time (caller should use Tcl_SetMaxBlockTime again). * *---------------------------------------------------------------------- */ @@ -1013,6 +1017,7 @@ Tcl_DoOneEvent( EventSource *sourcePtr; Tcl_Time *timePtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + int stopWait; /* * No event flags is equivalent to TCL_ALL_EVENTS. @@ -1022,20 +1027,26 @@ Tcl_DoOneEvent( flags |= TCL_ALL_EVENTS; } + /* Block time was set outside an event source traversal or no wait */ + stopWait = tsdPtr->blockTimeSet || (flags & TCL_DONT_WAIT); + /* * Asynchronous event handlers are considered to be the highest priority * events, and so must be invoked before we process events on the event * queue. */ - if ((flags & TCL_ASYNC_EVENTS) && Tcl_AsyncReady()) { - (void) Tcl_AsyncInvoke(NULL, 0); - return 1; - } + if (flags & TCL_ASYNC_EVENTS) { + if (Tcl_AsyncReady()) { + (void) Tcl_AsyncInvoke(NULL, 0); + return 1; + } - /* Async only */ - if ((flags & TCL_ALL_EVENTS) == TCL_ASYNC_EVENTS) { - return 0; + /* Async only and don't wait - return */ + if ( (flags & (TCL_ALL_EVENTS|TCL_DONT_WAIT)) + == (TCL_ASYNC_EVENTS|TCL_DONT_WAIT) ) { + return 0; + } } /* @@ -1047,12 +1058,10 @@ Tcl_DoOneEvent( tsdPtr->serviceMode = TCL_SERVICE_NONE; /* - * The core of this function is an infinite loop, even though we only - * service one event. The reason for this is that we may be processing - * events that don't do anything inside of Tcl. + * Main loop until servicing exact one event or block time resp. + * TCL_DONT_WAIT specified (infinite loop if stopWait = 0). */ - - while (1) { + do { /* * If idle events are the only things to service, skip the main part * of the loop and go directly to handle idle events (i.e. don't wait @@ -1060,7 +1069,6 @@ Tcl_DoOneEvent( */ if ((flags & TCL_ALL_EVENTS) == TCL_IDLE_EVENTS) { - flags |= TCL_DONT_WAIT; goto idleEvents; } @@ -1096,8 +1104,6 @@ Tcl_DoOneEvent( tsdPtr->blockTimeSet = 1; timePtr = &tsdPtr->blockTime; goto wait; /* for notifier resp. system events */ - } else { - tsdPtr->blockTimeSet = 0; } /* @@ -1164,9 +1170,6 @@ Tcl_DoOneEvent( break; } } - if (flags & TCL_DONT_WAIT) { - break; - } /* * If Tcl_WaitForEvent has returned 1, indicating that one system @@ -1176,16 +1179,13 @@ Tcl_DoOneEvent( * had the side effect of changing the variable (so the vwait can * return and unwind properly). * - * NB: We will process idle events if any first, because otherwise we - * might never do the idle events if the notifier always gets - * system events. + * We can stop also if block time was set outside an event source, + * that means timeout was set (so exit loop also without event/result). */ - if (result) { - break; - } - } + } while (!stopWait); + tsdPtr->blockTimeSet = 0; tsdPtr->serviceMode = oldMode; return result; } diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 52a3073..63346a1 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -1139,7 +1139,7 @@ Tcl_AfterObjCmd( */ index = -1; - if ( ( objv[1]->typePtr == &tclIndexType + if ( ( TclObjIsIndexOfTable(objv[1], afterSubCmds) || Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK ) && Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, diff --git a/tests/event.test b/tests/event.test index cce486a..d2dd2fc 100644 --- a/tests/event.test +++ b/tests/event.test @@ -488,7 +488,7 @@ test event-10.1 {Tcl_Exit procedure} {stdio} { test event-11.1 {Tcl_VwaitCmd procedure} { list [catch {vwait} msg] $msg -} {1 {wrong # args: should be "vwait ?options? name ?timeout?"}} +} {1 {wrong # args: should be "vwait ?options? ?timeout? name"}} test event-11.2 {Tcl_VwaitCmd procedure} { list [catch {vwait a b} msg] $msg } {1 {bad option "a": must be -idle, -noidle, -timer, -notimer, -file, -nofile, -window, -nowindow, -async, -noasync, -nowait, -wait, or idletasks}} @@ -527,26 +527,26 @@ test event-11.4.0 {vwait - interp limit precedence} {} { # no limit in between: $i limit time -seconds {} -milliseconds {} - lappend result 2. [catch {$i eval {vwait x 0}} msg] $msg + lappend result 2. [catch {$i eval {vwait 0 x}} msg] $msg # limit should be exceeded: (wait infinite by -1) $i limit time -milliseconds 0 - lappend result 3. [catch {$i eval {vwait x -1}} msg] $msg + lappend result 3. [catch {$i eval {vwait -1 x}} msg] $msg # limit should be exceeded (wait too long - 1000ms): $i limit time -milliseconds 0 - lappend result 4. [catch {$i eval {vwait x 1000}} msg] $msg + lappend result 4. [catch {$i eval {vwait 1000 x}} msg] $msg set tout [clock seconds]; incr tout 10 # wait timeout (before limit): $i limit time -seconds $tout - lappend result 5. [catch {$i eval {vwait x 0}} msg] $msg + lappend result 5. [catch {$i eval {vwait 0 x}} msg] $msg # wait timeout (before limit): $i limit time -seconds $tout - lappend result 6. [catch {$i eval {vwait x 10}} msg] $msg + lappend result 6. [catch {$i eval {vwait 10 x}} msg] $msg # wait successful (before limit): $i limit time -seconds $tout - lappend result 7. [catch {$i eval {after 0 {set x ""}; vwait x 10}} msg] $msg + lappend result 7. [catch {$i eval {after 0 {set x ""}; vwait 10 x}} msg] $msg interp delete $i set result @@ -560,6 +560,27 @@ test event-11.4.0 {vwait - interp limit precedence} {} { 7. 0 1 \ ] +test event-11.4.0 {vwait conditional with timeout (bypass timer)} {} { + set x {} + after 1000 {lappend x "error-too-slow"} + after 0 {lappend x 1-timer} + after 1 {lappend x 2-timer} + after idle {lappend x 3-idle} + vwait -async 50 x; # ignore all except async (timer also) + lappend x 4-async + vwait -idle 50 x; # ignore all except idle (timer also) + lappend x 5-idle + after idle {lappend x 6-idle} + vwait 100 x; # now we accept timer events + lappend x 7-idle + vwait 100 x; + # cleanup: + foreach i [after info] { + after cancel $i + } + set x +} {4-async 3-idle 5-idle 1-timer 2-timer 7-idle 6-idle} + test event-11.4.1 {vwait with timeout} {} { foreach i [after info] { after cancel $i @@ -568,15 +589,15 @@ test event-11.4.1 {vwait with timeout} {} { set x {} # success cases: after 0 {lappend z 0} - after 100 {lappend x 1} - after 100 {lappend x 2} - after 500 {lappend x 3} + after 50 {lappend x 1} + after 50 {lappend x 2} + after 250 {lappend x 3} after 1000 {lappend x "error-too-slow"} - vwait x 0; # no-wait + vwait 0 x; # no-wait lappend z $x; # 0 {} - (x still empty) - vwait x 200; # wait up-to 200ms + vwait 200 x; # wait up-to 200ms lappend z $x; # 0 {} {1 2} - vwait x -1; # infinite wait + vwait -1 x; # infinite wait lappend z $x; # 0 {} {1 2} {1 2 3} foreach i [after info] { after cancel $i @@ -746,7 +767,7 @@ test event-12.5 {update -idle, update -noidle} { update -idle lappend x 6 update - lappend x res:[vwait x 500] + lappend x res:[vwait 500 x] set x } {0 2 idle 3 idle 6 4 5 1 res:1} @@ -775,7 +796,7 @@ test event-12.6 {update -timer, update -notimer} { update -timer -idle lappend x 6 update - lappend x res:[vwait x 500] + lappend x res:[vwait 500 x] update -noidle lappend x 7 update -- cgit v0.12