Tcl Library Source Code

A bug confirmed by Donal Fellows:
[https://stackoverflow.com/questions/50352363/tcloo-class-logger-mixin]

-----
Here is an extract of the upper communication:

Andrej:

Logger included with tcllib 1.19 breaks when used as class logger:

#!/usr/bin/env tclsh
package require logger
package require logger::utils
::oo::class create Main {
    variable log
    constructor {} {
        set this_inst [namespace current]
        set this_klaz [info object class $this_inst]
        set log [::logger::init $this_klaz]
        ::logger::utils::applyAppender \
        -appender "console" \
        -appenderArgs {-conversionPattern {%d \[%p\] \[%M\] %m}} \
        -serviceCmd $log
    }
    method invoke {} {
        ${log}::info "hello"
    }
}
set main [Main new]
$main invoke

Producing object namespace:

2018/05/15 08:54:43 [info] [::oo::Obj12] hello

Instead of class/method namespace:

2018/05/15 08:54:43 [info] [::Main::invoke] hello

Donal:

This is a bug in ::logger::utils::createLogProc in loggerUtils.tcl in that the %M substitution is not aware of TclOO. If it was, it wouldn't be using the name of the object that the method was invoked on, but rather the name of the method. (It appears that it was designed to work with [incr Tcl], which does name methods like you appear to want.)

...

That's actually because it looks up the value for %M substitution like this:

    if {[info level] < 2} {
        set method "global"
    } else {
        set method [lindex [info level -1] 0]
    }

whereas it probably ought to do something more like this:

    if {[info level] < 2} {
        set method "global"
    } elseif {[uplevel 1 {namespace which self}] == "::oo::Helpers::self"} {
        set method [uplevel 1 {string cat [self class] "::" [self method]}]
    } else {
        set method [lindex [info level -1] 0]
    }

Fix integrated with commit [4955240acf].

Here are some hints and thoughts, no help for implementation etc.

The work done for TIP490 "oo for msgcat" may be helpful here: http://core.tcl.tk/tips/doc/trunk/tip/490.md.

See the section "Implementation" of the TIP. It contains the following function to detect the oo-environment of the callers-caller:

proc ::msgcat::PackageNamespaceGet {} {
    uplevel 2 {
	# Check for no object
	switch -exact -- [namespace which self] {
	    {::oo::define::self} {
		# We are within a class definition
		return [namespace qualifiers [self]]
	    }
	    {::oo::Helpers::self} {
		# We are within an object
		set Class [info object class [self]]
		# Check for classless defined object
		if {$Class eq {::oo::object}} {
		    return [namespace qualifiers [self]]
		}
		# Class defined object
		return [namespace qualifiers $Class]
	    }
	    default {
		# Not in object environment
		return [namespace current]
	    }
	}
    }
}

This is for TCL8.7 and only tcloo. Additional work might be necessary for tcl 8.5-6 and IncrTCL.

Hope this may help for an implementation, Harald