summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2005-12-18 22:42:14 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2005-12-18 22:42:14 (GMT)
commit9e980b0bde0e1bd6f6c549832502dcf9b5f6b623 (patch)
tree3aac20695f552a296f60f9a1ae5948f95ad97afe
parent6947dd1dec4d0417fddeeefed65c0ae6008bcf48 (diff)
downloadtcl-9e980b0bde0e1bd6f6c549832502dcf9b5f6b623.zip
tcl-9e980b0bde0e1bd6f6c549832502dcf9b5f6b623.tar.gz
tcl-9e980b0bde0e1bd6f6c549832502dcf9b5f6b623.tar.bz2
Fix [Bug 1382528]; thanks to Anton Kovalenko for finding this.
-rw-r--r--ChangeLog11
-rw-r--r--generic/tclCompCmds.c29
-rw-r--r--tests/dict.test14
3 files changed, 36 insertions, 18 deletions
diff --git a/ChangeLog b/ChangeLog
index 64e460a..d1052e9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,6 +1,13 @@
+2005-12-18 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclCompCmds.c (TclCompileDictCmd): Ensure that we only do an
+ 'endCatch' when there's a preceding 'beginCatch'. [Bug 1382528] Many
+ thanks to Anton Kovalenko for finding this and pointing out that it
+ was a catch stack handling problem!
+
2005-12-14 Daniel Steffen <das@users.sourceforge.net>
- * generic/tclIOUtil.c: workaround gcc warning "comparison is always
+ * generic/tclIOUtil.c: workaround gcc warning "comparison is always
* generic/tclTest.c: false due to limited range of data type".
* macosx/Tcl.xcode/project.pbxproj:
@@ -46,7 +53,7 @@
* win/tclWinFile.c:
* win/tclWinReg.c:
* win/tclWinSock.c:
-
+
2005-12-13 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
* generic/tclExecute.c (TEBC:DICT_FIRST,DICT_DONE): Only decrease the
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 2c63d5b..e62ab03 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompCmds.c,v 1.82 2005/11/30 14:59:40 dkf Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.83 2005/12/18 22:42:18 dkf Exp $
*/
#include "tclInt.h"
@@ -669,7 +669,7 @@ TclCompileDictCmd(
} else if (size==3 && strncmp(cmd, "for", 3)==0) {
Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr;
int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
- int infoIndex, jumpDisplacement, bodyTargetOffset, doneTargetOffset;
+ int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset;
int endTargetOffset;
const char **argv;
Tcl_DString buffer;
@@ -740,7 +740,7 @@ TclCompileDictCmd(
CompileWord(envPtr, dictTokenPtr, interp);
TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr);
- doneTargetOffset = CurrentOffset(envPtr);
+ emptyTargetOffset = CurrentOffset(envPtr);
TclEmitInstInt4( INST_JUMP_TRUE4, 0, envPtr);
/*
@@ -795,16 +795,6 @@ TclCompileDictCmd(
TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr);
jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement, envPtr);
-
- /*
- * Otherwise we're done (the jump after the DICT_FIRST points here)
- * and we need to pop the bogus key/value pair (pushed to keep stack
- * calculations easy!)
- */
-
- jumpDisplacement = CurrentOffset(envPtr) - doneTargetOffset;
- TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
- envPtr->codeStart + doneTargetOffset);
TclEmitOpcode( INST_POP, envPtr);
TclEmitOpcode( INST_POP, envPtr);
@@ -836,6 +826,19 @@ TclCompileDictCmd(
TclEmitOpcode( INST_RETURN_STK, envPtr);
/*
+ * Otherwise we're done (the jump after the DICT_FIRST points here)
+ * and we need to pop the bogus key/value pair (pushed to keep stack
+ * calculations easy!) Note that we skip the END_CATCH. [Bug 1382528]
+ */
+
+ jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset;
+ TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
+ envPtr->codeStart + emptyTargetOffset);
+ TclEmitOpcode( INST_POP, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ TclEmitInstInt4( INST_DICT_DONE, infoIndex, envPtr);
+
+ /*
* Final stage of the command (normal case) is that we push an empty
* object. This is done last to promote peephole optimization when
* it's dropped immediately.
diff --git a/tests/dict.test b/tests/dict.test
index 722ba23..1f8e310 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: dict.test,v 1.16 2005/12/13 13:46:15 dkf Exp $
+# RCS: @(#) $Id: dict.test,v 1.17 2005/12/18 22:42:18 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -551,8 +551,16 @@ test dict-14.17 {dict for command in compilation context} {
}
dicttest
} {a 0}
-# There's probably a lot more tests to add here. Really ought to use
-# a coverage tool for this job...
+test dict-14.17 {dict for command in compilation context} {
+ # Bug 1382528
+ proc dicttest {} {
+ dict for {k v} {} {} ;# Note empty dict
+ catch { error foo } ;# Note compiled [catch]
+ }
+ dicttest
+} 1
+# There's probably a lot more tests to add here. Really ought to use a
+# coverage tool for this job...
test dict-15.1 {dict set command} {
set dictVar {}