Tk Source Code

Artifact 3554c43bedb362f4371c858d3f644dfb345d483c:

Attachment "many_text_bug.tcl" to ticket [1348333f] added by kjnash 2005-11-04 21:49:02.

---

# Tk 8.5 cannot cope with a large number of 'idletasks' delayed actions, and
# it hangs, consuming most of the system's CPU - even though it is able to
# process the same actions if they are split by update commands.
#
# ActiveTcl 8.5 beta 3 (tcl_patchLevel 8.5a2) and ActiveTcl 8.5 beta 4 (8.5a4,
# threaded) both have this problem.
#
# Tk 8.4 does not have this problem: ActiveTcl 8.4.11.2 (8.4.11, threaded) and
# ActiveTcl 8.4.9.0 (8.4.9) tested.
#
# The attached script creates and maps a large number of text widgets, with
# the option of using update after each widget is created, and (separately)
# after it is mapped.

# Mapping a large number of widgets gives Tk 8.5 a problem.
# Creation of a large number of unmapped widgets also gives Tk 8.5 a problem.

# The numbers of widgets, though large, are not perversely large - I have apps
# with more than 150 widgets - and Tk 8.4 has no problem with much larger
# numbers.

# 100 widgets: OK always.
# 144 to 900 widgets: OK in 8.4 always; fails in Tk 8.5 if updates are not
# switched on.


set imax 10
set jmax 10               ;# number of text widgets is $imax * $jmax
set update_after_create 0 ;# boolean
set update_after_pack   0 ;# boolean
set verbose_stdout      0 ;# boolean

# update_after_create = 1, update_after_pack = 0: shows that mapping a large
# number of widgets gives Tk a problem.

# update_after_create = 0, update_after_pack = 1: shows that the creation of
# a large number of unmapped widgets also gives Tk a problem.


# Create and display a header
text .top -height 3 -width 32
.top insert end "$jmax x $imax text widgets\n"
.top insert end "update after create: $update_after_create\n"
.top insert end "update after pack:   $update_after_pack"
pack .top -expand yes -fill x
update

# Create the widgets
for {set i 0} {$i < $imax} {incr i} {
    set fr [frame .f$i]
	for {set j 0} {$j < $jmax} {incr j} {
		if {$verbose_stdout} {puts "Creating text widget $i : $j"}
		set t [text ${fr}.x${j}y${i} -height 1 -width 2]
		$t insert end [string index ${i} end][string index ${j} end]
		if {$update_after_create} {
			update
		}
	}
}

# Pack the widgets
for {set i 0} {$i < $imax} {incr i} {
    set fr .f$i
    pack $fr
	for {set j 0} {$j < $jmax} {incr j} {
		if {$verbose_stdout} {puts "Packing text widget $i : $j"}
		set t ${fr}.x${j}y${i}
		pack $t -side left
		if {$update_after_pack} {
			update
		}
	}
}