Tk Source Code

Check-in [afbac00c]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Revised bug fix for [5d991b822e].
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-6-branch
Files: files | file ages | folders
SHA3-256: afbac00c05c928d835adebb2f9b44ff6d5c61caff58e5a5f2be6e150128f47d0
User & Date: dgp 2019-05-15 19:33:53
Context
2019-05-15
20:02
Make new tests more robust against context. check-in: 2bdcb4be user: dgp tags: core-8-6-branch
19:33
Revised bug fix for [5d991b822e]. check-in: afbac00c user: dgp tags: core-8-6-branch
18:05
Tests and fix for similar issues in [menu]. Closed-Leaf check-in: c69b1cc4 user: dgp tags: bug-5d991b822e
2019-05-13
09:26
Fix [caa8cb25a8]: spelling fix in comment of tkMenuDraw.c check-in: 23c39bb0 user: fvogel tags: core-8-6-branch
2018-02-04
17:34
Fix [5d991b822e]: segmentation violation in TclObjLookupVarEx. Patch from Christian Werner. check-in: dfa30ff0 user: fvogel tags: core-8-6-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tkButton.c.

1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639




















1640
1641
1642
1643
1644
1645
1646
....
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744



























1745
1746
1747
1748
1749
1750
1751
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Information about what happened. */
{
    register TkButton *butPtr = clientData;
    const char *value;
    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)) {




















	    Tcl_TraceVar2(interp, Tcl_GetString(butPtr->selVarNamePtr),
		    NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		    ButtonVarProc, clientData);
	}
	goto redisplay;
    }

................................................................................
 */

	/* ARGSUSED */
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. */
    int flags)			/* Information about what happened. */
{
    TkButton *butPtr = clientData;
    Tcl_Obj *valuePtr;

    if (butPtr->flags & BUTTON_DELETED) {
	return NULL;
    }

    /*
     * 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)) {



























	    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);
	}
	return NULL;






<
<
<
<
<
<
<
<
<
<
<
<
<







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|
|









<
<
<
<
<
<
<
<
<
<
<
<
<






|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1612
1613
1614
1615
1616
1617
1618













1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
....
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731













1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Information about what happened. */
{
    register TkButton *butPtr = clientData;
    const char *value;
    Tcl_Obj *valuePtr;














    /*
     * 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 (!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;
    }

................................................................................
 */

	/* ARGSUSED */
static char *
ButtonTextVarProc(
    ClientData clientData,	/* Information about button. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Not used. */
    const char *name2,		/* Not used. */
    int flags)			/* Information about what happened. */
{
    TkButton *butPtr = clientData;
    Tcl_Obj *valuePtr;

    if (butPtr->flags & BUTTON_DELETED) {
	return NULL;
    }














    /*
     * If the variable is unset, then immediately recreate it unless the whole
     * interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
	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);
	}
	return NULL;

Changes to generic/tkEntry.c.

3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171




















3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
 */

	/* ARGSUSED */
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. */
    int flags)			/* Information about what happened. */
{
    Entry *entryPtr = clientData;
    const char *value;

    if (entryPtr->flags & ENTRY_DELETED) {
	/*
	 * Just abort early if we entered here while being deleted.
	 */
	return NULL;
    }

    /*
     * 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)) {




















	    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
     * entry already has that value (this happens when the variable changes
     * value because we changed it because someone typed in the entry).






|
|












<
<
<
<
<
<
<
<
<
<
<
<
<






|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>






|







3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151













3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
 */

	/* ARGSUSED */
static char *
EntryTextVarProc(
    ClientData clientData,	/* Information about button. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Not used. */
    const char *name2,		/* Not used. */
    int flags)			/* Information about what happened. */
{
    Entry *entryPtr = clientData;
    const char *value;

    if (entryPtr->flags & ENTRY_DELETED) {
	/*
	 * Just abort early if we entered here while being deleted.
	 */
	return NULL;
    }














    /*
     * If the variable is unset, then immediately recreate it unless the whole
     * interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
        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
     * entry already has that value (this happens when the variable changes
     * value because we changed it because someone typed in the entry).

Changes to generic/tkListbox.c.

3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461






















3462
3463
3464
3465
3466
3467
3468
 *----------------------------------------------------------------------
 */

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. */
    int flags)			/* Information about what happened. */
{
    Listbox *listPtr = clientData;
    Tcl_Obj *oldListObj, *varListObj;
    int oldLength, i;
    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)) {






















	    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);
	    return NULL;
	}






|
|







<
<
<
<
<
<
<
<
<
<
<
<
<





<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442













3443
3444
3445
3446
3447

3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
 *----------------------------------------------------------------------
 */

static char *
ListboxListVarProc(
    ClientData clientData,	/* Information about button. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Not used. */
    const char *name2,		/* Not used. */
    int flags)			/* Information about what happened. */
{
    Listbox *listPtr = clientData;
    Tcl_Obj *oldListObj, *varListObj;
    int oldLength, i;
    Tcl_HashEntry *entry;














    /*
     * Bwah hahahaha! Puny mortal, you can't unset a -listvar'd variable!
     */

    if (flags & TCL_TRACE_UNSETS) {


        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);
	    return NULL;
	}

Changes to generic/tkMenu.c.

2487
2488
2489
2490
2491
2492
2493
2494
2495
2496

2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525

2526
2527


2528
2529
2530


2531













2532
2533
2534
2535
2536
2537
2538
    int flags)			/* Describes what just happened. */
{
    TkMenuEntry *mePtr = clientData;
    TkMenu *menuPtr;
    const char *value;
    const char *name, *onValue;

    if (flags & TCL_INTERP_DESTROYED) {
	/*
	 * Do nothing if the interpreter is going away.

	 */

    	return NULL;
    }

    menuPtr = mePtr->menuPtr;

    if (menuPtr->menuFlags & MENU_DELETION_PENDING) {
    	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);

    /*
     * If the variable is being unset, then re-establish the trace.
     */

    if (flags & TCL_TRACE_UNSETS) {

	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);


	}













	TkpConfigureMenuEntry(mePtr);
	TkEventuallyRedrawMenu(menuPtr, NULL);
	return NULL;
    }

    /*
     * Use the value of the variable to update the selected status of the menu






|

|
>











<
<
<
<
<
<
<
<
<
<
<







>

<
>
>
|
|
|
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>







2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508











2509
2510
2511
2512
2513
2514
2515
2516
2517

2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
    int flags)			/* Describes what just happened. */
{
    TkMenuEntry *mePtr = clientData;
    TkMenu *menuPtr;
    const char *value;
    const char *name, *onValue;

    if (Tcl_InterpDeleted(interp) || (mePtr->namePtr == NULL)) {
	/*
	 * Do nothing if the interpreter is going away or we have
	 * no variable name.
	 */

    	return NULL;
    }

    menuPtr = mePtr->menuPtr;

    if (menuPtr->menuFlags & MENU_DELETION_PENDING) {
    	return NULL;
    }












    name = Tcl_GetString(mePtr->namePtr);

    /*
     * If the variable is being unset, then re-establish the trace.
     */

    if (flags & TCL_TRACE_UNSETS) {
        ClientData probe = NULL;
	mePtr->entryFlags &= ~ENTRY_SELECTED;


        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;
    }

    /*
     * Use the value of the variable to update the selected status of the menu

Changes to generic/tkMenubutton.c.

877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903




















904
905
906
907
908
909
910
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Information about what happened. */
{
    register TkMenuButton *mbPtr = clientData;
    const char *value;
    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)) {




















	    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);
	}
	return NULL;






