diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2016-03-30 08:46:43 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2016-03-30 08:46:43 (GMT) |
| commit | dedc1d86a28c562377215bc2d0bf10e75ed00f1d (patch) | |
| tree | 467dbf26f505d4f42a10c904b24b552022631320 /generic | |
| parent | e586c259bcbae989eca56b696377488dfe656b20 (diff) | |
| download | tcl-dedc1d86a28c562377215bc2d0bf10e75ed00f1d.zip tcl-dedc1d86a28c562377215bc2d0bf10e75ed00f1d.tar.gz tcl-dedc1d86a28c562377215bc2d0bf10e75ed00f1d.tar.bz2 | |
[47ac84309b] Import of aspect's branch from his personal repository on chiselapp.aspect_lreplace_cleanup
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclCmdIL.c | 2 | ||||
| -rw-r--r-- | generic/tclCompCmdsGR.c | 47 |
2 files changed, 41 insertions, 8 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 739dca9..0d35397 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2755,7 +2755,7 @@ Tcl_LreplaceObjCmd( * (to allow for replacing the last elem). */ - if ((first >= listLen) && (listLen > 0)) { + if ((first > listLen) && (listLen > 0)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "list doesn't contain element %s", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX", diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 9f430ea..ffe39ba 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -1489,6 +1489,15 @@ TclCompileLreplaceCmd( } /* + * idx1, idx2 are now in canonical form: + * + * - integer: [0,len+1] + * - end index: INDEX_END + * - -ive offset: INDEX_END-[len-1,0] + * - +ive offset: INDEX_END+1 + */ + + /* * Compilation fails when one index is end-based but the other isn't. * Fixing this will require more bytecodes, but this is a workaround for * now. [Bug 47ac84309b] @@ -1521,6 +1530,9 @@ TclCompileLreplaceCmd( idx1 = 0; goto dropEnd; } else { + if (idx2 < idx1) { + idx2 = idx1 - 1; + } if (idx1 > 0) { tmpObj = Tcl_NewIntObj(idx1); Tcl_IncrRefCount(tmpObj); @@ -1548,9 +1560,7 @@ TclCompileLreplaceCmd( idx1 = 0; goto replaceTail; } else { - if (idx1 > 0 && idx2 > 0 && idx2 < idx1) { - idx2 = idx1 - 1; - } else if (idx1 < 0 && idx2 < 0 && idx2 < idx1) { + if (idx2 < idx1) { idx2 = idx1 - 1; } if (idx1 > 0) { @@ -1566,7 +1576,7 @@ TclCompileLreplaceCmd( * operate on. */ - dropAll: + dropAll: /* This just ensures the arg is a list. */ TclEmitOpcode( INST_LIST_LENGTH, envPtr); TclEmitOpcode( INST_POP, envPtr); PushStringLiteral(envPtr, ""); @@ -1579,12 +1589,21 @@ TclCompileLreplaceCmd( dropRange: if (tmpObj != NULL) { + /* + * Emit bytecode to check the list length. + */ + TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_LIST_LENGTH, envPtr); TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr); - TclEmitOpcode( INST_GT, envPtr); + TclEmitOpcode( INST_GE, envPtr); offset = CurrentOffset(envPtr); TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr); + + /* + * Emit an error if we've been given an empty list. + */ + TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_LIST_LENGTH, envPtr); offset2 = CurrentOffset(envPtr); @@ -1635,16 +1654,30 @@ TclCompileLreplaceCmd( replaceRange: if (tmpObj != NULL) { + /* + * Emit bytecode to check the list length. + */ + TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_LIST_LENGTH, envPtr); + + /* + * Check the list length vs idx1. + */ + TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr); - TclEmitOpcode( INST_GT, envPtr); + TclEmitOpcode( INST_GE, envPtr); offset = CurrentOffset(envPtr); TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr); + + /* + * Emit an error if we've been given an empty list. + */ + TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_LIST_LENGTH, envPtr); offset2 = CurrentOffset(envPtr); - TclEmitInstInt1( INST_JUMP_TRUE1, 0, 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, |