Artifact 6cbc690715b7b1b2cfc874babdadfe24f79f9774:
#!/usr/bin/wishx
#Attempt to demonstrate a memory leak in TCL/TK/X-server
#Usage:
# Start with a fresh (newly running) X server so it is at its minimum size
# Run this program. Press the Reload button multiple times (or hold it)
# Watch the size of the X server grow
# comment out the "configure -cursor" calls, server no longer grows
set wordfile {/usr/share/dict/words} ;#could be any data
set lines 4000 ;#limit to 4000 words
set words [split [read_file $wordfile] "\n"] ;#make it into a tcl list
set words [lrange $words 0 $lines] ;#trim the list
set reps 1 ;#keep track of how many times we reload
# Clear and then reload the listbox with some content data
#------------------------------------------
proc reload {} {
global reps words
set lb .lb
$lb delete 0 end
$lb configure -cursor watch ;#comment out this line
update
$lb configure -cursor top_left_arrow ;#and this line to stop leak
foreach word $words {$lb insert end $word}
puts "reps:[incr reps]"
}
# Make the button repeat when held pressed
#------------------------------------------
proc b_press {b} {
global baid bp
if {[info exists baid] && $baid != {}} {after cancel $baid} ;#kill any leftover alarms
if {$bp} {
set baid [after 100 "$b invoke; b_press $b"] ;#push the button, reschedule a new alarm
}
}
# Main
#------------------------------------------
button .rel -text Reload -command reload
pack .rel -side bottom -fill x
bind .rel <Button-1> "+set ::bp 1; b_press .rel"
bind .rel <ButtonRelease-1> "+set ::bp 0"
listbox .lb -height 40 -width 80
pack .lb -side right -fill both
reload