This is the implementation of the method invocation benchmark of
Tcl OO Bench in various Tcl OO extensions.
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 {} {
set n [lindex $::argv 0]
set val 1
set toggle [Toggle #auto $val]
for {set i 0} {$i < $n} {incr i} {
set val [[$toggle activate] value]
}
if {$val} {puts "true"} else {puts "false"}
set val 1
set ntoggle [NthToggle #auto 1 3]
for {set i 0} {$i < $n} {incr i} {
set val [[$ntoggle activate] value]
}
if {$val} {puts "true"} else {puts "false"}
}
main
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 val 1
set toggle [Toggle n -state $val]
for {set i 0} {$i < $n} {incr i} {
set val [[$toggle activate] value]
}
if {$val} {puts "true"} else {puts "false"}
set val 1
set ntoggle [NthToggle nn -state 1 -max 3]
for {set i 0} {$i < $n} {incr i} {
set val [[$ntoggle activate] value]
}
if {$val} {puts "true"} else {puts "false"}
}
main
package require XOTcl; namespace import -force 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 val 1
set toggle [Toggle new -state $val]
for {set i 0} {$i < $n} {incr i} {
set val [[$toggle activate] value]
}
if {$val} {puts "true"} else {puts "false"}
set val 1
set ntoggle [NthToggle new -state 1 -max 3]
for {set i 0} {$i < $n} {incr i} {
set val [[$ntoggle activate] value]
}
if {$val} {puts "true"} else {puts "false"}
}
mainCategory XOTcl Code
package require stooop
namespace import 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 val 1
set toggle [new Toggle $val]
for {set i 0} {$i<$n} {incr i} {
set val [Toggle::value [Toggle::activate $toggle]]
}
if {$val} {puts true} else {puts false}
delete $toggle
set val 1
set ntoggle [new NthToggle $val 3]
for {set i 0} {$i<$n} {incr i} {
set val [Toggle::value [NthToggle::activate $ntoggle]]
}
if {$val} {puts true} else {puts false}
delete $ntoggle
}
main [expr {$argc==1?[lindex $argv 0]:1}]
