Tcl Source Code

Artifact 4a8fa1eee15de2225bdc184905d7b2e9a68df828:

Attachment "test_crash2.tcl" to ticket [1427570fff] added by souellet_rambo 2006-02-09 01:03:57.

---

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 {
    exec echo crap > c:/temp/crap$i
}

while {1} {

    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]
	set jobs [ldiff $jobs $completed]
    }
    puts .
}