Object Instantiation Test

This is the implementation of the object instantiation benchmark of Tcl OO Bench in some OO extensions of Tcl.

ITcl

 package require Itcl
 itcl::class Toggle {
   variable state
   constructor {start_state} {
     set state $start_state
   }
   method value {} {
     return $state
   }
   method activate {} {
     set state [expr {!$state}]
     return $this
   }
 }
 itcl::class NthToggle {
   inherit Toggle
   variable count_max
   variable counter
   constructor {start_state max_counter} {
     Toggle::constructor $start_state
   } {
     set count_max $max_counter
     set counter 0
   }
   method activate {} {
     if {[incr counter] >= $count_max} {
       Toggle::activate
       set counter 0
     }
     return $this
   }
 }
 proc main {n} {
   set toggle1 [Toggle \#auto 1]
   for {set i 0} {$i<5} {incr i} {
     $toggle1 activate
     if {[$toggle1 value]} {
       puts true
     } else {  puts false
     }
   }
   itcl::delete object $toggle1
   for {set i 0} {$i<$n} {incr i} {
     set toggle [Toggle \#auto 1]
     itcl::delete object $toggle
   }
   puts {}
   set ntoggle1 [NthToggle \#auto 1 3]
   for {set i 0} {$i<8} {incr i} {
     $ntoggle1 activate
     if {[$ntoggle1 value]} {
       puts true
     } else {  puts false
     }
   }
   itcl::delete object $ntoggle1
   for {set i 0} {$i<$n} {incr i} {
     set ntoggle [NthToggle \#auto 1 3]
     itcl::delete object $ntoggle
   }
 }
 main [expr {$argc==1?[lindex $argv 0]:1}]

MIT OTcl

 Class Toggle
 Toggle instproc state {v} {
   $self set state $v
 }
 Toggle instproc value {} {
   $self set state
 }
 Toggle instproc activate {} {
   $self state [expr {! [$self set state]}]
   set self
 }

 Class NthToggle -superclass Toggle
 NthToggle instproc max {v} {
   $self set max $v
 }
 NthToggle instproc init args {
   eval $self next $args
   $self set counter 0
 }
 NthToggle instproc activate {} {
   $self instvar counter
   if {[incr counter] >= [$self set max]} {
     $self next
     set counter 0
   }
   set self
 }

 proc main {} {
   set n [lindex $::argv 0]

   set toggle1 [Toggle t1 -state 1]
   for {set i 0} {$i<5} {incr i} {
     $toggle1 activate
     if {[$toggle1 value]} {puts true} else {puts false}
   }
   $toggle1 destroy

   for {set i 0} {$i<$n} {incr i} {
     set toggle [Toggle t$i -state 1]
     $toggle destroy
   }
   puts {}
   set ntoggle1 [NthToggle nt -state 1 -max 3]
   for {set i 0} {$i<8} {incr i} {
     $ntoggle1 activate
     if {[$ntoggle1 value]} {puts true} else {puts false}
   }
   $ntoggle1 destroy
   for {set i 0} {$i<$n} {incr i} {
     set ntoggle [NthToggle nt$i -state 1 -max 3]
     $ntoggle destroy
   }
 }

 main

XOTcl

 Class Toggle -parameter state
 Toggle instproc value {} {
   my state
 }
 Toggle instproc activate {} {
   my state [expr {! [my state]}]
   self
 } 

 Class NthToggle -superclass Toggle -parameter max
 NthToggle instproc init {} {
   next
   my set counter 0
 }
 NthToggle instproc activate {} {
   if {[my incr counter] >= [my max]} {
     next
     my set counter 0
   }
   self
 }

 proc main {} {
   set n [lindex $::argv 0]

   set toggle1 [Toggle new -state 1]
   for {set i 0} {$i<5} {incr i} {
     $toggle1 activate
     if {[$toggle1 value]} {puts true} else {puts false}
   }
   $toggle1 destroy

   for {set i 0} {$i<$n} {incr i} {
     set toggle [Toggle new -state 1]
     $toggle destroy
   }
   puts {}
   set ntoggle1 [NthToggle new -state 1 -max 3]
   for {set i 0} {$i<8} {incr i} {
     $ntoggle1 activate
     if {[$ntoggle1 value]} {puts true} else {puts false}
   }
   $ntoggle1 destroy
   for {set i 0} {$i<$n} {incr i} {
     set ntoggle [NthToggle new -state 1 -max 3]
     $ntoggle destroy
   }
 }

 main

Category XOTcl Code

stooop

 class Toggle {
     proc Toggle {this start_state} {
         set ($this,state) $start_state
     }
     proc ~Toggle {this} {}
     virtual proc value {this} {
         return $($this,state)
     }
     proc activate {this} {
         set ($this,state) [expr {!$($this,state)}]
         return $this
     }
 }
 class NthToggle {
     proc NthToggle {this start_state max_counter} Toggle {$start_state} {
         set ($this,count_max) $max_counter
         set ($this,counter) 0
     }
     proc ~NthToggle {this} {}
     proc activate {this} {
         if {[incr ($this,counter)]>=$($this,count_max)} {
             set Toggle::($this,state) [expr {!$Toggle::($this,state)}]
             set ($this,counter) 0
         }
         return $this
     }
 }
 proc main {n} {
   set toggle1 [new Toggle 1]
   for {set i 0} {$i<5} {incr i} {
     if {[Toggle::value [Toggle::activate $toggle1]]} {
       puts true
     } else {
       puts false
     }
   }
   delete $toggle1
   for {set i 0} {$i<$n} {incr i} {
     set toggle [new Toggle 1]
     delete $toggle
   }
   puts {}
   set ntoggle1 [new NthToggle 1 3]
   for {set i 0} {$i<8} {incr i} {
     if {[Toggle::value [NthToggle::activate $ntoggle1]]} {
       puts true
     } else {
       puts false
     }
   }
   delete $ntoggle1
   for {set i 0} {$i<$n} {incr i} {
     set ntoggle [new NthToggle 1 3]
     delete $ntoggle
   }
 }
 main [expr {$argc==1?[lindex $argv 0]:1}]