More test cases. More fixes.

1 files changed, 20 insertions, 4 deletions

diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h
index 22f5e56..6dd105e 100644
--- a/generic/tclOOScript.h
+++ b/generic/tclOOScript.h
@@ -33,8 +33,15 @@ static const char *tclOOSetupScript =
 "    # Get a reference to the class's namespace\n"
 "    set ns [info object namespace [uplevel 1 {self class}]]\n"
 "    # Double up the list of variable names\n"
-"    set vs [list $name $name]\n"
-"    foreach v $args {lappend vs $v $v}\n"
+"    foreach v [list $name {*}$args] {\n"
+"        if {[string match *(*) $v]} {\n"
+"            return -code error [string cat {bad variable name \"} $v {\": can\'t create a scalar variable that looks like an array element}]\n"
+"        }\n"
+"        if {[string match *::* $v]} {\n"
+"            return -code error [string cat {bad variable name \"} $v {\": can\'t create a local variable with a namespace separator in it}]\n"
+"        }\n"
+"        lappend vs $v $v\n"
+"    }\n"
 "    # Lastly, link the caller's local variables to the class's variables\n"
 "    tailcall namespace upvar $ns {*}$vs\n"
 "}\n"
@@ -48,12 +55,21 @@ static const char *tclOOSetupScript =
 "            lassign $link src\n"
 "            set dst $src\n"
 "        }\n"
-"        interp alias {} ${ns}::$src {} ${ns}::my $dst\n"
+"        if {![string match ::* $src]} {\n"
+"            set src [string cat $ns :: $src]\n"
+"        }\n"
+"        interp alias {} $src {} ${ns}::my $dst\n"
+"        trace add command ${ns}::my delete [list ::oo::Helpers::Unlink $src]\n"
 "    }\n"
 "    return\n"
 "}\n"
+"::proc ::oo::Helpers::Unlink {cmd args} {\n"
+"    if {[namespace which $cmd] ne {}} {\n"
+"        rename $cmd {}\n"
+"    }\n"
+"}\n"
 
-"proc ::oo::DelegateName {class} {\n"
+"::proc ::oo::DelegateName {class} {\n"
 "    string cat [info object namespace $class] {:: oo ::delegate}\n"
 "}\n"