setup

I have a simple class ::MyClass which has a method called icrN

icrN: Procedure icrN increment a instance-attribut

testN1-4: This is the test method that ultimately builds the environment and finally calls the time command

goal

The goal is to determine whether performance differs between the variable types used.

$myNs: This is the return from the instance-CTOR and points to the instance-namespace

::otto , ::ottoLongName111...: This is just the string value of the global-namespace variable.

analyze

If you analyze the test result, you will see that all my-variations have the same speed.

testN1 versa testN2/3 , testN4 versa testN5/6

direct-access is 50% - ~90% faster than method-call.

testN2 versa testN3

If local-reference is used only-once than my is faster than my(counter).

testN5 versa testN6

If local-reference is used more-than-once than my(counter) is faster than my.

 
# =================================================================
# performance test: different variants of <my> 

package require tclmyoox
> 1.0

::myooX::ClassN ::MyClass {
  proc MyClass {myNs} {
    namespace upvar $myNs my my
    set my(counter) [expr {int(rand()*10000)}]
    set my(backup)  $my(counter)
  }
  proc resetN {myNs} {
    namespace upvar $myNs my my
    set my(counter) $my(backup)
  }
  proc icrN {myNs} {
    namespace upvar $myNs my my
    incr my(counter)
  }
}
> ::MyClass


set dV_testL [list]

proc doValidate {myNs nme var code} {
  namespace upvar $myNs my my 
  upvar $var tst

  global dV_dataL dV_errorA dV_testL
  lappend dV_dataL $nme $var $code
  # dV_validate test case
  foreach tst $dV_testL {
    if {[string match *0 $tst]} {
      # referenze test
      set dV_errorA($tst,$nme) 0
    } else {
      # performance test
      # 1. reset test case, return "old" value
      set old [::MyClass::resetN $myNs]
      # 2. call incr code
      if {[catch {uplevel $code} new opt]} {
        #ErrorCatch $opt "§validate failed in" nme code
        set dV_errorA($tst,$nme) 1
        ErrorCatch $opt "§validate failed on 'execute'" nme code tst new
      } elseif {$new <= $old} {
        set dV_errorA($tst,$nme) 2
        Message red "§validate failed on 'count'" nme code tst old new
      } else {
        set dV_errorA($tst,$nme) 0
      }
    }
  }
}

proc doReset {pat} {
  global dT_resultA dV_dataL dV_errorA dV_testL

  array unset dV_errorA
  array unset dT_resultA

  array set dV_errorA     ""
  array set dT_resultA    ""
  set dV_dataL            [list]
  set dV_testL            [lsort -dictionary [info commands $pat]]
}

proc doTest {} {
  global dT_resultA dV_dataL dV_errorA dV_testL
  array set ref0 ""
  # do the real test
  foreach {nme var code} $dV_dataL {
    upvar $var tst
    lappend dT_resultA(TEST) $nme
    foreach tst $dV_testL {
      if {$dV_errorA($tst,$nme)} {
        lappend dT_resultA($tst) INVALID
      } elseif {[catch {uplevel [list time $code $::timeNum]} ret opt]} {
        ErrorCatch $opt "unexpected error in" nme code
      } elseif {[string match *0 $tst]} { 
        # overhead to call the test proc
        set ref0($code) [lindex $ret 0]
      } else {
        lappend dT_resultA($tst) [expr { 
         ( int( ( [lindex $ret 0] - $ref0($code) ) * 10000 ) ) / 10000.0
        }]
      }
    }
  }
  unset dV_dataL
}

# ==================================================================
# setup dV_dataL

proc testN0 {myNs} {
  # call empty proc overhead
  return 0
}

proc testN1 {myNs} {
  # call method to calculate overhead
  ::MyClass::icrN $myNs
}

proc testN2 {myNs} {
  # direct attribute access "my"
  namespace upvar $myNs  my my
  incr my(counter)
}

proc testN3 {myNs} {
  # direct attribute access "my(counter)"
  namespace upvar $myNs  my(counter) myCounter
  incr myCounter
}

proc testN4 {myNs} {
  # multiple incr using method call
  ::MyClass::icrN $myNs 
  ::MyClass::icrN $myNs 
  ::MyClass::icrN $myNs
  ::MyClass::icrN $myNs
  ::MyClass::icrN $myNs
}

proc testN5 {myNs} {
  # multiple incr on already resolved "my"
  namespace upvar $myNs  my my
  incr my(counter)
  incr my(counter)
  incr my(counter)
  incr my(counter)
  incr my(counter)
}

proc testN6 {myNs} {
  # multiple incr on already resolved "my(counter)"
  namespace upvar $myNs  my(counter) myCounter
  incr myCounter
  incr myCounter
  incr myCounter
  incr myCounter
  incr myCounter
}

set timeNum 5000

set myNs       [::myooX::NewN ::MyClass]
> ::MyClass::MyClass-1
set myNsShort  [::myooX::Create2N ::MyClass ::otto]
> ::otto
set myNsLong   [::myooX::Create2N ::MyClass ::ottoLongName111111111111111111111111111111111111111111111111]
> ::ottoLongName111111111111111111111111111111111111111111111111

# ============================================================================
# test - access instance by namespace

doReset testN*

doValidate $myNs       "nsAsVar"        tst {$tst $myNs}
doValidate $myNsShort  "nsAsShortName"  tst {$tst ::otto}
doValidate $myNsShort  "nsAsShortVar"   tst {$tst $myNsShort}
doValidate $myNsLong   "nsAsLongName"   tst {$tst ::ottoLongName111111111111111111111111111111111111111111111111}
doValidate $myNsLong   "nsAsLongVar"    tst {$tst $myNsLong}

doTest

# results: microseconds per interation
print -color orange §AL§*§dT_resultA
> dT_resultA<array|P|*>
  | TEST   | nsAsVar | nsAsShortName | nsAsShortVar | nsAsLongName | nsAsLongVar
  | testN1 | 5.9945  | 5.7878        | 5.9019       | 5.8426       | 6.0123
  | testN2 | 1.2229  | 1.0542        | 0.9822       | 1.1083       | 1.2013
  | testN3 | 1.2016  | 1.3182        | 1.1609       | 1.2698       | 1.2129
  | testN4 | 29.9126 | 29.501        | 29.4192      | 29.6583      | 29.5154
  | testN5 | 3.9528  | 4.0106        | 3.8043       | 4.0136       | 4.0154
  | testN6 | 1.5621  | 1.5178        | 1.3585       | 1.3854       | 1.4619