summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tkButton.c81
-rw-r--r--generic/tkEntry.c41
-rw-r--r--generic/tkListbox.c40
-rw-r--r--generic/tkMenu.c43
-rw-r--r--generic/tkMenubutton.c35
-rw-r--r--generic/tkMessage.c35
-rw-r--r--generic/tkScale.c35
-rw-r--r--generic/ttk/ttkTrace.c15
-rw-r--r--tests/button.test39
-rw-r--r--tests/entry.test28
-rw-r--r--tests/listbox.test27
-rw-r--r--tests/menu.test28
-rw-r--r--tests/menubut.test28
-rw-r--r--tests/message.test27
-rw-r--r--tests/scale.test26
15 files changed, 392 insertions, 136 deletions
diff --git a/generic/tkButton.c b/generic/tkButton.c
index 42d63a7..61aab0e 100644
--- a/generic/tkButton.c
+++ b/generic/tkButton.c
@@ -1617,26 +1617,33 @@ ButtonVarProc(
Tcl_Obj *valuePtr;
/*
- * See ticket [5d991b82].
- */
-
- if (butPtr->selVarNamePtr == NULL) {
- if (!(flags & TCL_INTERP_DESTROYED)) {
- Tcl_UntraceVar2(interp, name1, name2,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- ButtonVarProc, clientData);
- }
- return NULL;
- }
-
- /*
* If the variable is being unset, then just re-establish the trace unless
* 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);
@@ -1711,8 +1718,8 @@ static char *
ButtonTextVarProc(
ClientData clientData, /* Information about button. */
Tcl_Interp *interp, /* Interpreter containing variable. */
- const char *name1, /* Name of variable. */
- const char *name2, /* Second part of variable name. */
+ const char *name1, /* Not used. */
+ const char *name2, /* Not used. */
int flags) /* Information about what happened. */
{
TkButton *butPtr = clientData;
@@ -1723,25 +1730,39 @@ ButtonTextVarProc(
}
/*
- * See ticket [5d991b82].
- */
-
- if (butPtr->textVarNamePtr == NULL) {
- if (!(flags & TCL_INTERP_DESTROYED)) {
- Tcl_UntraceVar2(interp, name1, name2,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- ButtonTextVarProc, clientData);
- }
- return NULL;
- }
-
- /*
* 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),
diff --git a/generic/tkEntry.c b/generic/tkEntry.c
index 05a1a60..a7bc5a0 100644
--- a/generic/tkEntry.c
+++ b/generic/tkEntry.c
@@ -3135,8 +3135,8 @@ static char *
EntryTextVarProc(
ClientData clientData, /* Information about button. */
Tcl_Interp *interp, /* Interpreter containing variable. */
- const char *name1, /* Name of variable. */
- const char *name2, /* Second part of variable name. */
+ const char *name1, /* Not used. */
+ const char *name2, /* Not used. */
int flags) /* Information about what happened. */
{
Entry *entryPtr = clientData;
@@ -3150,32 +3150,39 @@ EntryTextVarProc(
}
/*
- * See ticket [5d991b82].
- */
-
- if (entryPtr->textVarName == NULL) {
- if (!(flags & TCL_INTERP_DESTROYED)) {
- Tcl_UntraceVar2(interp, name1, name2,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- EntryTextVarProc, clientData);
- }
- return NULL;
- }
-
- /*
* 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;
}
diff --git a/generic/tkListbox.c b/generic/tkListbox.c
index b323845..d92325f 100644
--- a/generic/tkListbox.c
+++ b/generic/tkListbox.c
@@ -3431,8 +3431,8 @@ static char *
ListboxListVarProc(
ClientData clientData, /* Information about button. */
Tcl_Interp *interp, /* Interpreter containing variable. */
- const char *name1, /* Name of variable. */
- const char *name2, /* Second part of variable name. */
+ const char *name1, /* Not used. */
+ const char *name2, /* Not used. */
int flags) /* Information about what happened. */
{
Listbox *listPtr = clientData;
@@ -3441,24 +3441,32 @@ ListboxListVarProc(
Tcl_HashEntry *entry;
/*
- * See ticket [5d991b82].
- */
-
- if (listPtr->listVarName == NULL) {
- if (!(flags & TCL_INTERP_DESTROYED)) {
- Tcl_UntraceVar2(interp, name1, name2,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- ListboxListVarProc, clientData);
- }
- return NULL;
- }
-
- /*
* 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,
diff --git a/generic/tkMenu.c b/generic/tkMenu.c
index 38e3bbd..a096684 100644
--- a/generic/tkMenu.c
+++ b/generic/tkMenu.c
@@ -2491,9 +2491,10 @@ MenuVarProc(
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,17 +2506,6 @@ MenuVarProc(
return NULL;
}
- /*
- * See ticket [5d991b82].
- */
-
- if (mePtr->namePtr == NULL) {
- Tcl_UntraceVar2(interp, name1, name2,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- MenuVarProc, clientData);
- return NULL;
- }
-
name = Tcl_GetString(mePtr->namePtr);
/*
@@ -2523,12 +2513,29 @@ MenuVarProc(
*/
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;
diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c
index 21da0d3..2228a2e 100644
--- a/generic/tkMenubutton.c
+++ b/generic/tkMenubutton.c
@@ -882,25 +882,32 @@ MenuButtonTextVarProc(
unsigned len;
/*
- * See ticket [5d991b82].
- */
-
- if (mbPtr->textVarName == NULL) {
- if (!(flags & TCL_INTERP_DESTROYED)) {
- Tcl_UntraceVar2(interp, name1, name2,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- MenuButtonTextVarProc, clientData);
- }
- return NULL;
- }
-
- /*
* 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,
diff --git a/generic/tkMessage.c b/generic/tkMessage.c
index 9d02346..1a3c6de 100644
--- a/generic/tkMessage.c
+++ b/generic/tkMessage.c
@@ -839,25 +839,32 @@ MessageTextVarProc(
const char *value;
/*
- * See ticket [5d991b82].
- */
-
- if (msgPtr->textVarName == NULL) {
- if (!(flags & TCL_INTERP_DESTROYED)) {
- Tcl_UntraceVar2(interp, name1, name2,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- MessageTextVarProc, clientData);
- }
- return NULL;
- }
-
- /*
* 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,
diff --git a/generic/tkScale.c b/generic/tkScale.c
index c5cdaff..a821e9d 100644
--- a/generic/tkScale.c
+++ b/generic/tkScale.c
@@ -1353,25 +1353,32 @@ ScaleVarProc(
int result;
/*
- * See ticket [5d991b82].
- */
-
- if (scalePtr->varNamePtr == NULL) {
- if (!(flags & TCL_INTERP_DESTROYED)) {
- Tcl_UntraceVar2(interp, name1, name2,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- ScaleVarProc, clientData);
- }
- return NULL;
- }
-
- /*
* 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);
diff --git a/generic/ttk/ttkTrace.c b/generic/ttk/ttkTrace.c
index e6eead2..ba66db4 100644
--- a/generic/ttk/ttkTrace.c
+++ b/generic/ttk/ttkTrace.c
@@ -26,8 +26,8 @@ static char *
VarTraceProc(
ClientData clientData, /* Widget record pointer */
Tcl_Interp *interp, /* Interpreter containing variable. */
- const char *name1, /* Name of variable. */
- const char *name2, /* Second part of variable name. */
+ const char *name1, /* (unused) */
+ const char *name2, /* (unused) */
int flags) /* Information about what happened. */
{
Ttk_TraceHandle *tracePtr = clientData;
@@ -38,17 +38,6 @@ VarTraceProc(
return NULL;
}
- /*
- * See ticket [5d991b82].
- */
-
- if (tracePtr->varnameObj == NULL) {
- Tcl_UntraceVar2(interp, name1, name2,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- VarTraceProc, clientData);
- return NULL;
- }
-
name = Tcl_GetString(tracePtr->varnameObj);
/*
diff --git a/tests/button.test b/tests/button.test
index d4db317..b953197 100644
--- a/tests/button.test
+++ b/tests/button.test
@@ -3958,6 +3958,45 @@ test button-14.1 {bug fix: [011706ec42] tk::ButtonInvoke unsafe wrt widget destr
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 <Configure> {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 <Configure> {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 <Configure> {unset var}
+ update
+ destroy .b
+} {}
+
+
imageFinish
cleanupTests
return
diff --git a/tests/entry.test b/tests/entry.test
index fbaf6a5..67f8374 100644
--- a/tests/entry.test
+++ b/tests/entry.test
@@ -3502,6 +3502,34 @@ test entry-24.1 {textvariable lives in a non-existing namespace} -setup {
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 <Configure> {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 <Configure> {unset -nocomplain var}
+ update
+ destroy .b
+ unset new
+} {}
+
+
# Gathered comments about lacks
# XXX Still need to write tests for EntryBlinkProc, EntryFocusProc,
# and EntryTextVarProc.
diff --git a/tests/listbox.test b/tests/listbox.test
index 99c84a7..2c07633 100644
--- a/tests/listbox.test
+++ b/tests/listbox.test
@@ -3177,6 +3177,33 @@ test listbox-31.2 {<<ListboxSelect>> event on lost selection} -setup {
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 <Configure> {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 <Configure> {unset -nocomplain var}
+ update
+ destroy .b
+ unset new
+} {}
+
resetGridInfo
deleteWindows
option clear
diff --git a/tests/menu.test b/tests/menu.test
index 9ad2a0c..a7f5956 100644
--- a/tests/menu.test
+++ b/tests/menu.test
@@ -3162,6 +3162,34 @@ test menu-17.5 {MenuVarProc} -setup {
} -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 {
diff --git a/tests/menubut.test b/tests/menubut.test
index 88f4330..9615fa8 100644
--- a/tests/menubut.test
+++ b/tests/menubut.test
@@ -751,6 +751,34 @@ test menubutton-8.1 {menubutton vs hidden commands} -body {
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 <Configure> {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 <Configure> {unset -nocomplain var}
+ update
+ destroy .b
+ unset new
+} {}
+
+
deleteWindows
diff --git a/tests/message.test b/tests/message.test
index dcffc72..cc2e0d0 100644
--- a/tests/message.test
+++ b/tests/message.test
@@ -470,5 +470,32 @@ test message-3.7 {MessageWidgetObjCmd procedure, "configure"} -setup {
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 <Configure> {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 <Configure> {unset -nocomplain var}
+ update
+ destroy .b
+ unset new
+} {}
+
cleanupTests
return
diff --git a/tests/scale.test b/tests/scale.test
index 7fa3a62..75293aa 100644
--- a/tests/scale.test
+++ b/tests/scale.test
@@ -1559,6 +1559,32 @@ test scale-21.2 {Bug [55b95f578a] again - Bignum value for -from/-to with scale
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 <Configure> {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 <Configure> {unset -nocomplain var}
+ update
+ destroy .b
+ unset new
+} {}
+
option clear
# cleanup
generated by cgit v0.12 at 2024-11-10 22:20:48 (GMT)