Add a simple version of the processevents test command and use it for the event-9* tests.

2 files changed, 91 insertions, 40 deletions

diff --git a/generic/tkTest.c b/generic/tkTest.c
index 755a6be..4fc6a80 100644
--- a/generic/tkTest.c
+++ b/generic/tkTest.c
@@ -147,6 +147,9 @@ typedef struct TrivialCommandHeader {
 static int		ImageObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj * const objv[]);
+static int		ProcessEventsObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj * const objv[]);
 static int		TestbitmapObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj * const objv[]);
@@ -247,6 +250,7 @@ Tktest_Init(
 	return TCL_ERROR;
     }
 
+    Tcl_CreateObjCommand(interp, "processevents", ProcessEventsObjCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "square", SquareObjCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "testbitmap", TestbitmapObjCmd,
 	    (ClientData) Tk_MainWindow(interp), NULL);
@@ -1682,6 +1686,48 @@ ImageDelete(
 /*
  *----------------------------------------------------------------------
  *
+ * ProcessEventsObjCmd --
+ *
+ *	This function implements the "processevents" command. Currently
+ *      It processes all <Enter> or <Leave> events on the queue.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Events are processed
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_RestrictAction
+CrossingRestrictProc(
+    ClientData arg,
+    XEvent *eventPtr)
+{
+    if (eventPtr->type == EnterNotify || eventPtr->type == LeaveNotify) {
+	return TK_PROCESS_EVENT;
+    }
+    return TK_DEFER_EVENT;	
+}
+
+static int ProcessEventsObjCmd(ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj * const objv[])
+{
+    ClientData oldArg;
+    Tk_RestrictProc *oldProc;
+    int count = 0;
+    oldProc = Tk_RestrictEvents(CrossingRestrictProc, NULL, &oldArg);
+    while (Tcl_ServiceEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT)) {};
+    Tk_RestrictEvents(oldProc, oldArg, &oldArg);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestmakeexistObjCmd --
  *
  *	This function implements the "testmakeexist" command. It calls
diff --git a/tests/event.test b/tests/event.test
index 7fcdab3..10dcf07 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -929,13 +929,13 @@ test event-9.11 {pointer window container = parent} -setup {
     create_and_pack_frames .one
     wm deiconify .one
     tkwait visibility .one.f1.f2
-    _pause 200
-    bind all <Leave> {append result "<Leave> %d %W|"}
-    bind all <Enter> {append result "<Enter> %d %W|"}
+    update; # finish display of window
     set result "|"
 } -body {
+    bind all <Leave> {append result "<Leave> %d %W|"}
+    bind all <Enter> {append result "<Enter> %d %W|"}
     destroy .one.f1.f2
-    _pause 200; # service crossing events
+    processevents end
     set result
 } -cleanup {
     bind all <Leave> {}
@@ -953,13 +953,13 @@ test event-9.12 {pointer window container != parent} -setup {
     wm deiconify .one
     tkwait visibility .one.g
     event generate .one <Motion> -warp 1 -x 250 -y 250
-    _pause 200
-    bind all <Leave> {append result "<Leave> %d %W|"}
-    bind all <Enter> {append result "<Enter> %d %W|"}
+    update; # finish mouse warp
     set result "|"
 } -body {
+    bind all <Leave> {append result "<Leave> %d %W|"}
+    bind all <Enter> {append result "<Enter> %d %W|"}
     destroy .one.g
-    _pause 200; # service crossing events -- crashes without this
+    processevents end
     set result
 } -cleanup {
     bind all <Leave> {}
@@ -975,18 +975,19 @@ test event-9.13 {pointer window is a toplevel, toplevel destination} -setup {
     wm withdraw .two
     wm deiconify .two
     waitForWindowEvent .two <Enter>
-    bind all <Leave> {append result "<Leave> %d %W|"}
-    bind all <Enter> {append result "<Enter> %d %W|"}
+    update; # finish displaying windows
     set result |
 } -body {
+    bind all <Leave> {append result "<Leave> %d %W|"}
+    bind all <Enter> {append result "<Enter> %d %W|"}
     destroy .two
     waitForWindowEvent .one <Enter>
-    # destroying .one here instead of in cleanup makes the test pass
-    destroy .one
+    processevents end
     set result
 } -cleanup {
     bind all <Leave> {}
     bind all <Enter> {}
+    destroy .one
     unset result
 } -result {|<Enter> NotifyNonlinear .one|}
 
@@ -1000,17 +1001,18 @@ test event-9.14 {pointer window is a toplevel, tk internal destination} -setup {
     wm deiconify .one
     wm deiconify .two
     waitForWindowEvent .two <Enter>
-    bind all <Leave> {append result "<Leave> %d %W|"}
-    bind all <Enter> {append result "<Enter> %d %W|"}
     set result "|"
 } -body {
+    bind all <Leave> {append result "<Leave> %d %W|"}
+    bind all <Enter> {append result "<Enter> %d %W|"}
     destroy .two
     waitForWindowEvent .one.f1.f2 <Enter>
+    processevents end
+    set result
+} -cleanup {
     bind all <Leave> {}
     bind all <Enter> {}
     destroy .one
-    set result
-} -cleanup {
     unset result
 } -result {|<Enter> NotifyNonlinearVirtual .one|<Enter> NotifyNonlinearVirtual .one.f1|<Enter> NotifyNonlinear .one.f1.f2|}
 
@@ -1022,12 +1024,12 @@ test event-9.15 {pointer window is a toplevel, destination is screen root} -setu
     waitForWindowEvent .two <Enter>
     event generate .two <Motion> -warp 1 -x 275 -y 275
     controlPointerWarpTiming
-    bind all <Leave> {append result "<Leave> %d %W|"}
-    bind all <Enter> {append result "<Enter> %d %W|"}
     set result "|"
 } -body {
-    _pause 200; # ensure servicing of all scheduled events (only <Expose> events expected)
+    bind all <Leave> {append result "<Leave> %d %W|"}
+    bind all <Enter> {append result "<Enter> %d %W|"}
     destroy .two
+    processevents end
     set result
 } -cleanup {
     bind all <Leave> {}
@@ -1044,13 +1046,13 @@ test event-9.16 {Successive destructions (pointer window + parent), single gener
     create_and_pack_frames .one
     wm deiconify .one
     tkwait visibility .one.f1.f2
-    _pause 200
-    bind all <Leave> {append result "<Leave> %d %W|"}
-    bind all <Enter> {append result "<Enter> %d %W|"}
+    update; # finish displaying window 
     set result "|"
 } -body {
+    bind all <Leave> {append result "<Leave> %d %W|"}
+    bind all <Enter> {append result "<Enter> %d %W|"}
     destroy .one.f1
-    _pause 200; # service crossing events
+    processevents end
     set result
 } -cleanup {
     bind all <Leave> {}
@@ -1067,15 +1069,16 @@ test event-9.17 {Successive destructions (pointer window + parent), separate cro
     create_and_pack_frames .one
     wm deiconify .one
     tkwait visibility .one.f1.f2
-    _pause 200
-    bind all <Leave> {append result "<Leave> %d %W|"}
-    bind all <Enter> {append result "<Enter> %d %W|"}
+    update; # finish displaying window
     set result "|"
 } -body {
+    bind all <Leave> {append result "<Leave> %d %W|"}
+    bind all <Enter> {append result "<Enter> %d %W|"}
     destroy .one.f1.f2
-    _pause 200; # service crossing events
+    update; # make sure window is gone
     destroy .one.f1
-    _pause 200; # service crossing events
+    update; # make sure window is gone
+    processevents end
     set result
 } -cleanup {
     bind all <Leave> {}
@@ -1092,17 +1095,18 @@ test event-9.18 {Successive destructions (pointer window + ancestors including i
     create_and_pack_frames .two
     wm deiconify .two
     waitForWindowEvent .two.f1.f2 <Enter>
-    bind all <Leave> {append result "<Leave> %d %W|"}
-    bind all <Enter> {append result "<Enter> %d %W|"}
     set result "|"
 } -body {
+    bind all <Leave> {append result "<Leave> %d %W|"}
+    bind all <Enter> {append result "<Enter> %d %W|"}
     destroy .two
     waitForWindowEvent .one <Enter>
+    processevents end
+    set result
+} -cleanup {
     bind all <Leave> {}
     bind all <Enter> {}
     destroy .one
-    set result
-} -cleanup {
     unset result
 } -result {|<Enter> NotifyNonlinear .one|}
 
@@ -1114,24 +1118,25 @@ test event-9.19 {Successive destructions (pointer window + ancestors including i
     wm geometry .two 300x300+100+100
     create_and_pack_frames .two
     wm deiconify .two
-    waitForWindowEvent .two.f1.f2 <Enter>
     toplevel .three
     pack propagate .three 0
     wm geometry .three 300x300+110+110
     create_and_pack_frames .three
     wm deiconify .three
     waitForWindowEvent .three.f1.f2 <Enter>
-    bind all <Leave> {append result "<Leave> %d %W|"}
-    bind all <Enter> {append result "<Enter> %d %W|"}
+    update; # finish displaying windows
     set result "|"
 } -body {
+    bind all <Leave> {append result "<Leave> %d %W|"}
+    bind all <Enter> {append result "<Enter> %d %W|"}
     destroy .three
     waitForWindowEvent .two.f1.f2 <Enter>
+    processevents end
+    set result
+} -cleanup {
     bind all <Leave> {}
     bind all <Enter> {}
     destroy .two
-    set result
-} -cleanup {
     unset result
 } -result {|<Enter> NotifyNonlinearVirtual .two|<Enter> NotifyNonlinearVirtual .two.f1|<Enter> NotifyNonlinear .two.f1.f2|}
 
@@ -1144,12 +1149,12 @@ test event-9.20 {Successive destructions (pointer window + ancestors including i
     create_and_pack_frames .two
     wm deiconify .two
     waitForWindowEvent .two.f1.f2 <Enter>
-    bind all <Leave> {append result "<Leave> %d %W|"}
-    bind all <Enter> {append result "<Enter> %d %W|"}
     set result "|"
 } -body {
+    bind all <Leave> {append result "<Leave> %d %W|"}
+    bind all <Enter> {append result "<Enter> %d %W|"}
     destroy .two
-    _pause 200; # service events (only screen drawing events expected)
+    processevents end
     set result
 } -cleanup {
     bind all <Leave> {}