Tcl Source Code

Artifact 47536a44a268c9032f011b30ab937446ddbd2565:

Attachment "test_crash.tcl" to ticket [1427570fff] added by souellet_rambo 2006-02-08 21:36:36.

---

package require Thread

proc ldiff {la lb} {
    set la [lsort -unique $la]
    set lb [lsort -unique $lb]
    set r {}
    
    for {set i 0; set j 0} {$i<[llength $la]} {} {
	set a [lindex $la $i]
	set b [lindex $lb $j]
	
	set cmp [string compare $a $b]
	if {$cmp<0 || $j>[llength $lb]} {
	    lappend r $a
	    incr i
	} elseif {$cmp>0} {
	    incr j
	} else {
	    incr i
	    incr j
	}
    }
    return $r
}


set pool [tpool::create -maxworkers 20]

set threadcode {
    after 500
    exec echo crap > c:/temp/crap$i
}

for {set i 0} {$i<20} {incr i} {
    lappend jobs [tpool::post -nowait $pool [subst $threadcode]]
}

set completed {}
while {[llength $jobs]>0} {
    set completed [tpool::wait $pool $jobs patate]
    puts $completed
    set jobs [ldiff $jobs $completed]
}