From 00604f72c60af9ed0748c955048a446f7e5f7b9c Mon Sep 17 00:00:00 2001
From: fvogel <fvogelnew1@free.fr>
Date: Thu, 21 Apr 2016 22:03:01 +0000
Subject: Fixed [b362182e45] - Generation of virtual events through
 Tk_HandleEvent is unsafe

---
 generic/tkInt.h         |  2 +-
 generic/tkListbox.c     | 11 +----------
 generic/tkText.c        | 26 ++------------------------
 generic/tkTextDisp.c    | 17 ++++-------------
 generic/tkUtil.c        |  9 +++++++--
 macosx/tkMacOSXDialog.c |  8 ++++----
 tests/listbox.test      |  1 +
 tests/text.test         |  6 +++++-
 win/tkWinDialog.c       |  8 ++++----
 9 files changed, 29 insertions(+), 59 deletions(-)

diff --git a/generic/tkInt.h b/generic/tkInt.h
index b644c5b..029f0f1 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.h
@@ -1208,7 +1208,7 @@ MODULE_SCOPE void	TkpCreateBusy(Tk_FakeWin *winPtr, Tk_Window tkRef,
 MODULE_SCOPE int	TkBackgroundEvalObjv(Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const *objv, int flags);
 MODULE_SCOPE void	TkSendVirtualEvent(Tk_Window tgtWin,
-			    const char *eventName);
+			    const char *eventName, Tcl_Obj *detail);
 MODULE_SCOPE Tcl_Command TkMakeEnsemble(Tcl_Interp *interp,
 			    const char *nsname, const char *name,
 			    ClientData clientData, const TkEnsemble *map);
diff --git a/generic/tkListbox.c b/generic/tkListbox.c
index c7effdd..b059727 100644
--- a/generic/tkListbox.c
+++ b/generic/tkListbox.c
@@ -3223,16 +3223,7 @@ static void
 GenerateListboxSelectEvent(
     Listbox *listPtr)		/* Information about widget. */
 {
-    union {XEvent general; XVirtualEvent virtual;} event;
-
-    memset(&event, 0, sizeof(event));
-    event.general.xany.type = VirtualEvent;
-    event.general.xany.serial = NextRequest(Tk_Display(listPtr->tkwin));
-    event.general.xany.send_event = False;
-    event.general.xany.window = Tk_WindowId(listPtr->tkwin);
-    event.general.xany.display = Tk_Display(listPtr->tkwin);
-    event.virtual.name = Tk_GetUid("ListboxSelect");
-    Tk_HandleEvent(&event.general);
+    TkSendVirtualEvent(listPtr->tkwin, "ListboxSelect", NULL);
 }
 
 /*
diff --git a/generic/tkText.c b/generic/tkText.c
index 506075d..b17a425 100644
--- a/generic/tkText.c
+++ b/generic/tkText.c
@@ -3554,16 +3554,7 @@ TkTextSelectionEvent(
      *     event generate $textWidget <<Selection>>
      */
 
-    union {XEvent general; XVirtualEvent virtual;} event;
-
-    memset(&event, 0, sizeof(event));
-    event.general.xany.type = VirtualEvent;
-    event.general.xany.serial = NextRequest(Tk_Display(textPtr->tkwin));
-    event.general.xany.send_event = False;
-    event.general.xany.window = Tk_WindowId(textPtr->tkwin);
-    event.general.xany.display = Tk_Display(textPtr->tkwin);
-    event.virtual.name = Tk_GetUid("Selection");
-    Tk_HandleEvent(&event.general);
+    TkSendVirtualEvent(textPtr->tkwin, "Selection", NULL);
 }
 
 /*
@@ -5361,21 +5352,8 @@ static void
 GenerateModifiedEvent(
     TkText *textPtr)	/* Information about text widget. */
 {
-    union {
-	XEvent general;
-	XVirtualEvent virtual;
-    } event;
-
     Tk_MakeWindowExist(textPtr->tkwin);
-
-    memset(&event, 0, sizeof(event));
-    event.general.xany.type = VirtualEvent;
-    event.general.xany.serial = NextRequest(Tk_Display(textPtr->tkwin));
-    event.general.xany.send_event = False;
-    event.general.xany.window = Tk_WindowId(textPtr->tkwin);
-    event.general.xany.display = Tk_Display(textPtr->tkwin);
-    event.virtual.name = Tk_GetUid("Modified");
-    Tk_HandleEvent(&event.general);
+    TkSendVirtualEvent(textPtr->tkwin, "Modified", NULL);
 }
 
 /*
diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c
index 0849307..81bce94 100644
--- a/generic/tkTextDisp.c
+++ b/generic/tkTextDisp.c
@@ -3104,7 +3104,7 @@ AsyncUpdateLineMetrics(
  *      Send the <<WidgetViewSync>> event related to the text widget
  *      line metrics asynchronous update.
  *      This is equivalent to:
- *         event generate $textWidget <<WidgetViewSync>> -detail $s
+ *         event generate $textWidget <<WidgetViewSync>> -data $s
  *      where $s is the sync status: true (when the widget view is in
  *      sync with its internal data) or false (when it is not).
  *
@@ -3120,19 +3120,10 @@ AsyncUpdateLineMetrics(
 static void
 GenerateWidgetViewSyncEvent(
     TkText *textPtr,		/* Information about text widget. */
