Tcl Source Code

Artifact 43485ffc607118aae8881e33ad3d673e015f9140:

Attachment "threadpool_leakdemo.tcl" to ticket [3382401fff] added by auriocus 2011-07-30 02:34:15.

---

# version that leaks
package require Thread
set t [tpool::create]

proc leak {} {
	# compute 1000 rand() s in parallel
	set joblist {}
	for {set i 0} {$i<1000} {incr i} {
		lappend joblist [tpool::post -nowait $::t {expr rand()}]
	}
	
	set max 0.0
	while {[llength $joblist]!=0} {
		foreach job [tpool::wait $::t $joblist joblist] {
			set max [expr {max($max, [tpool::get $::t $job])}]
		}
	}
	puts "Max is $max"

}

time leak 1000