Tcl Source Code

Artifact 4faddda562d6a7cb9cabe1b2df1296a86d33282f:

Attachment "test.tcl" to ticket [3603695fff] added by taylor_venable 2013-02-07 19:04:40.

---

#!/usr/bin/env tclsh

package require Tcl 8.6
package require TclOO 1.0

oo::class create test1 {
    variable x
    export varname
    constructor {arg} { set x $arg }
    method foo {other} {
        puts ""
        puts "(foo) \{[self]\} -> \{[my varname x]\} -> [set [my varname x]]"
        puts "(foo) \{$other\} -> \{[$other varname x]\} -> [set [$other varname x]]" ;# INCORRECT
        puts "(foo) \{$other\} -> \{[uplevel #0 $other varname x]\} -> [set [uplevel #0 $other varname x]]" ;# CORRECT
    }
}

oo::class create test2 {
    variable x
    export varname
    constructor {arg} { set x $arg }
}

set a [test1 new a]
set b [test1 new b]
set c [test2 new c]

puts "      \{$a\} -> \{[$a varname x]\} -> [set [$a varname x]]"
puts "      \{$b\} -> \{[$b varname x]\} -> [set [$b varname x]]" ;# CORRECT
puts "      \{$c\} -> \{[$c varname x]\} -> [set [$c varname x]]" ;# CORRECT

$a foo $b
$a foo $c

################################################################################
## OUTPUT                                                                     ##
################################################################################
#
#       {::oo::Obj13} -> {::oo::Obj13::x} -> a
#       {::oo::Obj14} -> {::oo::Obj14::x} -> b  CORRECT
#       {::oo::Obj15} -> {::oo::Obj15::x} -> c  CORRECT
#
# (foo) {::oo::Obj13} -> {::oo::Obj13::x} -> a
# (foo) {::oo::Obj14} -> {::oo::Obj13::x} -> a  INCORRECT
# (foo) {::oo::Obj14} -> {::oo::Obj14::x} -> b  CORRECT
#
# (foo) {::oo::Obj13} -> {::oo::Obj13::x} -> a
# (foo) {::oo::Obj15} -> {::oo::Obj13::x} -> a  INCORRECT
# (foo) {::oo::Obj15} -> {::oo::Obj15::x} -> c  CORRECT