Threaded Itcl test

The following shows errors in Threaded Itcl.

 package require Thread
 package require Itcl

 proc dumplist {n cmd} {
     set rc [list]
     for {set i 0} {$i < $n} {incr i} {
         lappend rc [eval $cmd]
     }
     return $rc
 }

 proc randstr {} {
     set rc "x"
     while {int(rand() * 5) != 0} {
         append rc [lindex {a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9} [expr {int(rand() * 36.0)}]]
     }
     return $rc
 }

 set tm [time {
     set n 5
     set list [dumplist $n {dumplist $n {dumplist $n {dumplist $n randstr}}}]
 }]

 puts "Creation: $tm"

 itcl::class x {
     private variable _var ""
     public method vset {x} {
         set _var $x
     }
     public method vget {} {
         return ${_var}
     }
 }

 x -ts x0
 x0 vset $list

 set tc {
     format %d,%d,%d,%d \
         [llength [x0 vget]] \
         [llength [lindex [x0 vget] 0]] \
         [llength [lindex [x0 vget] 0 0]] \
         [llength [lindex [x0 vget] 0 0 0]]
 }

 set tm [time {set res [eval $tc]}]
 puts R=$res,$tm

 for {set i 0} {$i < 50} {incr i} {
     set t [thread::create]

     thread::send $t {package require Itcl}

     lappend tl $t


     set tm [time {set res [thread::send $t $tc]}]
     puts $t=$res,$tm
 }

 foreach t $tl {
     thread::release $t
 }

 exit

 package require Thread
 package require Itcl

 proc dumplist {n cmd} {
     set rc [list]
     for {set i 0} {$i < $n} {incr i} {
         lappend rc [eval $cmd]
     }
     return $rc
 }

 proc randstr {} {
     set rc "x"
     while {int(rand() * 5) != 0} {
         append rc [lindex {a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9} [expr {int(rand() * 36.0)}]]
     }
     return $rc
 }

 set tm [time {
     set n 5
     set list [dumplist $n {dumplist $n {dumplist $n {dumplist $n randstr}}}]
 }]

 puts "Creation: $tm"

 itcl::class x {
     private variable _var ""
     public method vset {x} {
         set _var $x
     }
     public method vget {} {
         return ${_var}
     }
 }

 x -ts x0
 x0 vset $list

 set tc {
     format %d,%d,%d,%d \
         [llength [x0 vget]] \
         [llength [lindex [x0 vget] 0]] \
         [llength [lindex [x0 vget] 0 0]] \
         [llength [lindex [x0 vget] 0 0 0]]
 }

 set tm [time {set res [eval $tc]}]
 puts R=$res,$tm

 for {set i 0} {$i < 50} {incr i} {
     set t [thread::create]

     thread::send $t {package require Itcl}

     lappend tl $t


     set tm [time {set res [thread::send $t $tc]}]
     puts $t=$res,$tm
 }

 foreach t $tl {
     thread::release $t
 }

 exit

EL: There is a segmentation fault when the threads are released. If the -wait flag is set to thread::release, they don't appear.


Category Itcl Category Threads