Tk Source Code

Check-in [da24fd68]
Login

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

Overview
Comment:Tests and fix for [message ... -textvariable].
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | bug-5d991b822e
Files: files | file ages | folders
SHA3-256: da24fd6860649bec90a10bac767d896916d175f8d9308b74dadaa5e07fe8d8b1
User & Date: dgp 2019-05-15 17:20:54.373
Context
2019-05-15
17:30
Tests and fix for [scale ... -variable]. check-in: c1dd2ab0 user: dgp tags: bug-5d991b822e
17:20
Tests and fix for [message ... -textvariable]. check-in: da24fd68 user: dgp tags: bug-5d991b822e
17:16
Tests and fix for [menubutton ... -textvariable]. check-in: fdcced06 user: dgp tags: bug-5d991b822e
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/tkMessage.c.
840
841
842
843
844
845
846


847


















848
849
850
851
852
853
854

    /*
     * 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;







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







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

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