-    Bool InSync)                /* True if in sync, false otherwise */
+    Bool InSync)                /* true if in sync, false otherwise */
 {
-    union {XEvent general; XVirtualEvent virtual;} event;
-
-    memset(&event, 0, sizeof(event));
-    event.general.xany.type = VirtualEvent;
-    event.general.xany.serial = NextRequest(Tk_Display(textPtr->tkwin));
-    event.general.xany.send_event = False;
-    event.general.xany.window = Tk_WindowId(textPtr->tkwin);
-    event.general.xany.display = Tk_Display(textPtr->tkwin);
-    event.virtual.name = Tk_GetUid("WidgetViewSync");
-    event.virtual.user_data = Tcl_NewBooleanObj(InSync);
-    Tk_HandleEvent(&event.general);
+    TkSendVirtualEvent(textPtr->tkwin, "WidgetViewSync",
+        Tcl_NewBooleanObj(InSync));
 }
 
 /*
diff --git a/generic/tkUtil.c b/generic/tkUtil.c
index 7ff9ecb..6563165 100644
--- a/generic/tkUtil.c
+++ b/generic/tkUtil.c
@@ -1162,7 +1162,8 @@ TkMakeEnsemble(
  * TkSendVirtualEvent --
  *
  * 	Send a virtual event notification to the specified target window.
- * 	Equivalent to "event generate $target <<$eventName>>"
+ * 	Equivalent to:
+ * 	    "event generate $target <<$eventName>> -data $detail"
  *
  * 	Note that we use Tk_QueueWindowEvent, not Tk_HandleEvent, so this
  * 	routine does not reenter the interpreter.
@@ -1173,7 +1174,8 @@ TkMakeEnsemble(
 void
 TkSendVirtualEvent(
     Tk_Window target,
-    const char *eventName)
+    const char *eventName,
+    Tcl_Obj *detail)
 {
     union {XEvent general; XVirtualEvent virtual;} event;
 
@@ -1184,6 +1186,9 @@ TkSendVirtualEvent(
     event.general.xany.window = Tk_WindowId(target);
     event.general.xany.display = Tk_Display(target);
     event.virtual.name = Tk_GetUid(eventName);
+    if (detail != NULL) {
+        event.virtual.user_data = detail;
+    }
 
     Tk_QueueWindowEvent(&event.general, TCL_QUEUE_TAIL);
 }
diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c
index f6edb6d..80a7a11 100644
--- a/macosx/tkMacOSXDialog.c
+++ b/macosx/tkMacOSXDialog.c
@@ -1320,7 +1320,7 @@ FontchooserEvent(
     switch (kind) {
     case FontchooserClosed:
 	if (fcdPtr->parent != None) {
-	    TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility");
+	    TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility", NULL);
 	    fontchooserInterp = NULL;
 	}
 	break;
@@ -1343,7 +1343,7 @@ FontchooserEvent(
 		    ckfree(tmpv);
 		}
 	    }
-	    TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserFontChanged");
+	    TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserFontChanged", NULL);
 	}
 	break;
     }
@@ -1553,7 +1553,7 @@ FontchooserConfigureCmd(
 	    [fm setSelectedAttributes:fontPanelFontAttributes
 		    isMultiple:NO];
 	    if ([fp isVisible]) {
-		TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserFontChanged");
+		TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserFontChanged", NULL);
 	    }
 	    break;
 	case FontchooserCmd:
@@ -1616,7 +1616,7 @@ FontchooserShowCmd(
     }
     if (![fp isVisible]) {
 	[fm orderFrontFontPanel:NSApp];
-	TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility");
+	TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility", NULL);
     }
     fontchooserInterp = interp;
 
diff --git a/tests/listbox.test b/tests/listbox.test
index 76a4349..407420c 100644
--- a/tests/listbox.test
+++ b/tests/listbox.test
@@ -3170,6 +3170,7 @@ test listbox-31.2 {<<ListboxSelect>> event on lost selection} -setup {
     focus -force .l
     event generate .l <1> -x 5 -y 5  ; # <<ListboxSelect>> fires
     selection clear                  ; # <<ListboxSelect>> fires again
+    update
     set res
 } -cleanup {
     destroy .l
diff --git a/tests/text.test b/tests/text.test
index a778b79..a500daf 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -6280,7 +6280,7 @@ test text-27.11 {TextEditCmd procedure, set modified flag repeat} -setup {
 # Shouldn't require [update idle] to trigger event [Bug 1809538]
     lappend ::retval [.t edit modified]
     .t edit modified 1
-    update idletasks
+    update
     lappend ::retval [.t edit modified]
     .t edit modified 1 ; # binding should only fire once [Bug 1799782]
     update idletasks
@@ -6295,6 +6295,7 @@ test text-27.12 {<<Modified>> virtual event} -body {
     bind .t <<Modified>> "set ::retval modified"
     update idletasks
     .t insert end "nothing special\n"
+    update
     return $::retval
 } -cleanup {
     destroy .t
@@ -6305,6 +6306,7 @@ test text-27.13 {<<Modified>> virtual event - insert before Modified} -body {
     bind .t <<Modified>> { set ::retval [.t get 1.0 end-1c] }
     update idletasks
     .t insert end "nothing special"
+    update
     return $::retval
 } -cleanup {
     destroy .t
@@ -6317,6 +6319,7 @@ test text-27.14 {<<Modified>> virtual event - delete before Modified} -body {
     .t insert end "nothing special"
     .t edit modified 0
     .t delete 1.0 1.2
+    update
     set ::retval
 } -cleanup {
     destroy .t
@@ -6328,6 +6331,7 @@ test text-27.15 {<<Selection>> virtual event} -body {
     update idletasks
     .t insert end "nothing special\n"
     .t tag add sel 1.0 1.1
+    update
     set ::retval
 } -cleanup {
     destroy .t
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index d7f63fb..d58bd52 100644
--- a/win/tkWinDialog.c
+++ b/win/tkWinDialog.c
@@ -3145,13 +3145,13 @@ HookProc(
 	if (IsWindow(hwndCtrl)) {
 	    EnableWindow(hwndCtrl, FALSE);
 	}
-	TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility");
+	TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility", NULL);
 	return 1; /* we handled the message */
     }
 
     if (WM_DESTROY == msg) {
 	phd->hwnd = NULL;
-	TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility");
+	TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility", NULL);
 	return 0;
     }
 
