Index: ChangeLog =================================================================== RCS file: /cvsroot/tcllib/tcllib/modules/snit/ChangeLog,v retrieving revision 1.2 diff -w -u -r1.2 ChangeLog --- ChangeLog 16 Jul 2003 17:20:42 -0000 1.2 +++ ChangeLog 18 Jul 2003 18:26:39 -0000 @@ -1,3 +1,15 @@ +2003-07-18 Andreas Kupries + + * snit.test: Fixed SF tcllib bug #772535. Instead of using a + * snit.tcl: variable reference in the callback a regular command + is called, with the unchanging 'selfns' as argument. + From there things go through the regular dispatching + mechanism after the actual instance name was obtained. + Updated all affected tests. + + Updated dmethod-1.5 also, 'string' delivers a + different error message. + 2003-07-16 Andreas Kupries * snit.man: Added references to bug trackers, as part of Index: snit.tcl =================================================================== RCS file: /cvsroot/tcllib/tcllib/modules/snit/snit.tcl,v retrieving revision 1.2 diff -w -u -r1.2 snit.tcl --- snit.tcl 16 Jul 2003 17:20:42 -0000 1.2 +++ snit.tcl 18 Jul 2003 18:26:39 -0000 @@ -578,7 +578,7 @@ # in the calling context. proc mymethod {args} { upvar selfns selfns - return $[concat ${selfns}::Snit_instance $args] + return [linsert $args 0 ::snit::CallInstance ${selfns}] } @@ -1552,4 +1552,9 @@ } else { return 0 } +} + +proc ::snit::CallInstance {selfns args} { + upvar ${selfns}::Snit_instance self + return [uplevel 1 [linsert $args 0 $self]] } Index: snit.test =================================================================== RCS file: /cvsroot/tcllib/tcllib/modules/snit/snit.test,v retrieving revision 1.1 diff -w -u -r1.1 snit.test --- snit.test 15 Jul 2003 23:50:17 -0000 1.1 +++ snit.test 18 Jul 2003 18:26:39 -0000 @@ -99,6 +99,8 @@ cleanupType ::cat cleanupType ::mylabel cleanupType ::myframe + cleanupType ::foo + cleanupType ::bar } @@ -557,7 +559,7 @@ dog fido fido mymethod -} {{$::dog::Snit_inst1::Snit_instance} {$::dog::Snit_inst1::Snit_instance {A B}} {$::dog::Snit_inst1::Snit_instance A B}} +} {{::snit::CallInstance ::dog::Snit_inst1} {::snit::CallInstance ::dog::Snit_inst1 {A B}} {::snit::CallInstance ::dog::Snit_inst1 A B}} test rename-1.2 {instances can be renamed.} {} { cleanup @@ -574,7 +576,7 @@ set b [spot names] concat $a $b -} {{$::dog::Snit_inst1::Snit_instance} ::dog::Snit_inst1 ::fido ::fido {$::dog::Snit_inst1::Snit_instance} ::dog::Snit_inst1 ::fido ::spot} +} {{::snit::CallInstance ::dog::Snit_inst1} ::dog::Snit_inst1 ::fido ::fido {::snit::CallInstance ::dog::Snit_inst1} ::dog::Snit_inst1 ::fido ::spot} test rename-1.3 {rename to "" deletes an instance.} {} { cleanup @@ -613,6 +615,43 @@ } {::dog::Snit_inst1 ::dog::Snit_inst2 {}} #----------------------------------------------------------------------- +# mymethod actually works + +test mymethod-1.1 {run mymethod handler} { + cleanup + + type foo { + option -command {} + method runcmd {} { + eval [linsert $options(-command) end $self snarf] + return + } + } + type bar { + variable sub + constructor {args} { + set sub [foo fubar -command [mymethod Handler]] + return + } + + method Handler {args} { + set ::RES $args + } + + method test {} { + $sub runcmd + return + } + } + + set ::RES {} + bar boogle + boogle test + set ::RES +} {::bar::fubar snarf} + + +#----------------------------------------------------------------------- # typevariable test typevariable-1.1 {typevarname qualifies typevariables} {} { @@ -1564,7 +1603,9 @@ set result "" catch {spot foo bar} result set result -} {'::spot foo' is not defined.} +} {bad option "foo": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart} + +# {'::spot foo' is not defined.} test dmethod-1.6 {can't delegate local method: order 1} { cleanup