| Store | Cart

Re: [TCLCORE] TIP #434: Specify Event Sources for 'vwait'

From: Jos Decoster <jos....@gmail.com>
Mon, 2 Mar 2015 21:42:16 +0100
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

Recent Messages in this Thread
Jos Decoster Mar 02, 2015 11:20 am
Alexandre Ferrieux Mar 02, 2015 12:56 pm
Jos Decoster Mar 02, 2015 08:42 pm
Pietro Cerutti Mar 04, 2015 10:49 pm
Joe English Mar 06, 2015 06:22 pm
Jos Decoster Mar 07, 2015 08:13 pm
Brian Griffin Mar 07, 2015 08:21 pm
Andreas Leitgeb Mar 14, 2015 11:30 pm
Messages in this thread