summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2014-09-05 10:05:05 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2014-09-05 10:05:05 (GMT)
commit0b7aa99ede7838e4390b0c14bcda9485a08d0cf4 (patch)
treea13d527efc04cfe17dce8b8bfb99d04f2d0bad4d /generic
parent1ce040baf210e345e2c8f8a19fe7b8d821274c4b (diff)
downloadtcl-0b7aa99ede7838e4390b0c14bcda9485a08d0cf4.zip
tcl-0b7aa99ede7838e4390b0c14bcda9485a08d0cf4.tar.gz
tcl-0b7aa99ede7838e4390b0c14bcda9485a08d0cf4.tar.bz2
[ccc2c2cc98]: lreplace edge case
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCompCmdsGR.c14
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);