Attachment "530056.diff" to
ticket [530056ffff]
added by
andreas_kupries
2002-03-15 05:49:58.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/ChangeLog,v
retrieving revision 1.122
diff -u -r1.122 ChangeLog
--- ChangeLog 13 Mar 2002 22:38:57 -0000 1.122
+++ ChangeLog 14 Mar 2002 21:44:02 -0000
@@ -1,3 +1,7 @@
+2002-03-14 Andreas Kupries <[email protected]>
+
+ * textutil (expander): Fixed SF Bug #530056.
+
2002-03-13 Andreas Kupries <[email protected]>
* doctools: Fixed bug #528390.
Index: modules/textutil/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/textutil/ChangeLog,v
retrieving revision 1.21
diff -u -r1.21 ChangeLog
--- modules/textutil/ChangeLog 26 Feb 2002 23:31:09 -0000 1.21
+++ modules/textutil/ChangeLog 14 Mar 2002 21:44:02 -0000
@@ -1,9 +1,16 @@
+2002-03-14 Andreas Kupries <[email protected]>
+
+ * expander.tcl (Op_expand): Fix for SF Bug #530056. Added code
+ checking start and end levels for pushed/popped contexts and
+ alert the caller if the numbers do not match, indicating that
+ the macros pushed more or less contexts than popped.
+
2002-02-26 Joe English <[email protected]
* tabify.tcl, tabify.test: fix for #521590,
[tabify2 ""] and [untabify2 ""] raised an error.
-2002-02-14 Tcl Project <[email protected]>
+2002-02-14 Tcl Project <[email protected]>
* expander.tcl: Frink run.
Index: modules/textutil/expander.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/textutil/expander.tcl,v
retrieving revision 1.4
diff -u -r1.4 expander.tcl
--- modules/textutil/expander.tcl 15 Feb 2002 05:35:30 -0000 1.4
+++ modules/textutil/expander.tcl 14 Mar 2002 21:44:02 -0000
@@ -517,9 +517,8 @@
proc ::textutil::expander::Op_cget {name varname} {
if {![info exists [Var data-[Get level]-$varname]]} {
- error "$name cget: $varname doesn't exist in this context"
+ error "$name cget: $varname doesn't exist in this context ([Get level])"
}
-
return [Get data-[Get level]-$varname]
}
@@ -581,7 +580,6 @@
# FRINK: nocheck
incr [Var level] -1
-
return $result
}
@@ -626,12 +624,17 @@
# brackets are used.
proc ::textutil::expander::Op_expand {name inputString {brackets ""}} {
+
# FIRST, push a new context onto the stack, and save the current
# brackets.
+
Op_cpush $name expand
Op_cset $name lb [Get lb]
Op_cset $name rb [Get rb]
+ # SF Tcllib Bug #530056.
+ set start_level [Get level] ; # remember this for check at end
+
# NEXT, use the user's brackets, if given.
if {[llength $brackets] == 2} {
Set lb [lindex $brackets 0]
@@ -675,7 +678,39 @@
HandleError $name macro $macro $result
}
-
+
+ # SF Tcllib Bug #530056.
+ if {[Get level] > $start_level} {
+ # The user macros pushed additional contexts, but forgot to
+ # pop them all. The main work here is to place all the still
+ # open contexts into the error message, and to produce
+ # syntactically correct english.
+
+ set c [list]
+ set n [expr {[Get level] - $start_level}]
+ if {$n == 1} {
+ set ctx context
+ set verb was
+ } else {
+ set ctx contexts
+ set verb were
+ }
+ for {incr n -1} {$n >= 0} {incr n -1} {
+ lappend c [Get name-[expr {[Get level]-$n}]]
+ }
+ return -code error \
+ "The following $ctx pushed by the macros $verb not popped: [join $c ,]."
+ } elseif {[Get level] < $start_level} {
+ set n [expr {$start_level - [Get level]}]
+ if {$n == 1} {
+ set ctx context
+ } else {
+ set ctx contexts
+ }
+ return -code error \
+ "The macros popped $n more $ctx than they had pushed."
+ }
+
Op_lb $name [Op_cget $name lb]
Op_rb $name [Op_cget $name rb]
Index: modules/textutil/expander.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/textutil/expander.test,v
retrieving revision 1.4
diff -u -r1.4 expander.test
--- modules/textutil/expander.test 14 Dec 2001 04:58:18 -0000 1.4
+++ modules/textutil/expander.test 14 Mar 2002 21:44:02 -0000
@@ -116,7 +116,7 @@
exp cpush FOO
catch {exp cget BAR} result
set result
-} {::exp cget: BAR doesn't exist in this context}
+} {::exp cget: BAR doesn't exist in this context (1)}
test expander-2.6 {cpop mismatch} {} {
catch {::textutil::expander exp}
