diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 29 | ||||
| -rw-r--r-- | tests/dict.test | 14 |
3 files changed, 36 insertions, 18 deletions
@@ -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 {} |