merge core-8-6-branch

8 files changed, 89 insertions, 34 deletions

diff --git a/.github/workflows/mac-build.yml b/.github/workflows/mac-build.yml
index e15ff80..41da00c 100644
--- a/.github/workflows/mac-build.yml
+++ b/.github/workflows/mac-build.yml
@@ -136,8 +136,6 @@ jobs:
             echo "::error::Failure during Test"
             exit 1
           }
-        env:
-          MAC_CI: 1
       - name: Carry out trial installation
         run: |
           make install || {
diff --git a/generic/tkInt.h b/generic/tkInt.h
index a98b6d6..c281821 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.h
@@ -679,6 +679,10 @@ typedef struct TkMainInfo {
     struct TkMainInfo *nextPtr;	/* Next in list of all main windows managed by
 				 * this process. */
     Tcl_HashTable busyTable;	/* Information used by [tk busy] command. */
+    Tcl_ObjCmdProc *tclUpdateObjProc;
+				/* Saved Tcl [update] command, used to restore
+				 * Tcl's version of [update] after Tk is shut
+				 * down */
 } TkMainInfo;
 
 /*
@@ -1198,9 +1202,6 @@ MODULE_SCOPE int	Tk_SelectionObjCmd(ClientData clientData,
 MODULE_SCOPE int	Tk_SendObjCmd(ClientData clientData,
 			    Tcl_Interp *interp,int objc,
 			    Tcl_Obj *const objv[]);
-MODULE_SCOPE int	Tk_SendObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
 MODULE_SCOPE int	Tk_SpinboxObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -1322,7 +1323,8 @@ MODULE_SCOPE void	TkUnixSetXftClipRegion(TkRegion clipRegion);
 # define c_class class
 #endif
 
-#if TCL_UTF_MAX > 4
+/* Tcl 8.6 has a different definition of Tcl_UniChar than other Tcl versions for TCL_UTF_MAX > 3 */
+#if TCL_UTF_MAX > (3 + (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 6))
 #   define TkUtfToUniChar Tcl_UtfToUniChar
 #   define TkUniCharToUtf Tcl_UniCharToUtf
 #   define TkUtfPrev Tcl_UtfPrev
diff --git a/generic/tkUtil.c b/generic/tkUtil.c
index 00ac7be..375bb83 100644
--- a/generic/tkUtil.c
+++ b/generic/tkUtil.c
@@ -57,8 +57,7 @@ TkStateParseProc(
     int flags = PTR2INT(clientData);
     size_t length;
     Tcl_Obj *msgObj;
-
-    register Tk_State *statePtr = (Tk_State *) (widgRec + offset);
+    Tk_State *statePtr = (Tk_State *) (widgRec + offset);
 
     if (value == NULL || *value == 0) {
 	*statePtr = TK_STATE_NULL;
@@ -134,7 +133,7 @@ TkStatePrintProc(
 				 * information about how to reclaim storage
 				 * for return string. */
 {
-    register Tk_State *statePtr = (Tk_State *) (widgRec + offset);
+    Tk_State *statePtr = (Tk_State *) (widgRec + offset);
 
     switch (*statePtr) {
     case TK_STATE_NORMAL:
@@ -179,8 +178,7 @@ TkOrientParseProc(
 {
     int c;
     size_t length;
-
-    register int *orientPtr = (int *) (widgRec + offset);
+    int *orientPtr = (int *) (widgRec + offset);
 
     if (value == NULL || *value == 0) {
 	*orientPtr = 0;
@@ -237,7 +235,7 @@ TkOrientPrintProc(
 				 * information about how to reclaim storage
 				 * for return string. */
 {
-    register int *statePtr = (int *) (widgRec + offset);
+    int *statePtr = (int *) (widgRec + offset);
 
     if (*statePtr) {
 	return "vertical";
@@ -424,7 +422,7 @@ TkOffsetPrintProc(
 	if (offsetPtr->flags >= INT_MAX) {
 	    return "end";
 	}
-	p = ckalloc(32);
+	p = (char *)ckalloc(32);
 	sprintf(p, "%d", offsetPtr->flags & ~TK_OFFSET_INDEX);
 	*freeProcPtr = TCL_DYNAMIC;
 	return p;
@@ -454,7 +452,7 @@ TkOffsetPrintProc(
 	    return "se";
 	}
     }
-    q = p = ckalloc(32);
+    q = p = (char *)ckalloc(32);
     if (offsetPtr->flags & TK_OFFSET_RELATIVE) {
 	*q++ = '#';
     }
@@ -519,7 +517,7 @@ TkPixelPrintProc(
     Tcl_FreeProc **freeProcPtr)	/* not used */
 {
     double *doublePtr = (double *) (widgRec + offset);
-    char *p = ckalloc(24);
+    char *p = (char *)ckalloc(24);
 
     Tcl_PrintDouble(NULL, *doublePtr, p);
     *freeProcPtr = TCL_DYNAMIC;
@@ -1088,7 +1086,7 @@ TkBackgroundEvalObjv(
 Tcl_Command
 TkMakeEnsemble(
     Tcl_Interp *interp,
-    const char *namespace,
+    const char *namesp,
     const char *name,
     ClientData clientData,
     const TkEnsemble map[])
@@ -1105,11 +1103,11 @@ TkMakeEnsemble(
 
     Tcl_DStringInit(&ds);
 
-    namespacePtr = Tcl_FindNamespace(interp, namespace, NULL, 0);
+    namespacePtr = Tcl_FindNamespace(interp, namesp, NULL, 0);
     if (namespacePtr == NULL) {
-	namespacePtr = Tcl_CreateNamespace(interp, namespace, NULL, NULL);
+	namespacePtr = Tcl_CreateNamespace(interp, namesp, NULL, NULL);
 	if (namespacePtr == NULL) {
-	    Tcl_Panic("failed to create namespace \"%s\"", namespace);
+	    Tcl_Panic("failed to create namespace \"%s\"", namesp);
 	}
     }
 
@@ -1125,8 +1123,8 @@ TkMakeEnsemble(
     }
 
     Tcl_DStringSetLength(&ds, 0);
-    Tcl_DStringAppend(&ds, namespace, -1);
-    if (!(strlen(namespace) == 2 && namespace[1] == ':')) {
+    Tcl_DStringAppend(&ds, namesp, -1);
+    if (!(strlen(namesp) == 2 && namesp[1] == ':')) {
 	Tcl_DStringAppend(&ds, "::", -1);
     }
     Tcl_DStringAppend(&ds, name, -1);
@@ -1192,7 +1190,8 @@ TkSendVirtualEvent(
     Tk_QueueWindowEvent(&event.general, TCL_QUEUE_TAIL);
 }
 
-#if TCL_UTF_MAX <= 4
+/* Tcl 8.6 has a different definition of Tcl_UniChar than other Tcl versions for TCL_UTF_MAX > 3 */
+#if TCL_UTF_MAX <= (3 + (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 6))
 /*
  *---------------------------------------------------------------------------
  *
@@ -1221,11 +1220,11 @@ TkUtfToUniChar(
     Tcl_UniChar uniChar = 0;
 
     int len = Tcl_UtfToUniChar(src, &uniChar);
-    if ((sizeof(Tcl_UniChar) == 2) && ((uniChar & 0xFC00) == 0xD800)) {
+    if ((uniChar & 0xFC00) == 0xD800) {
 	Tcl_UniChar low = uniChar;
-	/* This can only happen if Tcl is compiled with TCL_UTF_MAX=4,
-	 * or when a high surrogate character is detected in UTF-8 form */
-	int len2 = Tcl_UtfToUniChar(src+len, &low);
+	/* This can only happen if sizeof(Tcl_UniChar)== 2 and src points
+	 * to a character > U+FFFF  */
+	size_t len2 = Tcl_UtfToUniChar(src+len, &low);
 	if ((low & 0xFC00) == 0xDC00) {
 	    *chPtr = (((uniChar & 0x3FF) << 10) | (low & 0x3FF)) + 0x10000;
 	    return len + len2;
@@ -1256,7 +1255,7 @@ TkUtfToUniChar(
 
 int TkUniCharToUtf(int ch, char *buf)
 {
-    if ((sizeof(Tcl_UniChar) == 2) && (((unsigned)(ch - 0x10000) <= 0xFFFFF))) {
+    if ((unsigned)(ch - 0x10000) <= 0xFFFFF) {
 	/* Spit out a 4-byte UTF-8 character or 2 x 3-byte UTF-8 characters, depending on Tcl
 	 * version and/or TCL_UTF_MAX build value */
 	int len = Tcl_UniCharToUtf(0xD800 | ((ch - 0x10000) >> 10), buf);
@@ -1333,7 +1332,6 @@ TkUtfAtIndex(
     return p;
 }
 #endif
-
 /*
  * Local Variables:
  * mode: c
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index 9750ed8..c2f6eaa 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -93,6 +93,7 @@ static const XSetWindowAttributes defAtts= {
 #define PASSMAINWINDOW 2
 #define WINMACONLY 4
 #define USEINITPROC 8
+#define SAVEUPDATECMD 16 /* better only be one of these! */
 
 typedef int (TkInitProc)(Tcl_Interp *interp, ClientData clientData);
 typedef struct {
@@ -126,7 +127,7 @@ static const TkCmd commands[] = {
     {"selection",	Tk_SelectionObjCmd,	PASSMAINWINDOW},
     {"tk",		(Tcl_ObjCmdProc *)(void *)TkInitTkCmd,  USEINITPROC|PASSMAINWINDOW|ISSAFE},
     {"tkwait",		Tk_TkwaitObjCmd,	PASSMAINWINDOW|ISSAFE},
-    {"update",		Tk_UpdateObjCmd,	PASSMAINWINDOW|ISSAFE},
+    {"update",		Tk_UpdateObjCmd,	PASSMAINWINDOW|ISSAFE|SAVEUPDATECMD},
     {"winfo",		Tk_WinfoObjCmd,		PASSMAINWINDOW|ISSAFE},
     {"wm",		Tk_WmObjCmd,		PASSMAINWINDOW},
 
@@ -880,6 +881,7 @@ TkCreateMainWindow(
     Tcl_InitHashTable(&mainPtr->imageTable, TCL_STRING_KEYS);
     mainPtr->strictMotif = 0;
     mainPtr->alwaysShowSelection = 0;
+    mainPtr->tclUpdateObjProc = NULL;
     if (Tcl_LinkVar(interp, "tk_strictMotif", (char *) &mainPtr->strictMotif,
 	    TCL_LINK_BOOLEAN) != TCL_OK) {
 	Tcl_ResetResult(interp);
@@ -919,6 +921,8 @@ TkCreateMainWindow(
 
     isSafe = Tcl_IsSafe(interp);
     for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
+	Tcl_CmdInfo cmdInfo;
+	
 	if (cmdPtr->objProc == NULL) {
 	    Tcl_Panic("TkCreateMainWindow: builtin command with NULL string and object procs");
 	}
@@ -938,6 +942,11 @@ TkCreateMainWindow(
 	} else {
 	    clientData = NULL;
 	}
+	if ((cmdPtr->flags & SAVEUPDATECMD) &&
+	    Tcl_GetCommandInfo(interp, cmdPtr->name, &cmdInfo) &&
+	    cmdInfo.isNativeObjectProc) {
+	    mainPtr->tclUpdateObjProc = cmdInfo.objProc;
+	}
 	if (cmdPtr->flags & USEINITPROC) {
 	    ((TkInitProc *)(void *)cmdPtr->objProc)(interp, clientData);
 	} else {
@@ -1502,10 +1511,20 @@ Tk_DestroyWindow(
 	     */
 
 	    if ((winPtr->mainPtr->interp != NULL) &&
-		    !Tcl_InterpDeleted(winPtr->mainPtr->interp)) {
+		!Tcl_InterpDeleted(winPtr->mainPtr->interp)) {
 		for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
-		    Tcl_CreateObjCommand(winPtr->mainPtr->interp, cmdPtr->name,
-			    TkDeadAppObjCmd, NULL, NULL);
+		    if ((cmdPtr->flags & SAVEUPDATECMD) &&
+			winPtr->mainPtr->tclUpdateObjProc != NULL) {
+			/* Restore Tcl's version of [update] */
+			Tcl_CreateObjCommand(winPtr->mainPtr->interp,
+					     cmdPtr->name,
+					     winPtr->mainPtr->tclUpdateObjProc,
+					     NULL, NULL);
+		    } else {
+			Tcl_CreateObjCommand(winPtr->mainPtr->interp,
+					     cmdPtr->name, TkDeadAppObjCmd,
+					     NULL, NULL);
+		    }
 		}
 		Tcl_CreateObjCommand(winPtr->mainPtr->interp, "send",
 			TkDeadAppObjCmd, NULL, NULL);
diff --git a/tests/event.test b/tests/event.test
index 28fe8af..9af334c 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -874,6 +874,9 @@ test event-9 {no <Enter> event is generated for the container window when its
     pack propagate .top 0
     bind .top <Enter> {lappend res %W}
     pack [frame .top.f -bg green -width 50 -height 50] -anchor se -side bottom
+    # stabilize the test by giving some time to the OS before the upcoming update,
+    # so that -warp below finds the frame
+    after 50
     update
     event generate .top.f <Motion> -warp 1 -x 25 -y 25  ; # <Enter> sent to .top and .top.f
     controlPointerWarpTiming
diff --git a/tests/textTag.test b/tests/textTag.test
index 62ede5b..9e5ccdc 100644
--- a/tests/textTag.test
+++ b/tests/textTag.test
@@ -1614,6 +1614,8 @@ test textTag-16.2 {TkTextPickCurrent procedure} -constraints {
     controlPointerWarpTiming
 } -body {
     .t tag configure big -font $bigFont
+    # update needed here to stabilize the test
+    update
     event gen .t <ButtonRelease-1> -state 0x100 -x $x1 -y $y1
     event gen .t <Motion> -x $x2 -y $y2
     set x [.t index current]
diff --git a/tests/tk.test b/tests/tk.test
index 9e088ce..f1a6b9a 100644
--- a/tests/tk.test
+++ b/tests/tk.test
@@ -10,7 +10,7 @@ eval tcltest::configure $argv
 tcltest::loadTestedCommands
 namespace import -force tcltest::test
 
-testConstraint failsOnQuarz [expr {![info exists ::env(MAC_CI)]}]
+testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }]
 
 test tk-1.1 {tk command: general} -body {
     tk
@@ -154,7 +154,7 @@ test tk-6.3 {tk inactive wrong argument} -body {
 test tk-6.4 {tk inactive too many arguments} -body {
     tk inactive reset foo
 } -returnCodes 1 -result {wrong # args: should be "tk inactive ?-displayof window? ?reset?"}
-test tk-6.5 {tk inactive} -constraints failsOnQuarz -body {
+test tk-6.5 {tk inactive} -constraints failsOnXQuarz -body {
     tk inactive reset
     update
     after 100
diff --git a/tests/window.test b/tests/window.test
index fea695a..c3b507d 100644
--- a/tests/window.test
+++ b/tests/window.test
@@ -263,6 +263,38 @@ test window-2.11 {Tk_DestroyWindow, don't reanimate a half-dead window} -constra
     list $error $msg
 } -result {0 YES}
 
+test window-2.12 {Test for ticket [9b6065d1fd] - restore Tcl [update] command} -constraints {
+    unixOrWin
+} -body {
+    set code [loadTkCommand]
+    append code {
+	after 1000 {set forever 1}
+	after 100 {destroy .}
+	after 200 {catch bell msg; puts "ringing the bell -> $msg"}
+	after 250 {update idletasks}
+	after 300 {update}
+	puts "waiting"
+	vwait forever
+	puts "done waiting"
+	catch {bell} msg
+	puts "bell -> $msg"
+	catch update msg
+	puts "update -> $msg"
+    }
+    set script [makeFile $code script]
+    if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} {
+        set error 1
+    } else {
+        set error 0
+    }
+    removeFile script
+    list $error $msg
+} -result {0 {waiting
+ringing the bell -> can't invoke "bell" command: application has been destroyed
+done waiting
+bell -> can't invoke "bell" command: application has been destroyed
+update -> }}
+
 
 test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} -constraints {
     unix testmenubar
@@ -342,6 +374,7 @@ test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} -con
 } -result {}
 
 
+
 # cleanup
 cleanupTests
 return