[Xotcl] Problem with slots and moving objects

[Stefan Sobernig]

Neil,

Interesting catch (though hairy)!

> I am having a problem/have found a bug with slots created with an
> -initcmd.
> If I set a value on an object containing a slot with an initcmd and then
> move it an error gets thrown every time I read the value.

The reason for this erratic behaviour is that the move (as well as the 
copy) operation does NOT handle the transfer of variable traces properly.
Some background: The ::xotcl::Attribute infrastructure uses Tcl variable 
traces to indirect operations (/obj/ set ...) on object variables to 
their respective attribute slot objects. When moving an object (x), 
these traces are supposed to migrate to the new or target object (y).

This migration action, however, is currently (1.6.6) broken:

a) the variable trace commands carry the name of the source object 
(::x). for now, the occurrences of the source object's name in the 
command statement are not replaced by the target object's name. hence, 
the error:

> can't read "a": invalid command name "::x"

(as it should by "::y" after the move!)

b) investigating this issue, I found that the migration action of var 
traces leads to an unwanted accumulation of trace definitions on the 
respective target objects (e.g., two initcmd scripts being eval'ed on 
::y, rather than one!).

i came up with a fix against 1.6.6. as i am not sure whether it will 
make it into a patch release in this shape (and assuming that you cannot 
upgrade to such a patch release), i refactored the patch into something 
ready-made. I tested it with initcmd, valuecmd, and valuechangecmd. 
there might be a more straight-forward approach for your deployment 
scenario, however, this one hasn't crossed my mind yet.

namespace eval ::xotcl::unsupported {
   namespace import ::xotcl::*

   Class create Copyable \
       -instproc clear_variable_traces {obj var op trace_cmd {max 1}} {
	set traces [$obj trace info variable $var]
	set occurrences [llength [lsearch -all -exact $traces [list $op 
$trace_cmd]]]
	while {$occurrences > $max} {
	  $obj trace remove variable $var $op $trace_cmd
	  incr occurrences -1
	}
       } -instproc __default_from_cmd {obj cmd var sub op} {
	set trace_cmd [list [self] [self proc] $obj $cmd]
	my clear_variable_traces $obj $var $op $trace_cmd 0
	next
       } -instproc __value_from_cmd {obj cmd var sub op} {
	set trace_cmd [list [self] [self proc] $obj $cmd]
	my clear_variable_traces $obj $var $op $trace_cmd
	next
       } -instproc __value_changed_cmd {obj cmd var sub op} {
	set trace_cmd [list [self] [self proc] $obj $cmd]
	my clear_variable_traces $obj $var $op $trace_cmd
	next
       }

   ::xotcl::Attribute instmixin add Copyable

   Class create FixedCopyHandler -instproc copyTargets {} {
     next
     foreach origin [my set targetList] {
       set dest [my getDest $origin]
       foreach var [$dest info vars] {
	set cmds [$dest trace info variable $var]
	foreach cmd $cmds {
	  foreach {op def} $cmd break
	  $dest trace remove variable $var $op $def
	  foreach idx [lsearch -exact -all $def $origin] {
	    lset def $idx $dest
	  }
	  $dest trace add variable $var $op $def
	}
       }
     }
   }

   ::xotcl::Object::CopyHandler instmixin add FixedCopyHandler
}


hope it helps,
//stefan