Index: generic/tkButton.c ================================================================== --- generic/tkButton.c +++ generic/tkButton.c @@ -1615,11 +1615,31 @@ * the whole interpreter is going away. */ if (flags & TCL_TRACE_UNSETS) { butPtr->flags &= ~(SELECTED | TRISTATED); - if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + if (!Tcl_InterpDeleted(interp)) { + ClientData probe = NULL; + + do { + probe = Tcl_VarTraceInfo(interp, + Tcl_GetString(butPtr->selVarNamePtr), + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonVarProc, probe); + if (probe == (ClientData)butPtr) { + break; + } + } while (probe); + if (probe) { + /* + * We were able to fetch the unset trace for our + * selVarNamePtr, which means it is not unset and not + * the cause of this unset trace. Instead some outdated + * former variable must be, and we should ignore it. + */ + goto redisplay; + } Tcl_TraceVar2(interp, Tcl_GetString(butPtr->selVarNamePtr), NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ButtonVarProc, clientData); } goto redisplay; @@ -1707,11 +1727,38 @@ * If the variable is unset, then immediately recreate it unless the whole * interpreter is going away. */ if (flags & TCL_TRACE_UNSETS) { - if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + if (!Tcl_InterpDeleted(interp) && butPtr->textVarNamePtr != NULL) { + + /* + * An unset trace on some variable brought us here, but is it + * the variable we have stored in butPtr->textVarNamePtr ? + */ + + ClientData probe = NULL; + + do { + probe = Tcl_VarTraceInfo(interp, + Tcl_GetString(butPtr->textVarNamePtr), + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonTextVarProc, probe); + if (probe == (ClientData)butPtr) { + break; + } + } while (probe); + if (probe) { + /* + * We were able to fetch the unset trace for our + * textVarNamePtr, which means it is not unset and not + * the cause of this unset trace. Instead some outdated + * former textvariable must be, and we should ignore it. + */ + return NULL; + } + Tcl_ObjSetVar2(interp, butPtr->textVarNamePtr, NULL, butPtr->textPtr, TCL_GLOBAL_ONLY); Tcl_TraceVar2(interp, Tcl_GetString(butPtr->textVarNamePtr), NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ButtonTextVarProc, clientData); Index: generic/tkEntry.c ================================================================== --- generic/tkEntry.c +++ generic/tkEntry.c @@ -3153,18 +3153,38 @@ * If the variable is unset, then immediately recreate it unless the whole * interpreter is going away. */ if (flags & TCL_TRACE_UNSETS) { - if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + if (!Tcl_InterpDeleted(interp) && entryPtr->textVarName) { + ClientData probe = NULL; + + do { + probe = Tcl_VarTraceInfo(interp, + entryPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + EntryTextVarProc, probe); + if (probe == (ClientData)entryPtr) { + break; + } + } while (probe); + if (probe) { + /* + * We were able to fetch the unset trace for our + * textVarName, which means it is not unset and not + * the cause of this unset trace. Instead some outdated + * former variable must be, and we should ignore it. + */ + return NULL; + } Tcl_SetVar2(interp, entryPtr->textVarName, NULL, entryPtr->string, TCL_GLOBAL_ONLY); Tcl_TraceVar2(interp, entryPtr->textVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, EntryTextVarProc, clientData); entryPtr->flags |= ENTRY_VAR_TRACED; - } + } return NULL; } /* * Update the entry's text with the value of the variable, unless the Index: generic/tkListbox.c ================================================================== --- generic/tkListbox.c +++ generic/tkListbox.c @@ -3443,11 +3443,32 @@ /* * Bwah hahahaha! Puny mortal, you can't unset a -listvar'd variable! */ if (flags & TCL_TRACE_UNSETS) { - if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + + if (!Tcl_InterpDeleted(interp) && listPtr->listVarName) { + ClientData probe = NULL; + + do { + probe = Tcl_VarTraceInfo(interp, + listPtr->listVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ListboxListVarProc, probe); + if (probe == (ClientData)listPtr) { + break; + } + } while (probe); + if (probe) { + /* + * We were able to fetch the unset trace for our + * listVarName, which means it is not unset and not + * the cause of this unset trace. Instead some outdated + * former variable must be, and we should ignore it. + */ + return NULL; + } Tcl_SetVar2Ex(interp, listPtr->listVarName, NULL, listPtr->listObj, TCL_GLOBAL_ONLY); Tcl_TraceVar2(interp, listPtr->listVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ListboxListVarProc, clientData); Index: generic/tkMenu.c ================================================================== --- generic/tkMenu.c +++ generic/tkMenu.c @@ -2484,13 +2484,14 @@ TkMenuEntry *mePtr = clientData; TkMenu *menuPtr; const char *value; const char *name, *onValue; - if (flags & TCL_INTERP_DESTROYED) { + if (Tcl_InterpDeleted(interp) || (mePtr->namePtr == NULL)) { /* - * Do nothing if the interpreter is going away. + * Do nothing if the interpreter is going away or we have + * no variable name. */ return NULL; } @@ -2505,16 +2506,33 @@ /* * If the variable is being unset, then re-establish the trace. */ if (flags & TCL_TRACE_UNSETS) { + ClientData probe = NULL; mePtr->entryFlags &= ~ENTRY_SELECTED; - if (flags & TCL_TRACE_DESTROYED) { - Tcl_TraceVar2(interp, name, NULL, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - MenuVarProc, clientData); - } + + do { + probe = Tcl_VarTraceInfo(interp, name, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuVarProc, probe); + if (probe == (ClientData)mePtr) { + break; + } + } while (probe); + if (probe) { + /* + * We were able to fetch the unset trace for our + * namePtr, which means it is not unset and not + * the cause of this unset trace. Instead some outdated + * former variable must be, and we should ignore it. + */ + return NULL; + } + Tcl_TraceVar2(interp, name, NULL, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuVarProc, clientData); TkpConfigureMenuEntry(mePtr); TkEventuallyRedrawMenu(menuPtr, NULL); return NULL; } Index: generic/tkMenubutton.c ================================================================== --- generic/tkMenubutton.c +++ generic/tkMenubutton.c @@ -885,11 +885,31 @@ * If the variable is unset, then immediately recreate it unless the whole * interpreter is going away. */ if (flags & TCL_TRACE_UNSETS) { - if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + if (!Tcl_InterpDeleted(interp) && mbPtr->textVarName) { + ClientData probe = NULL; + + do { + probe = Tcl_VarTraceInfo(interp, + mbPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuButtonTextVarProc, probe); + if (probe == (ClientData)mbPtr) { + break; + } + } while (probe); + if (probe) { + /* + * We were able to fetch the unset trace for our + * textVarName, which means it is not unset and not + * the cause of this unset trace. Instead some outdated + * former variable must be, and we should ignore it. + */ + return NULL; + } Tcl_SetVar2(interp, mbPtr->textVarName, NULL, mbPtr->text, TCL_GLOBAL_ONLY); Tcl_TraceVar2(interp, mbPtr->textVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MenuButtonTextVarProc, clientData); Index: generic/tkMessage.c ================================================================== --- generic/tkMessage.c +++ generic/tkMessage.c @@ -842,11 +842,31 @@ * If the variable is unset, then immediately recreate it unless the whole * interpreter is going away. */ if (flags & TCL_TRACE_UNSETS) { - if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + if (!Tcl_InterpDeleted(interp) && msgPtr->textVarName) { + ClientData probe = NULL; + + do { + probe = Tcl_VarTraceInfo(interp, + msgPtr->textVarName, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MessageTextVarProc, probe); + if (probe == (ClientData)msgPtr) { + break; + } + } while (probe); + if (probe) { + /* + * We were able to fetch the unset trace for our + * textVarName, which means it is not unset and not + * the cause of this unset trace. Instead some outdated + * former variable must be, and we should ignore it. + */ + return NULL; + } Tcl_SetVar2(interp, msgPtr->textVarName, NULL, msgPtr->string, TCL_GLOBAL_ONLY); Tcl_TraceVar2(interp, msgPtr->textVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MessageTextVarProc, clientData); Index: generic/tkScale.c ================================================================== --- generic/tkScale.c +++ generic/tkScale.c @@ -1196,11 +1196,31 @@ * If the variable is unset, then immediately recreate it unless the whole * interpreter is going away. */ if (flags & TCL_TRACE_UNSETS) { - if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { + if (!Tcl_InterpDeleted(interp) && scalePtr->varNamePtr) { + ClientData probe = NULL; + + do { + probe = Tcl_VarTraceInfo(interp, + Tcl_GetString(scalePtr->varNamePtr), + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ScaleVarProc, probe); + if (probe == (ClientData)scalePtr) { + break; + } + } while (probe); + if (probe) { + /* + * We were able to fetch the unset trace for our + * varNamePtr, which means it is not unset and not + * the cause of this unset trace. Instead some outdated + * former variable must be, and we should ignore it. + */ + return NULL; + } Tcl_TraceVar2(interp, Tcl_GetString(scalePtr->varNamePtr), NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ScaleVarProc, clientData); scalePtr->flags |= NEVER_SET; TkScaleSetValue(scalePtr, scalePtr->value, 1, 0); Index: tests/button.test ================================================================== --- tests/button.test +++ tests/button.test @@ -3955,10 +3955,49 @@ event generate .top.b update ; # shall not trigger error invalid command name ".top.b" } -cleanup { destroy .top.b .top } -result {} + +test button-15.1 {Bug [5d991b822e]} { + # Want this not to segfault + set var INIT + button .b -textvariable var + trace add variable var unset {apply {args { + .b configure -textvariable {} + }}} + pack .b + bind .b {unset var} + update + destroy .b +} {} +test button-15.2 {Bug [5d991b822e]} { + # Want this not to leak traces + set var INIT + button .b -textvariable var + trace add variable var unset {apply {args { + .b configure -textvariable new + }}} + pack .b + bind .b {unset -nocomplain var} + update + destroy .b + unset new +} {} +test button-15.3 {Bug [5d991b822e]} { + # Want this not to leak traces + set var INIT + checkbutton .b -variable var + trace add variable var unset {apply {args { + .b configure -variable {} + }}} + pack .b + bind .b {unset var} + update + destroy .b +} {} + imageFinish cleanupTests return Index: tests/entry.test ================================================================== --- tests/entry.test +++ tests/entry.test @@ -3499,10 +3499,38 @@ catch {entry .e -textvariable thisnsdoesntexist::myvar} result1 set result1 } -cleanup { destroy .e } -result {can't trace "thisnsdoesntexist::myvar": parent namespace doesn't exist} + +test entry-25.1 {Bug [5d991b822e]} { + # Want this not to segfault, or write to variable with empty name + set var INIT + entry .b -textvariable var + trace add variable var unset {apply {args { + .b configure -textvariable {} + }}} + pack .b + bind .b {unset var} + update + destroy .b + info exists {} +} 0 +test entry-25.2 {Bug [5d991b822e]} { + # Want this not to leak traces + set var INIT + entry .b -textvariable var + trace add variable var unset {apply {args { + .b configure -textvariable new + }}} + pack .b + bind .b {unset -nocomplain var} + update + destroy .b + unset new +} {} + # Gathered comments about lacks # XXX Still need to write tests for EntryBlinkProc, EntryFocusProc, # and EntryTextVarProc. # No tests for DisplayEntry. Index: tests/listbox.test ================================================================== --- tests/listbox.test +++ tests/listbox.test @@ -3174,10 +3174,37 @@ update set res } -cleanup { destroy .l } -result {{.l 0} {{} {}}} + +test listbox-32.1 {Bug [5d991b822e]} { + # Want this not to segfault, or write to variable with empty name + set var INIT + listbox .b -listvariable var + trace add variable var unset {apply {args { + .b configure -listvariable {} + }}} + pack .b + bind .b {unset var} + update + destroy .b + info exists {} +} 0 +test listbox-32.2 {Bug [5d991b822e]} { + # Want this not to leak traces + set var INIT + listbox .b -listvariable var + trace add variable var unset {apply {args { + .b configure -listvariable new + }}} + pack .b + bind .b {unset -nocomplain var} + update + destroy .b + unset new +} {} resetGridInfo deleteWindows option clear Index: tests/menu.test ================================================================== --- tests/menu.test +++ tests/menu.test @@ -3160,10 +3160,38 @@ list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \ [set foo "goodbye"] [unset foo] } -cleanup { deleteWindows } -result {{} goodbye {}} +test menu-17.6 {MenuVarProc [5d991b822e]} -setup { + deleteWindows +} -body { + # Want this not to crash + menu .b + set var INIT + .b add checkbutton -variable var + trace add variable var unset {apply {args { + .b entryconfigure 1 -variable {} + }}} + unset var +} -cleanup { + deleteWindows +} -result {} +test menu-17.7 {MenuVarProc [5d991b822e]} -setup { + deleteWindows +} -body { + # Want this not to duplicate traces + menu .b + set var INIT + .b add checkbutton -variable var + trace add variable var unset {apply {args { + .b entryconfigure 1 -variable new + }}} + unset var +} -cleanup { + deleteWindows +} -result {} test menu-18.1 {TkActivateMenuEntry} -setup { deleteWindows } -body { Index: tests/menubut.test ================================================================== --- tests/menubut.test +++ tests/menubut.test @@ -744,10 +744,38 @@ destroy .mb set res1 [list [winfo children .] [interp hidden]] set res2 [list {} $l] expr {$res1 eq $res2} } -result 1 + +test menubutton-9.1 {Bug [5d991b822e]} { + # Want this not to segfault, or write to variable with empty name + set var INIT + menubutton .b -textvariable var + trace add variable var unset {apply {args { + .b configure -textvariable {} + }}} + pack .b + bind .b {unset var} + update + destroy .b + info exists {} +} 0 +test menubutton-9.2 {Bug [5d991b822e]} { + # Want this not to leak traces + set var INIT + menubutton .b -textvariable var + trace add variable var unset {apply {args { + .b configure -textvariable new + }}} + pack .b + bind .b {unset -nocomplain var} + update + destroy .b + unset new +} {} + deleteWindows option clear Index: tests/message.test ================================================================== --- tests/message.test +++ tests/message.test @@ -467,8 +467,35 @@ .m configure -bg #ffffff lindex [.m configure -bd] 4 } -cleanup { destroy .m } -result {4} + +test message-4.1 {Bug [5d991b822e]} { + # Want this not to segfault, or write to variable with empty name + set var INIT + message .b -textvariable var + trace add variable var unset {apply {args { + .b configure -textvariable {} + }}} + pack .b + bind .b {unset var} + update + destroy .b + info exists {} +} 0 +test message-4.2 {Bug [5d991b822e]} { + # Want this not to leak traces + set var INIT + message .b -textvariable var + trace add variable var unset {apply {args { + .b configure -textvariable new + }}} + pack .b + bind .b {unset -nocomplain var} + update + destroy .b + unset new +} {} cleanupTests return Index: tests/scale.test ================================================================== --- tests/scale.test +++ tests/scale.test @@ -1521,10 +1521,36 @@ # non-regression test for bug [55b95f578a] - shall just not crash .s configure -from -6.8e99 -to 8.8e99 } -cleanup { destroy .s } -result {} + +test scale-22.1 {Bug [5d991b822e]} { + # Want this not to crash + set var INIT + scale .b -variable var + trace add variable var unset {apply {args { + .b configure -variable {} + }}} + pack .b + bind .b {unset var} + update + destroy .b +} {} +test scale-22.2 {Bug [5d991b822e]} { + # Want this not to leak traces + set var INIT + scale .b -variable var + trace add variable var unset {apply {args { + .b configure -variable new + }}} + pack .b + bind .b {unset -nocomplain var} + update + destroy .b + unset new +} {} option clear # cleanup cleanupTests