Hi,
Attached the patch for this tip. There are no changes to file events.
Additional arguments for vwait set the argument for the Tcl_DoOneEvent call.
Kind regards,
Jos.
On Mon, Mar 2, 2015 at 1:56 PM, Alexandre Ferrieux <
alex...@gmail.com> wrote:
> On Mon, Mar 2, 2015 at 12:20 PM, Jos Decoster <jos....@gmail.com>> wrote:> >> > TIP #434: SPECIFY EVENT SOURCES FOR 'VWAIT'>> Nice ! Thanks in advance for publishing the implementation on a> branch. ISTR fileevents use a hidden [after 0], which frightened me> last time I dreamt about this kind of decoupling. I'm sure you took> care of that, and would love to see the result !>> -Alex>>> ------------------------------------------------------------------------------> Dive into the World of Parallel Programming The Go Parallel Website,> sponsored> by Intel and developed in partnership with Slashdot Media, is your hub for> all> things parallel software development, from weekly thought leadership blogs> to> news, videos, case studies, tutorials and more. Take a look and join the> conversation now. http://goparallel.sourceforge.net/> _______________________________________________> Tcl-Core mailing list> Tcl-...@lists.sourceforge.net> https://lists.sourceforge.net/lists/listinfo/tcl-core>
Index: generic/tclEvent.c
==================================================================
--- generic/tclEvent.c
+++ generic/tclEvent.c
@@ -1386,25 +1386,57 @@
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int done, foundEvent;
const char *nameString;
+ int flags = TCL_ALL_EVENTS;
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "name");
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name ?eventspec?");
return TCL_ERROR;
}
nameString = Tcl_GetString(objv[1]);
if (Tcl_TraceVar2(interp, nameString, NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VwaitVarProc, &done) != TCL_OK) {
return TCL_ERROR;
};
+ if (objc > 2) {+ int i;
+ enum {FLAG_WINDOW, FLAG_FILE, FLAG_TIMER, FLAG_IDLE, FLAG_ALL};
+ static const char* const flagStrings[] =
+ { "-window", "-file", "-timer", "-idle", "-all", NULL };
+ flags = 0;
+ for (i = 2; i < objc; i++) {
+ int index;
+ if (Tcl_GetIndexFromObj(interp, objv[i], flagStrings, "event",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (index) {
+ case FLAG_WINDOW:
+ flags |= TCL_WINDOW_EVENTS;
+ break;
+ case FLAG_FILE:
+ flags |= TCL_FILE_EVENTS;
+ break;
+ case FLAG_TIMER:
+ flags |= TCL_TIMER_EVENTS;
+ break;
+ case FLAG_IDLE:
+ flags |= TCL_IDLE_EVENTS;
+ break;
+ case FLAG_ALL:
+ flags |= TCL_ALL_EVENTS;
+ break;
+ }
+ }
+ }
done = 0;
foundEvent = 1;
while (!done && foundEvent) {
- foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS);
+ foundEvent = Tcl_DoOneEvent(flags);
if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
break;
}
if (Tcl_LimitExceeded(interp)) {
Tcl_ResetResult(interp);
Index: tests/event.test
==================================================================
--- tests/event.test
+++ tests/event.test
@@ -507,21 +507,18 @@
[lindex $::errorCode 2]
} {1 {child process exited abnormally} CHILDSTATUS 3}
test event-11.1 {Tcl_VwaitCmd procedure} -returnCodes error -body {
vwait
-} -result {wrong # args: should be "vwait name"}
-test event-11.2 {Tcl_VwaitCmd procedure} -returnCodes error -body {
- vwait a b
-} -result {wrong # args: should be "vwait name"}
-test event-11.3 {Tcl_VwaitCmd procedure} -setup {
+} -result {wrong # args: should be "vwait name ?eventspec?"}
+test event-11.2 {Tcl_VwaitCmd procedure} -setup {
catch {unset x}
} -body {
set x 1
vwait x(1)
} -returnCodes error -result {can't trace "x(1)": variable isn't array}
-test event-11.4 {Tcl_VwaitCmd procedure} -setup {
+test event-11.3 {Tcl_VwaitCmd procedure} -setup {
foreach i [after info] {
after cancel $i
}
after 10; update; # On Mac make sure update won't take long
} -body {
@@ -537,11 +534,11 @@
} -cleanup {
foreach i [after info] {
after cancel $i
}
} -result {{} x-done y-done before q-done}
-test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} -setup {
+test event-11.4 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} -setup {
set test1file [makeFile "" test1]
} -constraints {socket} -body {
set f1 [open $test1file w]
proc accept {s args} {
puts $s foobar
@@ -563,11 +560,11 @@
close $s2
list $x $y $z
} -cleanup {
removeFile $test1file
} -result {3 3 done}
-test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
+test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
set test1file [makeFile "" test1]
set test2file [makeFile "" test2]
set f1 [open $test1file w]
set f2 [open $test2file w]
set x 0
@@ -581,10 +578,73 @@
close $f2
removeFile $test1file
removeFile $test2file
list $x $y $z
} {3 3 done}
+test event-11.6 {Tcl_VwaitCmd procedure event sources} -returnCodes error -body {
+ vwait a b
+} -result {bad event "b": must be -window, -file, -timer, -idle, or -all}
+test event-11.7 {Tcl_VwaitCmd procedure, wait for all events} -setup {
+ foreach i [after info] {
+ after cancel $i
+ }
+ after 10; update; # On Mac make sure update won't take long
+} -body {
+ 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 -all] $x $y $z $q
+} -cleanup {
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {{} x-done y-done before q-done}
+test event-11.8 {Tcl_VwaitCmd procedure, only wait for timer events} -setup {
+ foreach i [after info] {
+ after cancel $i
+ }
+ after 10; update; # On Mac make sure update won't take long
+} -body {
+ 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 -timer] $x $y $z $q
+} -cleanup {
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {{} x-done y-done before before}
+test event-11.9 {Tcl_VwaitCmd procedure, only wait for idle events} -returnCodes error -setup {
+ foreach i [after info] {
+ after cancel $i
+ }
+ after 10; update; # On Mac make sure update won't take long
+} -body {
+ 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 -idle] $x $y $z $q
+} -cleanup {
+ foreach i [after info] {
+ after cancel $i
+ }
+} -result {can't wait for variable "y": would wait forever}
test event-12.1 {Tcl_UpdateCmd procedure} -returnCodes error -body {
update a b
} -result {wrong # args: should be "update ?idletasks?"}
test event-12.2 {Tcl_UpdateCmd procedure} -returnCodes error -body {
------------------------------------------------------------------------------
Dive into the World of Parallel Programming The Go Parallel Website, sponsored
by Intel and developed in partnership with Slashdot Media, is your hub for all
things parallel software development, from weekly thought leadership blogs to
news, videos, case studies, tutorials and more. Take a look and join the
conversation now. http://goparallel.sourceforge.net/
_______________________________________________
Tcl-Core mailing list
Tcl-...@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/tcl-core