Tk Library Source Code

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164

Hallo, using tcllib's profiler 0.2.1 with tcl 8.4 shows some problems which I try to overcome. The first problem or comment is related to a former posting of Ulrich Schoebel and some Bug (582506, 582522) in the namespace import and trace functionality. The workaround I found is to wrap the import when profiling and set an 'interp alias ...' too. But then I found out that the procedure name is not always the same for a procedure depending on the scope of calling. So I add a small patch to the trace handler to get more 'canonical' names using 'namespace origin'. --- /usr/local/ActiveTcl-8.4.4/lib/tcllib1.5/profiler/profiler.tcl 2003-07-21 07:16:11.000000000 +0200 +++ profiler.tcl 2003-10-16 11:51:50.000000000 +0200 @@ -158,15 +158,31 @@ # None proc ::profiler::TraceHandler {name cmd args} { - + if { [info level] == 1 } { set caller GLOBAL } else { # Get the name of the calling procedure set caller [lindex [info level -1] 0] + if {[string length $caller]} { + set caller [uplevel [list namespace origin $caller]] + } else { + # if info level is empty try one more + if {[info level] > 2} { + set caller [lindex [info level -2] 0] + if {[string length $caller]} { + set caller [uplevel [list namespace origin $caller]] + } else { + set caller EMPTY + } + } + } } set type [lindex $args end] + # get a 'canonical' name + set name [uplevel [list namespace origin $name]] + ::profiler::${type}Handler $name $caller } Note, that if the info level is empty, which occurs with tcltest, I go up another level if this is possible. A somehow strange effect, any comments? Next, it would be nice to add commands and procedures defined before the profiler was initialized. Therefore I suggest an additional procedure: # ::profiler::addCmd # # the procedure is derived from the tcllib profiler procedure # procProf and allows to add commands to the profiling, which are not # included before proc ::profiler::addCmd {name} { variable callCount variable compileTime variable totalRuntime variable descendantTime variable statTime variable enabled variable paused set name [uplevel [list namespace origin $name]] # Set up accounting for this procedure set callCount($name) 0 set compileTime($name) 0 set totalRuntime($name) 0 set descendantTime($name) 0 set statTime($name) {} set enabled($name) [expr {!$paused}] if {[package vsatisfies [package provide Tcl] 8.4]} { trace add execution $name {enter leave} [list ::profiler::TraceHandler $name] } else { error "add commands to profiling needs tcl 8.4 or higher" } return } This procedure was derived from the ::profiler::profProc and allows to add tcl commands, too. But one must be careful profiling 'set', because you change the internal profiler state while calling suspend and resume. See the patch below. The same problems occur when you try to profile the profiler ;-) apply to proc ::profiler::resume {{pattern *}} @@ -571,10 +588,15 @@ variable callCount variable enabled variable paused - set paused 0 foreach name [array names callCount $pattern] { - set enabled($name) 1 + if {[string equal $name "::set"]} { + trace remove execution $name {enter leave} [list ::profiler::TraceHandler $name] + } + set enabled($name) 1 + if {[string equal $name "::set"]} { + trace add execution $name {enter leave} [list ::profiler::TraceHandler $name] + } } return Having add, remove would be nice too: proc ::profiler::removeCmd {name} { variable callCount variable compileTime variable totalRuntime variable descendantTime variable statTime variable enabled variable paused set name [uplevel [list namespace origin $name]] if {![info exists enabled($name)]} return # Remove accounting for this procedure unset callCount($name) unset compileTime($name) unset totalRuntime($name) unset descendantTime($name) unset statTime($name) unset enabled($name) if {[package vsatisfies [package provide Tcl] 8.4]} { trace remove execution $name {enter leave} [list ::profiler::TraceHandler $name] } else { error "delete commands to profiling needs tcl 8.4 or higher" } return } And finally it would be nice to stop the profiler from arranging procedures for profiling. I solve this by setting back the interpreter alias of proc. This are the points which are still open, IMHO - separate init and profiler start - leaving the profiler completely, something like package forget ... - have a closer look on recursive function calls - and maybe some day one could measure the coverage, too. IMHO that this should not be too difficult If, you are interested I send the patched profiler and some tcltest. <frank/>