diff options
author | dkf <dkf@noemail.net> | 2014-09-05 10:05:05 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2014-09-05 10:05:05 (GMT) |
commit | ebc62d49bd8a2512a8cbd12fdf6d9d93d2bf32ed (patch) | |
tree | d3d1489190638b77c85006dc0c420c7e10d397e1 /generic | |
parent | a19677ee3b4dcff933e99c75126c2b9354462f2f (diff) | |
download | tcl-ebc62d49bd8a2512a8cbd12fdf6d9d93d2bf32ed.zip tcl-ebc62d49bd8a2512a8cbd12fdf6d9d93d2bf32ed.tar.gz tcl-ebc62d49bd8a2512a8cbd12fdf6d9d93d2bf32ed.tar.bz2 |
[ccc2c2cc98]: lreplace edge case
FossilOrigin-Name: c20208530fb098174717ee1e2fdc2bd786c60374
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclCompCmdsGR.c | 14 |
1 files changed, 13 insertions, 1 deletions
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 166fea0..64dcaa6 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -1480,7 +1480,7 @@ TclCompileLreplaceCmd( Tcl_Token *tokenPtr, *listTokenPtr; DefineLineInformation; /* TIP #280 */ Tcl_Obj *tmpObj; - int idx1, idx2, i, offset; + int idx1, idx2, i, offset, offset2; if (parsePtr->numWords < 4) { return TCL_ERROR; @@ -1586,12 +1586,18 @@ TclCompileLreplaceCmd( TclEmitOpcode( INST_GT, envPtr); offset = CurrentOffset(envPtr); TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr); + TclEmitOpcode( INST_DUP, envPtr); + TclEmitOpcode( INST_LIST_LENGTH, envPtr); + offset2 = CurrentOffset(envPtr); + TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr); TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf( "list doesn't contain element %d", idx1), NULL), envPtr); CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0, Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}")); TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset, envPtr->codeStart + offset + 1); + TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2, + envPtr->codeStart + offset2 + 1); TclAdjustStackDepth(-1, envPtr); } TclEmitOpcode( INST_DUP, envPtr); @@ -1636,12 +1642,18 @@ TclCompileLreplaceCmd( TclEmitOpcode( INST_GT, envPtr); offset = CurrentOffset(envPtr); TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr); + TclEmitOpcode( INST_DUP, envPtr); + TclEmitOpcode( INST_LIST_LENGTH, envPtr); + offset2 = CurrentOffset(envPtr); + TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr); TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf( "list doesn't contain element %d", idx1), NULL), envPtr); CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0, Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}")); TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset, envPtr->codeStart + offset + 1); + TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2, + envPtr->codeStart + offset2 + 1); TclAdjustStackDepth(-1, envPtr); } TclEmitOpcode( INST_DUP, envPtr); |