0030430: Draw - command testgrid in parallel mode hangs if DRAW is launched without GUI
[occt.git] / 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"