@@ -3169,7 +3169,7 @@ HookProc(
 	    ApplyLogfont(phd->interp, phd->cmdObj, hdc, &lf);
 	}
 	if (phd && phd->parent) {
-	    TkSendVirtualEvent(phd->parent, "TkFontchooserFontChanged");
+	    TkSendVirtualEvent(phd->parent, "TkFontchooserFontChanged", NULL);
 	}
 	return 1;
     }
@@ -3481,7 +3481,7 @@ FontchooserShowCmd(
 		ApplyLogfont(hdPtr->interp, hdPtr->cmdObj, hdc, &lf);
 	    }
 	    if (hdPtr->parent) {
-		TkSendVirtualEvent(hdPtr->parent, "TkFontchooserFontChanged");
+		TkSendVirtualEvent(hdPtr->parent, "TkFontchooserFontChanged", NULL);
 	    }
 	}
 	Tcl_SetServiceMode(oldMode);
-- 
cgit v0.12


From d9629dd3f036632bf29ca7792d85a0fd346e8cb9 Mon Sep 17 00:00:00 2001
From: fvogel <fvogelnew1@free.fr>
Date: Fri, 22 Apr 2016 20:15:13 +0000
Subject: Added test text-11a.51 to check the fix of [b362182e45]

---
 tests/text.test | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

diff --git a/tests/text.test b/tests/text.test
index a500daf..4b27c76 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -3053,6 +3053,25 @@ test text-11a.41 {"sync" "pendingsync" and <<WidgetViewSync>>} -setup {
     destroy .top.yt .top
 } -result {Sync:0 Pending:1 Sync:1 Pending:0}
 
+test text-11a.51 {<<WidgetViewSync>> calls TkSendVirtualEvent(),
+                  NOT Tk_HandleEvent().
+                  Bug [b362182e45704dd7bbd6aed91e48122035ea3d16]} -setup {
+    destroy .top.t .top
+} -body {
+    set res {}
+    toplevel .top
+    pack [text .top.t]
+    for {set i 1} {$i < 10000} {incr i} {
+        .top.t insert end "Hello world!\n" 
+    }
+    bind .top.t <<WidgetViewSync>> {destroy .top.t}
+    .top.t tag add mytag 1.5 8000.8    ; # shall not crash
+    update
+    set res "Still doing fine!"
+} -cleanup {
+    destroy .top.t .top
+} -result {Still doing fine!}
+
 test text-12.1 {TextWidgetCmd procedure, "index" option} -setup {
     text .t
 } -body {
-- 
cgit v0.12