Tcl Source Code

Tcl/Tk 8.5.15 on Linux and Windows
Itcl 3.4

The appended code crashes TCL (sometimes immediately, sometimes after
one minute):

(gdb) where
#0  0xb745fe7a in Tcl_GetString () from /aegis/si++/branch.4/branch.0/baseline/lib/linux/libtcl8.5.so
#1  0xb75060dc in ButtonTextVarProc () from /aegis/si++/branch.4/branch.0/baseline/lib/linux/libtk8.5.so
#2  0xb74826b7 in TclCallVarTraces () from /aegis/si++/branch.4/branch.0/baseline/lib/linux/libtcl8.5.so
#3  0xb7482bd7 in TclObjCallVarTraces () from /aegis/si++/branch.4/branch.0/baseline/lib/linux/libtcl8.5.so
#4  0xb748b061 in TclPtrSetVar () from /aegis/si++/branch.4/branch.0/baseline/lib/linux/libtcl8.5.so
#5  0xb7425644 in TclExecuteByteCode () from /aegis/si++/branch.4/branch.0/baseline/lib/linux/libtcl8.5.so
#6  0xb742f491 in TclCompEvalObj () from /aegis/si++/branch.4/branch.0/baseline/lib/linux/libtcl8.5.so
#7  0xb73df911 in TclEvalObjEx () from /aegis/si++/branch.4/branch.0/baseline/lib/linux/libtcl8.5.so
#8  0xb73dfdab in Tcl_EvalObjEx () from /aegis/si++/branch.4/branch.0/baseline/lib/linux/libtcl8.5.so
#9  0xb6e233c1 in Itcl_EvalMemberCode () from /aegis/si++/branch.4/branch.0/baseline/tcltk/linux/lib/itcl3.4/libitcl3.4.so

when dereferencing a NULL-Pointer in Tcl_GetString().

The cause of the crash is a stale Tk-Button pointer in the list of
variable traces, which later is referenced when no -textvariable is
bound to the button.

As fas as I can tell, the following happens:

- a button is created and coupled via -textvariable to a variable
  in a different itcl object
- due to the -textvariable button and variable are entered in the
  tracelist of that variable
- that variable is destroyed when the itcl object is destroyed, the
  variable trace triggers and re-establishes the variable since it
  still is coupled to the button (tkButton.c, ButtonTextVarProc())
     /*
     * If the variable is unset, then immediately recreate it unless the whole
     * interpreter is going away.
     */
  
- later the button is destroyed and tries to untrace the variable,
  (tkButton.c, DestroyButton())
     if (butPtr->textVarNamePtr != NULL) {
	Tcl_UntraceVar(butPtr->interp, Tcl_GetString(butPtr->textVarNamePtr),
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ButtonTextVarProc, (ClientData) butPtr);
     }
 
  but for some reason I don't understand yet, Tcl_UntraceVar() does
  not find the variable and just returns, leaving the stale button
  pointer in the global trace list.

- now Buttons and Variables get recreated, and the pointers are
  eventually reused.  Now it can happen that a button without
  -textvariable is assigned the (stale) pointer in the trace list, and
  a variable coupled to a different button is assigned the variable
  pointer which leads to the stale button pointer.  When the traces
  for that variable are executed, the stale button pointer (which in
  the meantime is a valid button again, but without -textvariable) is
  passed to ButtonTextVarProc(), which tries to get the -textvariable
  and crashes.


Here is the code, maybe someone with deeper insight can find why the
button does not find the variable when the button is destroyed.
It definetly is related to itcl (couldn't reproduce it using ordinary
namespaces) and the way itcl variables are named when using
[itcl::scope] and in the objects themselves.

The code creates 4 buttons in one itcl object and round-robin couples
them to textvariables in a different itcl object.  The buttons and
objects are destroyed and re-created using the event loop, so sooner or
later the combination of pointers described above triggers.


# ==============================

package require Itk

itcl::class bar {
    public {
	method config_textvar {w var} {
	    $w configure -textvariable [itcl::scope $var]
	    set $var [clock seconds]
	}
    }
    private {
	variable foo 0
	variable bar 0
    }    
}

itcl::class foo {
    inherit itk::Widget
    constructor args {
	create
    }

    public {
	method create {} {
	    set obj_ [uplevel \#0 bar \#auto]
	    pack [frame $itk_interior.f] -fill both -expand yes
	    pack [button $itk_interior.f.a] [button $itk_interior.f.b] [button $itk_interior.f.c] [button $itk_interior.f.d] -fill both -expand yes
	    switch -- $count_ {
		0 {
		    $obj_ config_textvar $itk_interior.f.a foo
		    $itk_interior.f.b configure -textvariable [itcl::scope count_]
		}
		1 {
		    $obj_ config_textvar $itk_interior.f.b foo
		    $itk_interior.f.c configure -textvariable [itcl::scope count_]
		}
		2 {
		    $obj_ config_textvar $itk_interior.f.c foo
		    $itk_interior.f.a configure -textvariable [itcl::scope count_]
		}
	    }
	    after $interval_ms_ [itcl::code $this assign]
	}
	method assign {} {
	    incr count_
	    if {$count_ > 2} { set count_ 0 }
	    set foo_ $count_
	    after $interval_ms_ [itcl::code $this remove]
	}
	method remove {} {
	    rename $obj_ {}
	    destroy $itk_interior.f
	    unset foo_
	    after $interval_ms_ [itcl::code $this create]
	}
    }
    private {
	variable interval_ms_ 100
	variable count_ 0
	variable foo_ 0
	variable obj_ {}
    }
}

wm geometry . 200x200
update idle
pack [foo .foo] -fill both -expand yes

# End of file