Attachment "p.diff" to
ticket [446799ffff]
added by
andreas_kupries
2001-08-22 06:35:10.
? Makefile
? config.status
? config.cache
? config.log
Index: modules/fileutil/fileutil.n
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/fileutil.n,v
retrieving revision 1.3
diff -u -r1.3 fileutil.n
--- modules/fileutil/fileutil.n 2001/08/02 16:38:06 1.3
+++ modules/fileutil/fileutil.n 2001/08/21 23:33:32
@@ -5,7 +5,7 @@
'\" RCS: @(#) $Id: fileutil.n,v 1.3 2001/08/02 16:38:06 andreas_kupries Exp $
'\"
.so man.macros
-.TH fileutil n 1.0 Fileutil "file utilities"
+.TH fileutil n 1.1 Fileutil "file utilities"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
Index: modules/profiler/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/profiler/ChangeLog,v
retrieving revision 1.11
diff -u -r1.11 ChangeLog
--- modules/profiler/ChangeLog 2001/07/31 23:47:51 1.11
+++ modules/profiler/ChangeLog 2001/08/21 23:33:32
@@ -1,3 +1,15 @@
+2001-08-21 Andreas Kupries <[email protected]>
+
+ * pkgIndex.tcl: Moved version to 0.2.
+
+ * profiler.test: Adapted testsuite.
+
+ * profiler.n: Added documentation. Same patch as below.
+
+ * profiler.tcl: Applied patch [446799] by Hemang Lavana
+ <[email protected]>, adding support for
+ resume/suspend operations to the profiler. moved version to 0.2.
+
2001-07-31 Andreas Kupries <[email protected]>
* profiler.tcl (Handler): Fixed [446562].
Index: modules/profiler/pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/profiler/pkgIndex.tcl,v
retrieving revision 1.2
diff -u -r1.2 pkgIndex.tcl
--- modules/profiler/pkgIndex.tcl 2001/08/02 16:38:07 1.2
+++ modules/profiler/pkgIndex.tcl 2001/08/21 23:33:32
@@ -9,4 +9,4 @@
# full path name of this file's directory.
if {![package vsatisfies [package provide Tcl] 8.3]} {return}
-package ifneeded profiler 0.1 [list source [file join $dir profiler.tcl]]
+package ifneeded profiler 0.2 [list source [file join $dir profiler.tcl]]
Index: modules/profiler/profiler.n
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/profiler/profiler.n,v
retrieving revision 1.5
diff -u -r1.5 profiler.n
--- modules/profiler/profiler.n 2001/08/02 16:38:07 1.5
+++ modules/profiler/profiler.n 2001/08/21 23:33:32
@@ -5,7 +5,7 @@
'\" RCS: @(#) $Id: profiler.n,v 1.5 2001/08/02 16:38:07 andreas_kupries Exp $
'\"
.so man.macros
-.TH profiler n 0.1 profiler "Tcl Profiler"
+.TH profiler n 0.2 profiler "Tcl Profiler"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -13,8 +13,12 @@
.SH SYNOPSIS
\fBpackage require Tcl 8.3\fR
.sp
-\fBpackage require profiler ?0.1?\fR
+\fBpackage require profiler ?0.2?\fR
.sp
+\fB::profiler::suspend\fR ?\fIpattern\fR?
+.sp
+\fB::profiler::resume\fR ?\fIpattern\fR?
+.sp
\fB::profiler::init\fR
.sp
\fB::profiler::dump\fR ?\fIpattern\fR?
@@ -79,9 +83,23 @@
The return result is a human readable display of the profiling
information.
.TP
-\fB::profiler::reset\fR ?\fIpattern\fR?
+\fB::profiler::reset\fR
Reset profiling information for all functions matching \fIpattern\fR.
If no pattern is specified, information will be reset for all functions.
+.TP
+\fB::profiler::suspend\fR ?\fIpattern\fR?
+Suspend profiling for all functions matching \fIpattern\fR.
+If no pattern is specified, profiling will be suspended for
+all functions. It stops gathering profiling information after
+this command is issued. However, it does not erase any profiling
+information that has been gathered previously.
+Use resume command to re-enable profiling.
+.TP
+\fB::profiler::resume\fR ?\fIpattern\fR?
+Resume profiling for all functions matching \fIpattern\fR.
+If no pattern is specified, profiling will be resumed for
+all functions. This command should be invoked after suspending
+the profiler in the code.
.TP
\fB::profiler::sortFunctions\fR \fIkey\fR
Return a list of functions sorted by a particular profiling
Index: modules/profiler/profiler.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/profiler/profiler.tcl,v
retrieving revision 1.16
diff -u -r1.16 profiler.tcl
--- modules/profiler/profiler.tcl 2001/08/02 16:38:07 1.16
+++ modules/profiler/profiler.tcl 2001/08/21 23:33:32
@@ -10,10 +10,9 @@
# RCS: @(#) $Id: profiler.tcl,v 1.16 2001/08/02 16:38:07 andreas_kupries Exp $
package require Tcl 8.3 ;# uses [clock clicks -milliseconds]
-package provide profiler 0.1
+package provide profiler 0.2
namespace eval ::profiler {
- variable enabled 1
}
# ::profiler::tZero --
@@ -121,7 +120,7 @@
proc ::profiler::Handler {name args} {
variable enabled
- if { $enabled } {
+ if { $enabled($name) } {
if { [info level] == 1 } {
set caller GLOBAL
} else {
@@ -137,7 +136,7 @@
}
set CODE [uplevel 1 [list ${name}ORIG] $args]
- if { $enabled } {
+ if { $enabled($name) } {
set t [::profiler::tMark $name.$caller]
lappend ::profiler::statTime($name) $t
@@ -174,6 +173,8 @@
variable totalRuntime
variable descendantTime
variable statTime
+ variable enabled
+ variable paused
# Get the fully qualified name of the proc
set ns [uplevel [list namespace current]]
@@ -195,6 +196,7 @@
set totalRuntime($name) 0
set descendantTime($name) 0
set statTime($name) {}
+ set enabled($name) [expr {!$paused}]
uplevel 1 [list ::_oldProc ${name}ORIG $arglist $body]
uplevel 1 [list interp alias {} $name {} ::profiler::Handler $name]
@@ -213,6 +215,9 @@
# profiler::profProc
proc ::profiler::init {} {
+ # paused is set to 1 when the profiler is suspended.
+ variable paused 0
+
rename ::proc ::_oldProc
interp alias {} proc {} ::profiler::profProc
@@ -440,6 +445,54 @@
unset callers($caller)
}
}
+ return
+}
+
+# ::profiler::suspend --
+#
+# Suspend the profiler.
+#
+# Arguments:
+# pattern pattern of functions to suspend; default is *.
+#
+# Results:
+# None. Resets the `enabled($name)' variable to 0
+# to suspend profiling
+
+proc ::profiler::suspend {{pattern *}} {
+ variable callCount
+ variable enabled
+ variable paused
+
+ set paused 1
+ foreach name [array names callCount $pattern] {
+ set enabled($name) 0
+ }
+
+ return
+}
+
+# ::profiler::resume --
+#
+# Resume the profiler, after it has been suspended.
+#
+# Arguments:
+# pattern pattern of functions to suspend; default is *.
+#
+# Results:
+# None. Sets the `enabled($name)' variable to 1
+# so as to enable the profiler.
+
+proc ::profiler::resume {{pattern *}} {
+ variable callCount
+ variable enabled
+ variable paused
+
+ set paused 0
+ foreach name [array names callCount $pattern] {
+ set enabled($name) 1
+ }
+
return
}
Index: modules/profiler/profiler.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/profiler/profiler.test,v
retrieving revision 1.9
diff -u -r1.9 profiler.test
--- modules/profiler/profiler.test 2000/06/15 23:46:59 1.9
+++ modules/profiler/profiler.test 2001/08/21 23:33:32
@@ -163,7 +163,7 @@
Caller distribution:
GLOBAL: 4"
-test profiler-5.1 {profiler respects enabled flag} {
+test profiler-5.1 {profiler respects suspend/resume} {
set c [interp create]
interp alias $c parentSet {} set
set result [$c eval {
@@ -177,10 +177,12 @@
foo
foo
foo
- set profiler::enabled 0
+ profiler::suspend ::foo ; # note the qualification, has to match proc!
foo
foo
- profiler::print ::foo
+ set res [profiler::print ::foo]
+ profiler::resume
+ set res
}]
interp delete $c
regsub {Compile time:.*} $result {} result
