Tk Library Source Code

Attachment Details
Login
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
   138
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