Profiling a TclOO class

tomk: I noticed the following example on comp.lang.tcl and thought that it was

  1. A good example of how to use the TclOO filter command
  2. A useful example in its own right

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.


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]} {
        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 {

  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

};# 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.