tomk: I noticed the following example on comp.lang.tcl and thought that it was
so I decided it was worth preserving on the wiki.
Fredrik wrote: sorry if this is a stupid question, but I would like to get into profiling of some of my TclOO classes, i.e. some use cases for their methods. Now, I see that the Tcllib profiler package redefines the "proc" command to do the dynamic source code analysis. Now, would that behave anywhere near correctly on a TclOO object method call?
DKF responded: No.
Frederick: If not, which I would guess is the case, are there alternatives which would work?
DKF: Mix in some kind of interceptor class into an object you want to watch, like this:
oo::class create interceptor {
filter INTERCEPT
method INTERCEPT args {
set t [time {
catch {next {*}$args} msg opts
}]
puts "[lindex $t 0]µs for [lindex $args 0] on [self]"
return -options $opts $msg
}
}
# A silly example class
oo::class create example {
method bar x {
for {set i 0} {$i<$x} {incr i} {
incr out $i
}
return $out
}
}
example create foo
puts [foo bar 500]
# Attach the instrumentation and rerun with a little profiling...
oo::objdefine foo mixin interceptor
puts [foo bar 500]OK, that's a very noddy example but it shows how to do it.
Donal.
George Petasis: I have tried to write a small extension for tcllib's profiler:
package require TclOO
package require profiler
namespace eval ::profiler {
if {![info exists paused]} {set paused 0}
namespace eval tcloo {
proc profile {args} {
foreach object $args {
## Have we registered this object before?
if {"::profiler::tcloo::interceptor" in [info object mixins $object]} {
continue
}
if {[info object isa class $object]} {
set class ::[string trimleft $object :]
} else {
set class [info object class $object]
}
foreach method [info class methods $class -all -private] {
set name ${class}::$method
set ::profiler::callCount($name) 0
set ::profiler::compileTime($name) 0
set ::profiler::totalRuntime($name) 0
set ::profiler::descendantTime($name) 0
set ::profiler::statTime($name) {}
set ::profiler::enabled($name) [expr {!$::profiler::paused}]
}
if {[info object isa class $object]} {
oo::define $class mixin ::profiler::tcloo::interceptor
} else {
oo::objdefine $object mixin ::profiler::tcloo::interceptor
}
}
};# profile
};# namespace tcloo
};# namespace ::profiler
oo::class create ::profiler::tcloo::interceptor {
filter PROFILER_INTERCEPT
method PROFILER_INTERCEPT args {
lassign [self target] class method
# Do not filter the core method implementations
if {$class eq "::oo::object"} {
return [next {*}$args]
}
set name ${class}::$method
if {![info exists ::profiler::enabled($name)]} {
::profiler::tcloo::profile $class
}
::profiler::TraceHandler $name {} enter
catch {next {*}$args} msg opts
::profiler::TraceHandler $name {} leave
return -options $opts $msg
};# PROFILER_INTERCEPT
};# class ::profiler::tcloo::interceptor
package provide profiler_tcloo 1.0
# vim: syntax=tcl
It can be used as: ::profiler::tcloo::profile ?class|object? ...
package require profiler_tcloo ::profiler::tcloo::profile example example create foo puts [foo bar 500] puts [::profiler::print]
It can be set to either classes or specific objects. In case of objects, the usage statistics are stored using as name of the class (and not the object name, which may aslo be reasonable...)
SEH: The above works well to profile class methods, but if you create a subclass from your profiled class, you get an error in the profiler package code, because the subclass inherits the interceptor mixin but the subclass isn't registered with the profiler code. So when a method from the subclass is executed, the error is thrown. I added a check for this case in the interceptor, that dynamically calls ::profiler::tcloo::profile on the subclass if necessary. Now I can register oo::class and profile all object methods.