Index: logger.man
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/log/logger.man,v
retrieving revision 1.17
diff -u -p -r1.17 logger.man
--- logger.man	28 Apr 2006 06:07:20 -0000	1.17
+++ logger.man	23 Jun 2006 22:16:49 -0000
@@ -176,6 +176,37 @@ to a database, or anything else.  For ex
     ${log}::logproc notice logtoserver
 }]
 
+Trace logs are slightly different: instead of a plain text argument,
+the argument provided to the logproc is a dictionary consisting of the
+[const enter] or [const leave] keyword along with another dictionary of
+details about the trace.  These include:
+
+[list_begin bullet]
+
+[bullet] [const proc] - Name of the procedure being traced.
+
+[bullet] [const level] - The stack level for the procedure invocation
+(from [cmd info] [cmd level]).
+
+[bullet] [const script] - The name of the file in which the procedure is
+defined, or an empty string if defined in interactive mode.
+
+[bullet] [const caller] - The name of the procedure calling the procedure
+being traced, or an empty string if the procedure was called from the
+global scope (stack level 0).
+
+[bullet] [const procargs] - A dictionary consisting of the names of arguments
+to the procedure paired with values given for those arguments ([const enter]
+traces only).
+
+[bullet] [const status] - The Tcl return code (e.g. [const ok],
+[const continue], etc.) ([const leave] traces only).
+
+[bullet] [const result] - The value returned by the procedure ([const leave]
+traces only).
+
+[list_end]
+
 [call [cmd \${log}::services]]
 
 Returns a list of the registered logging services which are children of this service.
@@ -204,6 +235,97 @@ For example:
 This command deletes a particular logging service, and its children.
 You must call this to clean up the resources used by a service.
 
+[call [cmd \${log}::trace] [arg command]]
+
+This command controls logging of enter/leave traces for specified procedures.
+It is used to enable and disable tracing, query tracing status, and
+specify procedures are to be traced.  Trace handlers are unregistered when
+tracing is disabled.  As a result, there is not performance impact to a
+library when tracing is disabled, just as with other log level commands.
+
+[example {
+  proc tracecmd { dict } {
+      puts $dict
+  }
+
+  set log [::logger::init example]
+  ${log}::logproc trace tracecmd
+
+  proc foo { args } {
+      puts "In foo"
+      bar 1
+      return "foo_result"
+  }
+    
+  proc bar { x } {
+      puts "In bar"
+      return "bar_result"
+  }
+
+  ${log}::trace add foo bar
+  ${log}::trace on
+
+  foo
+
+# Output:
+enter {proc ::foo level 1 script {} caller {} procargs {args {}}}
+In foo
+enter {proc ::bar level 2 script {} caller ::foo procargs {x 1}}
+In bar
+leave {proc ::bar level 2 script {} caller ::foo status ok result bar_result}
+leave {proc ::foo level 1 script {} caller {} status ok result foo_result}
+}]
+
+[call [cmd \${log}::trace] [cmd on]]
+
+Turns on trace logging for procedures registered through the [cmd trace]
+[cmd add] command.  This is similar to the [cmd enable] command for other
+logging levels, but allows trace logging to take place at any level.
+
+The trace logging mechanism takes advantage of the execution trace feature
+of Tcl 8.4 and later.  The [cmd trace] [cmd on] command will return an
+error if called from earlier versions of Tcl.
+
+[call [cmd \${log}::trace] [cmd off]]
+
+Turns off trace logging for procedures registered for trace logging
+through the [cmd trace] [cmd add] command.  This is similar to the
+[cmd disable] command for other logging levels, but allows trace logging
+to take place at any level.
+
+Procedures are not unregistered, so logging for them can be turned back
+on with the [cmd trace] [cmd on] command.  There is no overhead imposed
+by trace registration when trace logging is disabled.
+
+[call [cmd \${log}::trace] [cmd status] [opt procName] [opt ...]]
+
+This command returns a list of the procedures currently registered for
+trace logging, or a flag indicating whether or not a trace is registered
+for one or more specified procedures.
+
+[call [cmd \${log}::trace] [cmd add] [arg procName] [opt ...]]
+[call [cmd \${log}::trace] [cmd add] [opt -ns] [arg nsName] [opt ...]]
+
+This command registers one or more procedures for logging of entry/exit
+traces.  Procedures can be specified via a list of procedure names or
+namespace names (in which case all procedure within the namespace
+are targeted by the operation).  By default, each name is first
+interpreted as a procedure name or glob-style search pattern, and if
+not found its interpreted as a namespace name.  The [arg -ns] option can
+be used to force interpretation of all provided arguments as namespace names.
+
+Procedures must be defined prior to registering them for tracing
+through the [cmd trace] [cmd add] command.  Any procedure or namespace
+names/patterns that don't match any existing procedures will be
+silently ignored.
+
+[call [cmd \${log}::trace] [cmd remove] [arg procName] [opt ...]]
+[call [cmd \${log}::trace] [cmd remove] [opt -ns] [arg nsName] [opt ...]]
+
+This command unregisters one or more procedures so that they will no
+longer have trace logging performed, with the same matching rules as
+that of the [cmd trace] [cmd add] command.
+
 [list_end]
 
 [section IMPLEMENTATION]
