? test.tcl
? profiler0.2.1.diff
Index: pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/profiler/pkgIndex.tcl,v
retrieving revision 1.3
diff -r1.3 pkgIndex.tcl
12c12
< package ifneeded profiler 0.2 [list source [file join $dir profiler.tcl]]
---
> package ifneeded profiler 0.2.1 [list source [file join $dir profiler.tcl]]
Index: profiler.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/profiler/profiler.tcl,v
retrieving revision 1.17
diff -r1.17 profiler.tcl
13c13
< package provide profiler 0.2
---
> package provide profiler 0.2.1
109,112c109,113
< #	Profile a function.  This function works together with profProc, which
< #	replaces the proc command.  When a new procedure is defined, it creates
< #	and alias to this function; when that procedure is called, it calls
< #	this handler first, which gathers profiling information from the call.
---
> #	Profile a function (tcl8.3).  This function works together with 
> #       profProc, which replaces the proc command.  When a new procedure
> #       is defined, it creates and alias to this function; when that
> #       procedure is called, it calls this handler first, which gathers
> #       profiling information from the call.
123,135c124,131
<     if { $enabled($name) } {
< 	if { [info level] == 1 } {
< 	    set caller GLOBAL
< 	} else {
< 	    # Get the name of the calling procedure
< 	    set caller [lindex [info level -1] 0]
< 	    # Remove the ORIG suffix
< 	    set caller [string range $caller 0 end-4]
< 	}
< 	if { [catch {incr ::profiler::callers($name,$caller)}] } {
< 	    set ::profiler::callers($name,$caller) 1
< 	}
< 	::profiler::tZero $name.$caller
---
> 
>     if { [info level] == 1 } {
>         set caller GLOBAL
>     } else {
>         # Get the name of the calling procedure
> 	set caller [lindex [info level -1] 0]
> 	# Remove the ORIG suffix
> 	set caller [string range $caller 0 end-4]
137a134
>     ::profiler::enterHandler $name $caller
139,141c136,138
<     if { $enabled($name) } {
< 	set t [::profiler::tMark $name.$caller]
< 	lappend ::profiler::statTime($name) $t
---
>     ::profiler::leaveHandler $name $caller
>     return $CODE
> }
143,152c140,228
< 	if { [incr ::profiler::callCount($name)] == 1 } {
< 	    set ::profiler::compileTime($name) $t
< 	}
< 	incr ::profiler::totalRuntime($name) $t
< 	if { [catch {incr ::profiler::descendantTime($caller) $t}] } {
< 	    set ::profiler::descendantTime($caller) $t
< 	}
< 	if { [catch {incr ::profiler::descendants($caller,$name)}] } {
< 	    set ::profiler::descendants($caller,$name) 1
< 	}
---
> # ::profiler::TraceHandler --
> #
> #	Profile a function (tcl8.4+).  This function works together with
> #       profProc, which replaces the proc command.  When a new procedure
> #       is defined, it creates an execution trace on the function; when
> #       that function is called, 'enter' and 'leave' traces invoke this
> #       handler first, which gathers profiling information from the call.
> #
> # Arguments:
> #	name	name of the function to profile.
> #	cmd	command name and its expanded arguments.
> #	args	for 'enter' operation, value of args is "enter"
> #	    	for 'leave' operation, args is list of
> #               3 elements: <code> <result> "leave"
> #
> # Results:
> #	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]
>     }
> 
>     set type [lindex $args end]
>     ::profiler::${type}Handler $name $caller
> }
> 
> # ::profiler::enterHandler --
> #
> #	Profile a function.  This function works together with Handler and
> #       TraceHandler to collect profiling information just before it invokes
> #       the function.
> #
> # Arguments:
> #	name	name of the function to profile.
> #	caller	name of the function that calls the profiled function.
> #
> # Results:
> #	None
> 
> proc ::profiler::enterHandler {name caller} {
>     variable enabled
> 
>     if { !$enabled($name) } {
>         return
>     }
> 
>     if { [catch {incr ::profiler::callers($name,$caller)}] } {
>         set ::profiler::callers($name,$caller) 1
>     }
>     ::profiler::tZero $name.$caller
> }
> 
> # ::profiler::leaveHandler --
> #
> #	Profile a function.  This function works together with Handler and
> #       TraceHandler to collect profiling information just after it invokes
> #       the function.
> #
> # Arguments:
> #	name	name of the function to profile.
> #	caller	name of the function that calls the profiled function.
> #
> # Results:
> #	None
> 
> proc ::profiler::leaveHandler {name caller} {
>     variable enabled
> 
>     if { !$enabled($name) } {
>         return
>     }
> 
>     set t [::profiler::tMark $name.$caller]
>     lappend ::profiler::statTime($name) $t
> 
>     if { [incr ::profiler::callCount($name)] == 1 } {
>         set ::profiler::compileTime($name) $t
>     }
>     incr ::profiler::totalRuntime($name) $t
>     if { [catch {incr ::profiler::descendantTime($caller) $t}] } {
>         set ::profiler::descendantTime($caller) $t
>     }
>     if { [catch {incr ::profiler::descendants($caller,$name)}] } {
>         set ::profiler::descendants($caller,$name) 1
154d229
<     return $CODE
201,202c276,283
<     uplevel 1 [list ::_oldProc ${name}ORIG $arglist $body]
<     uplevel 1 [list interp alias {} $name {} ::profiler::Handler $name]
---
>     if {[package vsatisfies [package provide Tcl] 8.4]} {
>         uplevel 1 [list ::_oldProc $name $arglist $body]
>         trace add execution $name {enter leave} \
>                  [list ::profiler::TraceHandler $name]
>     } else {
>         uplevel 1 [list ::_oldProc ${name}ORIG $arglist $body]
>         uplevel 1 [list interp alias {} $name {} ::profiler::Handler $name]
>     }
Index: profiler.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/profiler/profiler.test,v
retrieving revision 1.10
diff -r1.10 profiler.test
15a16,26
> # This constraint restricts certain tests to run on tcl8.3 version only
> if {[package vsatisfies [package provide tcltest] 2.0]} {
>     # tcltest2.0+ has an API to specify a test constraint
>     ::tcltest::testConstraint tcl8.3only \
>         [expr {![package vsatisfies [package provide Tcl] 8.4]}]
> } else {
>     # In tcltest1.0, a global variable needs to be set directly.
>     set ::tcltest::testConstraints(tcl8.3only) \
>         [expr {![package vsatisfies [package provide Tcl] 8.4]}]
> }
> 
33c44
< test profiler-2.0 {profiler creates two wrapper proc and real proc} {
---
> test profiler-2.0 {profiler creates two wrapper proc and real proc} {tcl8.3only} {
48c59
< test profiler-2.1 {profiler creates procs in correct scope} {
---
> test profiler-2.1 {profiler creates procs in correct scope} {tcl8.3only} {
64c75
< test profiler-2.2 {profiler creates procs in correct scope} {
---
> test profiler-2.2 {profiler creates procs in correct scope} {tcl8.3only} {
81c92
< test profiler-2.3 {profiler creates procs in correct scope} {
---
> test profiler-2.3 {profiler creates procs in correct scope} {tcl8.3only} {
100c111
< test profiler-2.4 {profiler creates procs in correct scope} {
---
> test profiler-2.4 {profiler creates procs in correct scope} {tcl8.3only} {