<
<
<
<
<
<
<
<
<
<
<
<
<






|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







877
878
879
880
881
882
883













884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Information about what happened. */
{
    register TkMenuButton *mbPtr = clientData;
    const char *value;
    unsigned len;














    /*
     * If the variable is unset, then immediately recreate it unless the whole
     * interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
        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);
	}
	return NULL;

Changes to generic/tkMessage.c.

834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860




















861
862
863
864
865
866
867
    const char *name1,		/* Name of variable. */
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Information about what happened. */
{
    register Message *msgPtr = clientData;
    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)) {




















	    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);
	}
	return NULL;






<
<
<
<
<
<
<
<
<
<
<
<
<






|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







834
835
836
837
838
839
840













841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
    const char *name1,		/* Name of variable. */
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Information about what happened. */
{
    register Message *msgPtr = clientData;
    const char *value;














    /*
     * If the variable is unset, then immediately recreate it unless the whole
     * interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
        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);
	}
	return NULL;

Changes to generic/tkScale.c.

1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374




















1375
1376
1377
1378
1379
1380
1381
{
    register TkScale *scalePtr = clientData;
    const char *resultStr;
    double value;
    Tcl_Obj *valuePtr;
    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)) {




















	    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);
	}
	return NULL;






<
<
<
<
<
<
<
<
<
<
<
<
<






|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1348
1349
1350
1351
1352
1353
1354













1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
{
    register TkScale *scalePtr = clientData;
    const char *resultStr;
    double value;
    Tcl_Obj *valuePtr;
    int result;














    /*
     * If the variable is unset, then immediately recreate it unless the whole
     * interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
        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);
	}
	return NULL;

Changes to generic/ttk/ttkTrace.c.

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
/*
 * Tcl_VarTraceProc for trace handles.
 */
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. */
    int flags)			/* Information about what happened. */
{
    Ttk_TraceHandle *tracePtr = clientData;
    const char *name, *value;
    Tcl_Obj *valuePtr;

    if (flags & TCL_INTERP_DESTROYED) {
	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);

    /*
     * If the variable is being unset, then re-establish the trace:
     */
    if (flags & TCL_TRACE_DESTROYED) {
	/*






|
|










<
<
<
<
<
<
<
<
<
<
<







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40











41
42
43
44
45
46
47
/*
 * Tcl_VarTraceProc for trace handles.
 */
static char *
VarTraceProc(
    ClientData clientData,	/* Widget record pointer */
    Tcl_Interp *interp, 	/* Interpreter containing variable. */
    const char *name1,		/* (unused) */
    const char *name2,		/* (unused) */
    int flags)			/* Information about what happened. */
{
    Ttk_TraceHandle *tracePtr = clientData;
    const char *name, *value;
    Tcl_Obj *valuePtr;

    if (flags & TCL_INTERP_DESTROYED) {
	return NULL;
    }












    name = Tcl_GetString(tracePtr->varnameObj);

    /*
     * If the variable is being unset, then re-establish the trace:
     */
    if (flags & TCL_TRACE_DESTROYED) {
	/*

Changes to tests/button.test.

3953
3954
3955
3956
3957
3958
3959







































3960
3961
3962
3963
3964
3965
3966
3967
    focus -force .top.b
    update
    event generate .top.b <space>
    update  ; # shall not trigger error  invalid command name ".top.b"
} -cleanup {
    destroy .top.b .top
} -result {} 








































imageFinish
cleanupTests
return

# Local variables:
# mode: tcl
# End:






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
    focus -force .top.b
    update
    event generate .top.b <space>
    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 <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

# Local variables:
# mode: tcl
# End:

Changes to tests/entry.test.

3497
3498
3499
3500
3501
3502
3503




























3504
3505
3506
3507
3508
3509
3510
    destroy .e
} -body {
    catch {entry .e -textvariable thisnsdoesntexist::myvar} result1
    set result1
} -cleanup {
  destroy .e
} -result {can't trace "thisnsdoesntexist::myvar": parent namespace doesn't exist}





























# Gathered comments about lacks
# XXX Still need to write tests for EntryBlinkProc, EntryFocusProc,
# and EntryTextVarProc.
# No tests for DisplayEntry.
# XXX Still need to write tests for EntryScanTo and EntrySelectTo.
# No tests for EventuallyRedraw






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
    destroy .e
} -body {
    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 <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.
# No tests for DisplayEntry.
# XXX Still need to write tests for EntryScanTo and EntrySelectTo.
# No tests for EventuallyRedraw

Changes to tests/listbox.test.

3172
3173
3174
3175
3176
3177
3178



























3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
    event generate .l <1> -x 5 -y 5  ; # <<ListboxSelect>> fires
    selection clear                  ; # <<ListboxSelect>> fires again
    update
    set res
} -cleanup {
    destroy .l
} -result {{.l 0} {{} {}}}




























resetGridInfo
deleteWindows
option clear

# cleanup
cleanupTests
return











>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>













3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
    event generate .l <1> -x 5 -y 5  ; # <<ListboxSelect>> fires
    selection clear                  ; # <<ListboxSelect>> fires again
    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 <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

# cleanup
cleanupTests
return





Changes to tests/menu.test.

3158
3159
3160
3161
3162
3163
3164




























3165
3166
3167
3168
3169
3170
3171
    menu .m1
    set foo "hello"
    list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \
		[set foo "goodbye"] [unset foo]
} -cleanup {
	deleteWindows
} -result {{} goodbye {}}






























test menu-18.1 {TkActivateMenuEntry} -setup {
	deleteWindows
} -body {
    menu .m1
    .m1 add command -label "test"






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
    menu .m1
    set foo "hello"
    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 {
    menu .m1
    .m1 add command -label "test"

Changes to tests/menubut.test.

746
747
748
749
750
751
752




























753
754
755
756
757
758
759
    menubutton .mb
    interp hide {} .mb
    destroy .mb
    set res1 [list [winfo children .] [interp hidden]]
    set res2 [list {} $l]
    expr {$res1 eq $res2}
} -result 1































deleteWindows
option clear
imageFinish







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
    menubutton .mb
    interp hide {} .mb
    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 <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
option clear
imageFinish

Changes to tests/message.test.

465
466
467
468
469
470
471
472



























473
474
} -body {
    .m configure -bd 4
    .m configure -bg #ffffff
    lindex [.m configure -bd] 4
} -cleanup {
    destroy .m
} -result {4}




























cleanupTests
return







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
} -body {
    .m configure -bd 4
    .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 <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

Changes to tests/scale.test.

1554
1555
1556
1557
1558
1559
1560


























1561
1562
1563
1564
1565
1566
} -body {
    pack [scale .s]
    # non-regression test for bug [55b95f578a] - shall just not crash
    .s configure -from -6.8e99 -to 8.8e99
} -cleanup {
    destroy .s
} -result {}



























option clear

# cleanup
cleanupTests
return






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>






1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
} -body {
    pack [scale .s]
    # 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 <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
cleanupTests
return