Tk Library Source Code

Artifact 77c3329ff0f5569b519fb959c4ac37022c9495af:

Attachment "diff.snit.txt" to ticket [772535ffff] added by andreas_kupries 2003-07-19 01:45:25.

---

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  <[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