Index: logger.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/log/logger.tcl,v
retrieving revision 1.28
diff -u -p -r1.28 logger.tcl
--- logger.tcl	28 Apr 2006 06:07:20 -0000	1.28
+++ logger.tcl	23 Jun 2006 22:16:49 -0000
@@ -28,6 +28,9 @@ namespace eval ::logger {
     
     # The default global log level used for new logging services
     variable enabled "debug"
+
+    # Tcl return codes (in numeric order)
+    variable RETURN_CODES   [list "ok" "error" "return" "break" "continue"]
 }
 
 # ::logger::_nsExists --
@@ -127,6 +130,13 @@ proc ::logger::init {service} {
     # The currently configured levelcommands
     variable lvlcmds 
     array set lvlcmds {}
+
+    # List of procedures registered via the trace command
+    variable traceList ""
+
+    # Flag indicating whether or not tracing is currently enabled
+    variable tracingEnabled 0
+
     # We use this to disable a service completely.  In Tcl 8.4
     # or greater, by using this, disabled log calls are a
     # no-op!
@@ -375,7 +385,7 @@ proc ::logger::init {service} {
         variable lvlcmds
         
         set lvnum [lsearch -exact $levels $lv]
-        if { $lvnum == -1 } {
+        if { ($lvnum == -1) && ($lv != "trace") } {
         return -code error "Invalid level '$lv' - levels are $levels"
         }
         switch -exact -- [llength $args] {
@@ -505,6 +515,60 @@ proc ::logger::init {service} {
         return
     }
     
+    proc trace { action args } {
+        variable service
+
+        # Allow other boolean values (true, false, yes, no, 0, 1) to be used
+        # as synonymns for "on" and "off".
+
+        if {[string is boolean $action]} {
+            set xaction [expr {($action && 1) ? "on" : "off"}]
+        } else {
+            set xaction $action
+        }
+
+        # Check for required arguments for actions/subcommands and dispatch
+        # to the appropriate procedure.
+
+        switch -- $xaction {
+            "status" {
+                return [uplevel 1 [list logger::_trace_status $service $args]]
+            }
+            "on" {
+                if {[llength $args]} {
+                    return -code error "wrong # args: should be \"trace on\""
+                }
+                return [logger::_trace_on $service]
+            }
+            "off" {
+                if {[llength $args]} {
+                    return -code error "wrong # args: should be \"trace off\""
+                }
+                return [logger::_trace_off $service]
+            }
+            "add" {
+                if {![llength $args]} {
+                    return -code error \
+                        "wrong # args: should be \"trace add ?-ns? <proc> ...\""
+                }
+                return [uplevel 1 [list ::logger::_trace_add $service $args]]
+            }
+            "remove" {
+                if {![llength $args]} {
+                    return -code error \
+                        "wrong # args: should be \"trace remove ?-ns? <proc> ...\""
+                }
+                return [uplevel 1 [list ::logger::_trace_remove $service $args]]
+            }
+
+            default {
+	        return -code error \
+                    "Invalid action \"$action\": must be status, add, remove,\
+                    on, or off"
+            }
+        }
+    }
+
     # Walk the parent service namespaces to see first, if they
     # exist, and if any are enabled, and then, as a
     # consequence, enable this one
@@ -545,7 +609,7 @@ proc ::logger::init {service} {
         setlevel [${parent}::currentloglevel]
 
     } else {
-        foreach lvl [::logger::levels] {
+        foreach lvl [concat [::logger::levels] "trace"] {
             proc ${lvl}cmd {args} "_setservicename \$args ; 
                                    set val \[stdoutcmd $lvl \[lindex \$args end\]\] ; 
                                    _restoreservice; set val"
@@ -728,6 +792,7 @@ proc ::logger::import {args} {
     #
     
     set cmds [logger::levels]
+    lappend cmds "trace"
     if {$import_all} {
         lappend cmds setlevel enable disable logproc delproc services 
         lappend cmds servicename currentloglevel delete
@@ -807,3 +872,335 @@ proc ::logger::initNamespace {ns {level 
     namespace eval $ns [list log::setlevel $level]
     return
 }
+
+# This procedure handles the "logger::trace status" command.  Given no
+# arguments, returns a list of all procedures that have been registered
+# via "logger::trace add".  Given one or more procedure names, it will
+# return 1 if all were registered, or 0 if any were not.
+
+proc ::logger::_trace_status { service procList } {
+    upvar #0 ::logger::tree::${service}::traceList traceList
+
+    # If no procedure names were given, just return the registered list
+
+    if {![llength $procList]} {
+        return $traceList
+    }
+
+    # Get caller's namespace for qualifying unqualified procedure names
+
+    set caller_ns [uplevel 1 namespace current]
+    set caller_ns [string trimright $caller_ns ":"]
+
+    # Search for any specified proc names that are *not* registered
+
+    foreach procName $procList {
+        # Make sure the procedure namespace is qualified
+
+        if {![string match "::*" $procName]} {
+            set procName ${caller_ns}::$procName
+        }
+
+        # Check if the procedure has been registered for tracing
+
+        if {[lsearch -exact $traceList $procName] == -1} {
+	    return 0
+        }
+    }
+
+    return 1
+}
+
+# This procedure handles the "logger::trace on" command.  If tracing
+# is turned off, it will enable Tcl trace handlers for all of the procedures
+# registered via "logger::trace add".  Does nothing if tracing is already
+# turned on.
+
+proc ::logger::_trace_on { service } {
+    set tcl_version [package provide Tcl]
+
+    if {[package vcompare $tcl_version "8.4"] < 0} {
+        return -code error \
+            "execution tracing is not available in Tcl $tcl_version"
+    }
+
+    namespace eval ::logger::tree::${service} {
+        if {!$tracingEnabled} {
+            set tracingEnabled 1
+            ::logger::_enable_traces $service $traceList
+        }
+    }
+
+    return 1
+}
+
+# This procedure handles the "logger::trace off" command.  If tracing
+# is turned on, it will disable Tcl trace handlers for all of the procedures
+# registered via "logger::trace add", leaving them in the list so they
+# tracing on all of them can be enabled again with "logger::trace on".
+# Does nothing if tracing is already turned off.
+
+proc ::logger::_trace_off { service } {
+    namespace eval ::logger::tree::${service} {
+        if {$tracingEnabled} {
+            ::logger::_disable_traces $service $traceList
+            set tracingEnabled 0
+        }
+    }
+
+    return 1
+}
+
+# This procedure is used by the logger::trace add and remove commands to
+# process the arguments in a common fashion.  If the -ns switch is given
+# first, this procedure will return a list of all existing procedures in
+# all of the namespaces given in remaining arguments.  Otherwise, each
+# argument is taken to be either a pattern for a glob-style search of
+# procedure names or, failing that, a namespace, in which case this
+# procedure returns a list of all the procedures matching the given
+# pattern (or all in the named namespace, if no procedures match).
+
+proc ::logger::_trace_get_proclist { inputList } {
+    set procList ""
+
+    if {[lindex $inputList 0] == "-ns"} {
+	# Verify that at least one target namespace was supplied
+
+	set inputList [lrange $inputList 1 end]
+	if {![llength $inputList]} {
+	    return -code error "Must specify at least one namespace target"
+	}
+
+	# Rebuild the argument list to contain namespace procedures
+
+	foreach namespace $inputList {
+            # Don't allow tracing of the logger (or child) namespaces
+
+	    if {![string match "::logger::*" $namespace]} {
+		set nsProcList  [::info procs ${namespace}::*]
+                set procList    [concat $procList $nsProcList]
+            }
+	}
+    } else {
+        # Search for procs or namespaces matching each of the specified
+        # patterns.
+
+        foreach pattern $inputList {
+	    set matches [uplevel 1 ::info proc $pattern]
+
+	    if {![llength $matches]} {
+	        if {[uplevel 1 namespace exists $pattern]} {
+		    set matches [::info procs ${pattern}::*]
+	        }
+
+                # Matched procs will be qualified due to above pattern
+
+                set procList [concat $procList $matches]
+            } elseif {[string match "::*" $pattern]} {
+                # Patterns were pre-qualified - add them directly
+
+                set procList [concat $procList $matches]
+            } else {
+                # Qualify each proc with the namespace it was in
+
+                set ns [uplevel 1 namespace current]
+                if {$ns == "::"} {
+                    set ns ""
+                }
+                foreach proc $matches {
+                    lappend procList ${ns}::$proc
+                }
+            }
+        }
+    }
+
+    return $procList
+}
+
+# This procedure handles the "logger::trace add" command.  If the tracing
+# feature is enabled, it will enable the Tcl entry and leave trace handlers
+# for each procedure specified that isn't already being traced.  Each
+# procedure is added to the list of procedures that the logger trace feature
+# should log when tracing is enabled.
+
+proc ::logger::_trace_add { service procList } {
+    upvar #0 ::logger::tree::${service}::traceList traceList
+
+    # Handle -ns switch and glob search patterns for procedure names
+
+    set procList [uplevel 1 [list logger::_trace_get_proclist $procList]]
+
+    # Enable tracing for each procedure that has not previously been
+    # specified via logger::trace add.  If tracing is off, this will just
+    # store the name of the procedure for later when tracing is turned on.
+
+    foreach procName $procList {
+        if {[lsearch -exact $traceList $procName] == -1} {
+            lappend traceList $procName
+            ::logger::_enable_traces $service [list $procName]
+        }
+    }
+}
+
+# This procedure handles the "logger::trace remove" command.  If the tracing
+# feature is enabled, it will remove the Tcl entry and leave trace handlers
+# for each procedure specified.  Each procedure is removed from the list
+# of procedures that the logger trace feature should log when tracing is
+# enabled.
+
+proc ::logger::_trace_remove { service procList } {
+    upvar #0 ::logger::tree::${service}::traceList traceList
+
+    # Handle -ns switch and glob search patterns for procedure names
+
+    set procList [uplevel 1 [list logger::_trace_get_proclist $procList]]
+
+    # Disable tracing for each proc that previously had been specified
+    # via logger::trace add.  If tracing is off, this will just
+    # remove the name of the procedure from the trace list so that it
+    # will be excluded when tracing is turned on.
+
+    foreach procName $procList {
+        set index [lsearch -exact $traceList $procName]
+        if {$index != -1} {
+            set traceList [lreplace $traceList $index $index]
+            ::logger::_disable_traces $service [list $procName]
+        }
+    }
+}
+
+# This procedure enables Tcl trace handlers for all procedures specified.
+# It is used both to enable Tcl's tracing for a single procedure when
+# removed via "logger::trace add", as well as to enable all traces
+# via "logger::trace on".
+
+proc ::logger::_enable_traces { service procList } {
+    upvar #0 ::logger::tree::${service}::tracingEnabled tracingEnabled
+
+    if {$tracingEnabled} {
+        foreach procName $procList {
+            ::trace add execution $procName enter \
+                [list ::logger::_trace_enter $service]
+            ::trace add execution $procName leave \
+                [list ::logger::_trace_leave $service]
+        }
+    }
+}
+
+# This procedure disables Tcl trace handlers for all procedures specified.
+# It is used both to disable Tcl's tracing for a single procedure when
+# removed via "logger::trace remove", as well as to disable all traces
+# via "logger::trace off".
+
+proc ::logger::_disable_traces { service procList } {
+    upvar #0 ::logger::tree::${service}::tracingEnabled tracingEnabled
+
+    if {$tracingEnabled} {
+        foreach procName $procList {
+            ::trace remove execution $procName enter \
+                [list ::logger::_trace_enter $service]
+            ::trace remove execution $procName leave \
+                [list ::logger::_trace_leave $service]
+        }
+    }
+}
+
+########################################################################
+# Trace Handlers
+########################################################################
+
+# This procedure is invoked upon entry into a procedure being traced
+# via "logger::trace add" when tracing is enabled via "logger::trace on"
+# to log information about how the procedure was called.
+
+proc ::logger::_trace_enter { service cmd op } {
+    # Parse the command
+    set procName [uplevel 1 namespace origin [lindex $cmd 0]]
+    set args     [lrange $cmd 1 end]
+
+    # Display the message prefix
+    set callerLvl [expr {[::info level] - 1}]
+    set calledLvl [::info level]
+
+    lappend message "proc" $procName
+    lappend message "level" $calledLvl
+    lappend message "script" [uplevel ::info script]
+
+    # Display the caller information
+    set caller ""
+    if {$callerLvl >= 1} {
+	# Display the name of the caller proc w/prepended namespace
+	catch {
+	    set callerProcName [lindex [::info level $callerLvl] 0]
+	    set caller [uplevel 2 namespace origin $callerProcName]
+	}
+    }
+
+    lappend message "caller" $caller
+
+    # Display the argument names and values
+    set argSpec [uplevel 1 ::info args $procName]
+    set argList ""
+    if {[llength $argSpec]} {
+	foreach argName $argSpec {
+            lappend argList $argName
+
+	    if {$argName == "args"} {
+                lappend argList $args
+                break
+	    } else {
+	        lappend argList [lindex $args 0]
+	        set args [lrange $args 1 end]
+            }
+	}
+    }
+
+    lappend message "procargs" $argList
+    set message [list $op $message]
+
+    ::logger::tree::${service}::tracecmd $message
+}
+
+# This procedure is invoked upon leaving into a procedure being traced
+# via "logger::trace add" when tracing is enabled via "logger::trace on"
+# to log information about the result of the procedure call.
+
+proc ::logger::_trace_leave { service cmd status rc op } {
+    variable RETURN_CODES
+
+    # Parse the command
+    set procName [uplevel 1 namespace origin [lindex $cmd 0]]
+
+    # Gather the caller information
+    set callerLvl [expr {[::info level] - 1}]
+    set calledLvl [::info level]
+
+    lappend message "proc" $procName "level" $calledLvl
+    lappend message "script" [uplevel ::info script]
+
+    # Get the name of the proc being returned to w/prepended namespace
+    set caller ""
+    catch {
+        set callerProcName [lindex [::info level $callerLvl] 0]
+        set caller [uplevel 2 namespace origin $callerProcName]
+    }
+
+    lappend message "caller" $caller
+
+    # Convert the return code from numeric to verbal
+
+    if {$status < [llength $RETURN_CODES]} {
+        set status [lindex $RETURN_CODES $status]
+    }
+
+    lappend message "status" $status
+    lappend message "result" $rc
+
+    # Display the leave message
+
+    set message [list $op $message]
+    ::logger::tree::${service}::tracecmd $message
+
+    return 1
+}
+
Index: logger.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/log/logger.test,v
retrieving revision 1.25
diff -u -p -r1.25 logger.test
--- logger.test	29 Jan 2006 05:58:20 -0000	1.25
+++ logger.test	23 Jun 2006 22:16:49 -0000
@@ -1210,5 +1210,336 @@ test logger-15.13 {test for namespace wi
     list $::gotcalled $code $msg
 } {0 1 {Invalid cmd '::logtest::*::test' - does not exist}}
 
+proc traceproc0 { } {
+    traceproc1
+}
+
+proc traceproc1 { args } {
+    return "procresult1"
+}
+
+proc traceproc2 { args } {
+    return "procresult2"
+}
+
+proc traceproc3 { args } {
+    return "procresult3"
+}
+
+test logger-trace-1.1 {
+    Test <service>::trace with no arguments.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace
+} -returnCodes 1 -result {wrong # args: should be "::logger::tree::tracetest::trace action args"}
+
+test logger-trace-1.2 {
+    Test <service>::trace with an unknown action
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace foo
+} -returnCodes 1 -result \
+    {Invalid action "foo": must be status, add, remove, on, or off}
+
+test logger-trace-on-1.1 {
+    Verify that tracing is disabled by default.
+} -body {
+    set l [::logger::init tracetest]
+    set ${l}::tracingEnabled
+} -result 0
+
+test logger-trace-on-1.2 {
+    Test <service>::trace on with extra arguments
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace on 1
+} -returnCodes 1 -result {wrong # args: should be "trace on"}
+
+test logger-trace-on-1.3 {
+    Test <service>::trace on with no extra arguments and verify that
+    the tracing state flag is enabled afterward.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace on
+    set ${l}::tracingEnabled
+} -cleanup {
+    ${l}::trace off
+} -result 1
+
+test logger-trace-on-1.4 {
+    Verify <service>::trace on enables tracing only for the one service
+    and not for any of its children.
+} -body {
+    set l1 [::logger::init tracetest]
+    set l2 [::logger::init tracetest::child]
+    ${l1}::trace on
+    set ${l2}::tracingEnabled
+} -cleanup {
+    ${l1}::trace off
+} -result 0
+
+test logger-trace-off-1.1 {
+    Test <service>::trace off with extra arguments
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace off 1
+} -returnCodes 1 -result {wrong # args: should be "trace off"}
+
+test logger-trace-off-1.2 {
+    Test <service>::trace off with no extra arguments and verify that
+    tracing state flag is disabled afterward.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace off
+    set ${l}::tracingEnabled
+} -result 0
+
+test logger-trace-off-1.3 {
+    Verify that <service>::trace on followed by off leaves tracing disabled.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace on
+    ${l}::trace off
+    set ${l}::tracingEnabled
+} -result 0
+
+test logger-trace-remove-1.1 {
+    Test <service>::trace remove with no targets specified.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace remove
+} -returnCodes 1 -result \
+    {wrong # args: should be "trace remove ?-ns? <proc> ..."}
+
+test logger-trace-remove-1.2 {
+    Test <service>::trace remove with procedure names that don't exist.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace remove nosuchproc1 nosuchproc2
+} -result {}
+
+test logger-trace-remove-1.3 {
+    Test <service>::trace remove with -ns switch and namespace names
+    that don't exist.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace remove -ns nosuchns
+} -result {}
+
+test logger-trace-remove-1.4 {
+    Verify that <service>::trace remove does glob pattern matching
+    on procedure names.
+} -body {
+    namespace eval ::tracetest {
+        proc foo1 {} {}
+        proc foo2 {} {}
+        proc bar1 {} {}
+        proc bar2 {} {}
+        proc bar3 {} {}
+    }
+    set l [::logger::init tracetest]
+    ${l}::trace add ::tracetest::bar1
+    ${l}::trace add ::tracetest::bar2
+    ${l}::trace add ::tracetest::bar3
+    ${l}::trace remove ::tracetest::bar*
+    ${l}::trace status
+} -cleanup {
+    namespace delete ::tracetest
+} -result {}
+
+test logger-trace-add-1.1 {
+    Test <service>::trace add with no targets specified.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace add
+} -returnCodes 1 -result \
+    {wrong # args: should be "trace add ?-ns? <proc> ..."}
+
+test logger-trace-add-1.2 {
+    Test <service>::trace add with procedure names that don't exist, and
+    verify that they are not listed in <service>::trace status.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace add nosuchproc1 nosuchproc2
+    ${l}::trace status
+} -cleanup {
+    ${l}::trace remove nosuchproc1 nosuchproc2
+} -result {}
+
+test logger-trace-add-1.3 {
+    Verify that <service>::trace add with the -ns switch followed by
+    <service>::trace remove with the -ns switch, both with the same
+    namespace, leaves no traces for the namespace remaining.
+} -body {
+    namespace eval ::tracetest {
+        proc test1 {} {}
+        proc test2 {} {}
+        proc test3 {} {}
+    }
+    set l [::logger::init tracetest]
+    ${l}::trace add -ns ::tracetest
+    ${l}::trace remove -ns ::tracetest
+    ${l}::trace status
+} -cleanup {
+    namespace delete ::tracetest
+} -result {}
+
+test logger-trace-add-1.4 {
+    Verify that <service>::trace add with the -ns switch registers
+    traces for all of the procedures in that namespace.
+} -body {
+    namespace eval ::tracetest {
+        proc test1 {} {}
+        proc test2 {} {}
+        proc test3 {} {}
+    }
+    set l [::logger::init tracetest]
+    ${l}::trace add -ns ::tracetest
+    lsort -dictionary [${l}::trace status]
+} -cleanup {
+    ${l}::trace remove -ns ::tracetest
+    namespace delete ::tracetest
+} -result {::tracetest::test1 ::tracetest::test2 ::tracetest::test3}
+
+test logger-trace-add-1.5 {
+    Verify that <service>::trace add does glob pattern matching
+    on procedure names.
+} -body {
+    namespace eval ::tracetest {
+        proc foo1 {} {}
+        proc foo2 {} {}
+        proc bar1 {} {}
+        proc bar2 {} {}
+        proc bar3 {} {}
+    }
+    set l [::logger::init tracetest]
+    ${l}::trace add ::tracetest::bar*
+    lsort -dictionary [${l}::trace status]
+} -cleanup {
+    ${l}::trace remove -ns ::tracetest
+    namespace delete ::tracetest
+} -result {::tracetest::bar1 ::tracetest::bar2 ::tracetest::bar3}
+
+test logger-trace-status-1.1 {
+    Verify that <service>::trace status with no argument returns an empty
+    list when no traces are currently active.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace status
+} -result {}
+
+test logger-trace-status-1.2 {
+    Verify that <service>::trace status returns 0 when given the name of a
+    procedure that is not currently being traced.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace status foo
+} -result 0
+
+test logger-trace-status-1.3 {
+    Verify that <service>::trace status returns 0 when given the name of a
+    procedure that was, but is no longer, being traced.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace add foo
+    ${l}::trace remove foo
+    ${l}::trace status foo
+} -result 0
+
+test logger-trace-status-1.4 {
+    Verify that <service>::trace status returns 0 when given the name of a
+    procedure that doesn't exist, but was passed to <service>::trace add.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace add nosuchproc
+    ${l}::trace status nosuchproc
+} -cleanup {
+    ${l}::trace remove nosuchproc
+} -result 0
+
+test logger-trace-status-1.5 {
+    Verify that <service>::trace status returns 1 when given the name of an
+    existing procedure that is currently registered via <service>::trace add.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace add traceproc1
+    ${l}::trace status traceproc1
+} -cleanup {
+    ${l}::trace remove traceproc1
+} -result 1
+
+test logger-trace-log-1.1 {
+    Verify that invoking a procedure that has been registered for tracing
+    via <service>::trace add does NOT generate a log message when tracing is
+    turned off.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace off       ;# Should already be off.  Just in case.
+    ${l}::trace add traceproc1
+    traceproc1
+} -cleanup {
+    ${l}::trace remove traceproc1
+} -result "procresult1" -output {}
+
+test logger-trace-log-1.2 {
+    Verify that invoking a procedure that has been registered for tracing
+    via <service>::trace add DOES generate a log message when tracing is
+    turned on BEFORE registration.
+
+    This test calls the traced function through another function, which
+    should result in a non-empty caller string.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace on
+    ${l}::trace add traceproc1
+    traceproc0
+} -cleanup {
+    ${l}::trace remove traceproc1
+    ${l}::trace off
+} -result "procresult1" -match regexp -output \
+{\[.*\] \[tracetest\] \[trace\] 'enter {proc ::traceproc1 level 2 script logger.test caller ::traceproc0 procargs {args {}}}'
+\[.*\] \[tracetest\] \[trace\] 'leave {proc ::traceproc1 level 2 script logger.test caller ::traceproc0 status ok result procresult1}'
+}
+
+test logger-trace-log-1.3 {
+    Verify that invoking a procedure that has been registered for tracing
+    via <service>::trace add DOES generate a log message when tracing is
+    turned on AFTER registration.
+
+    This test calls the traced function directly, which should result in
+    the caller being an empty string.
+} -body {
+    set l [::logger::init tracetest]
+    ${l}::trace add traceproc2
+    ${l}::trace on
+    traceproc2
+} -cleanup {
+    ${l}::trace remove traceproc2
+    ${l}::trace off
+} -result "procresult2" -match regexp -output \
+{\[.*\] \[tracetest\] \[trace\] 'enter {proc ::traceproc2 level 1 script logger.test caller {} procargs {args {}}}'
+\[.*\] \[tracetest\] \[trace\] 'leave {proc ::traceproc2 level 1 script logger.test caller {} status ok result procresult2}'
+}
+
+test logger-trace-logproc-1.1 {
+    Verify that a logproc can be specified for trace logging.
+} -body {
+    set l [::logger::init tracetest]
+    proc ::tracelog { message } {
+        puts $message
+    }
+    ${l}::logproc trace ::tracelog
+    ${l}::trace add traceproc2
+    ${l}::trace on
+    traceproc2
+} -cleanup {
+    ${l}::trace remove traceproc2
+    ${l}::trace off
+    rename ::tracelog {}
+} -result "procresult2" -output \
+{enter {proc ::traceproc2 level 1 script logger.test caller {} procargs {args {}}}
+leave {proc ::traceproc2 level 1 script logger.test caller {} status ok result procresult2}
+}
+
 ::tcltest::cleanupTests
-return
\ No newline at end of file
+return
