tests/demo/draw/bug30430

   1 # testgrid demo draw -overwrite
   2
   3 catch {cpulimit 10}
   4
   5 package require Thread
   6
   7 set NBTHREADS 1
   8 set NBWORKERS 1
   9
  10 puts "Creating worker"
  11 set worker [tpool::create -minworkers $NBWORKERS -maxworkers $NBWORKERS]
  12
  13 puts "Suspending worker"
  14 tpool::suspend $worker
  15
  16 puts "Arranging jobs"
  17 for {set i 1} {$i <= $NBTHREADS} {incr i} {
  18     set job [tpool::post $worker "puts Executing_job_$i"]
  19     puts "Job $i: $job"
  20 #    set job [tpool::post -nowait $worker "puts $i"]
  21     set jobs($job) $job
  22 }
  23
  24 puts "Resuming worker"
  25 tpool::resume $worker
  26
  27 puts "Waiting while all threads complete"
  28 after 1000
  29
  30 puts "Obtaining results"
  31 while { [llength [array names jobs]] > 0 } {
  32     puts "Queue: [array names jobs]"
  33
  34     foreach job [tpool::wait $worker [array names jobs]] {
  35         puts -nonewline "Completed $job: "
  36         puts "[tpool::get $worker $job]"
  37         unset jobs($job)
  38     }
  39 }
  40
  41 puts "Releasing worker"
  42 tpool::release $worker
  43
  44 catch {cpulimit 0}
  45
  46 puts "TEST COMPLETED"