Overview
| Artifact ID: | d5cfd7887af67dd05d518d3c14ced1086a2a4a06 |
|---|---|
| Ticket: | 772535ffffffffffffffffffffffffffffffffff |
| Date: | 2003-07-19 01:45:25 |
| User: | andreas_kupries |
| Artifact Attached: | 77c3329ff0f5569b519fb959c4ac37022c9495af |
| Filename: | diff.snit.txt |
| Description: | Fix, v0 |
Content:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138Index: 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 <[email protected]> + + * 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 <[email protected]> * 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
