diff options
| -rw-r--r-- | jim-eventloop.c | 30 | ||||
| -rw-r--r-- | jim.c | 18 | ||||
| -rw-r--r-- | jim.h | 1 | ||||
| -rw-r--r-- | tests/event.test | 150 |
4 files changed, 185 insertions, 14 deletions
diff --git a/jim-eventloop.c b/jim-eventloop.c index ff94f50..0f34dd3 100644 --- a/jim-eventloop.c +++ b/jim-eventloop.c @@ -419,9 +419,21 @@ static int JimELVwaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) Jim_WrongNumArgs(interp, 1, argv, "name"); return JIM_ERR; } + + interp->suppress_bgerror = 0; + oldValue = Jim_GetGlobalVariable(interp, argv[1], JIM_NONE); - if (oldValue) + if (oldValue) { Jim_IncrRefCount(oldValue); + } + else { + /* If a result was left, it is an error */ + int len; + Jim_GetString(interp->result, &len); + if (len) { + return JIM_ERR; + } + } while (1) { Jim_Obj *currValue; @@ -439,6 +451,8 @@ static int JimELVwaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) } if (oldValue) Jim_DecrRefCount(interp, oldValue); + + Jim_SetEmptyResult(interp); return JIM_OK; } @@ -461,18 +475,18 @@ static int JimELAfterCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) jim_wide ms, id; Jim_Obj *objPtr, *idObjPtr; const char *options[] = { - "info", "cancel", NULL + "cancel", NULL }; enum - { INFO, CANCEL, RESTART, EXPIRE, CREATE }; - int option = CREATE; + { AFTER_CANCEL, AFTER_INFO, AFTER_RESTART, AFTER_EXPIRE, AFTER_CREATE }; + int option = AFTER_CREATE; if (argc < 2) { Jim_WrongNumArgs(interp, 1, argv, "<after milliseconds> ?script|cancel <id>?"); return JIM_ERR; } if (Jim_GetWide(interp, argv[1], &ms) != JIM_OK) { - if (Jim_GetEnum(interp, argv[1], options, &option, "after options", JIM_ERRMSG) != JIM_OK) { + if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG) != JIM_OK) { return JIM_ERR; } } @@ -483,7 +497,7 @@ static int JimELAfterCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) return JIM_OK; } switch (option) { - case CREATE: + case AFTER_CREATE: Jim_IncrRefCount(argv[2]); id = Jim_CreateTimeHandler(interp, ms, JimAfterTimeHandler, argv[2], JimAfterTimeEventFinalizer); @@ -495,7 +509,7 @@ static int JimELAfterCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) Jim_DecrRefCount(interp, idObjPtr); Jim_SetResult(interp, objPtr); return JIM_OK; - case CANCEL:{ + case AFTER_CANCEL:{ int tlen; jim_wide remain = 0; const char *tok = Jim_GetString(argv[2], &tlen); @@ -510,8 +524,6 @@ static int JimELAfterCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) Jim_SetResultString(interp, "invalid event", -1); return JIM_ERR; } - default: - fprintf(stderr, "unserviced option to after %d\n", option); } return JIM_OK; } @@ -4670,6 +4670,7 @@ 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); @@ -9886,17 +9887,24 @@ int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr) retval = Jim_EvalObj(interp, scriptObjPtr); interp->framePtr = savedFramePtr; /* Try to report the error (if any) via the bgerror proc */ - if (retval != JIM_OK) { + 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 || Jim_EvalObjVector(interp, 2, objv) != JIM_OK) { - /* Report the error to stderr. */ - fprintf(stderr, "Background error:" JIM_NL); - Jim_PrintErrorMessage(interp); + 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]); @@ -541,6 +541,7 @@ 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(). */ diff --git a/tests/event.test b/tests/event.test new file mode 100644 index 0000000..9f14f6d --- /dev/null +++ b/tests/event.test @@ -0,0 +1,150 @@ +source testing.tcl + +test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} { + catch {rename bgerror {}} + proc bgerror msg { + lappend ::x $msg + } + after 100 {error "a simple error"} + after 200 {open non_existent} + set x {} + vwait dummy + 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; + } + after 0 {error err1} + vwait errRes; + set errRes; +} err1 + +test event-7.2 {bgerror / accumulation} { + set errRes {} + proc bgerror {err} { + lappend ::errRes $err; + } + after 0 {error err1} + after 1 {error err2} + after 2 {error err3} + vwait dummy + set errRes; +} {err1 err2 err3} + +test event-7.3 {bgerror / accumulation / break} { + set errRes {} + proc bgerror {err} { + lappend ::errRes $err; + return -code break "skip!"; + } + after 0 {error err1} + after 1 {error err2} + after 2 {error err3} + vwait dummy + set errRes +} err1 + +# end of bgerror tests +catch {rename bgerror {}} + +test event-11.1 {Tcl_VwaitCmd procedure} { + list [catch {vwait} msg] $msg +} {1 {wrong # args: should be "vwait name"}} +test event-11.2 {Tcl_VwaitCmd procedure} { + list [catch {vwait a b} msg] $msg +} {1 {wrong # args: should be "vwait name"}} +test event-11.3 {Tcl_VwaitCmd procedure} { + catch {unset x} + 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}] + 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} + +foreach i $ids { + after cancel $i +} + +test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} { + set f1 [open test1 w] + proc accept {s args} { + puts $s foobar + close $s + } + catch {set s1 [socket stream.server 5001]} + after 1000 + catch {set s2 [socket stream 5001]} + close $s1 + set x 0 + set y 0 + set z 0 + $s2 readable { incr z } + vwait z + $f1 writable { incr x; if { $y == 3 } { set z done } } + $s2 readable { incr y; if { $x == 3 } { set z done } } + vwait z + close $f1 + close $s2 + 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] + set f2 [open test2 w] + set x 0 + set y 0 + set z 0 + vwait dummy + $f1 writable { incr x; if { $y == 3 } { set z done } } + $f2 writable { incr y; if { $x == 3 } { set z done } } + vwait z + close $f1 + close $f2 + file delete test1 test2 + list $x $y $z +} {3 3 done} + + +test event-12.3 {Tcl_UpdateCmd procedure} { + after 500 {set x after} + after 1 {set y after} + after 2 {set z "after, y = $y"} + set x before + set y before + set z before + vwait z + list $x $y $z +} {before after {after, y = after}} + +vwait dummy + +testreport |