diff options
Diffstat (limited to 'generic/tclVar.c')
| -rw-r--r-- | generic/tclVar.c | 227 |
1 files changed, 145 insertions, 82 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c index dcaf2c8..4f31613 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.31 2001/04/27 22:11:51 kennykb Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.32 2001/05/17 02:13:03 hobbs Exp $ */ #include "tclInt.h" @@ -665,7 +665,7 @@ Tcl_GetVar2Ex(interp, part1, part2, flags) * given by localIndex. If the specified variable doesn't exist, or * there is a clash in array usage, or an error occurs while executing * variable traces, then NULL is returned and a message will be left in - * the interpreter's result if leaveErrorMsg is 1. + * the interpreter's result if TCL_LEAVE_ERR_MSG is set in flags. * * Side effects: * The ref count for the returned object is _not_ incremented to @@ -676,13 +676,13 @@ Tcl_GetVar2Ex(interp, part1, part2, flags) */ Tcl_Obj * -TclGetIndexedScalar(interp, localIndex, leaveErrorMsg) +TclGetIndexedScalar(interp, localIndex, flags) Tcl_Interp *interp; /* Command interpreter in which variable is * to be looked up. */ register int localIndex; /* Index of variable in procedure's array * of local variables. */ - int leaveErrorMsg; /* 1 if to leave an error message in - * interpreter's result on an error. + int flags; /* TCL_LEAVE_ERR_MSG if to leave an error + * message in interpreter's result on an error. * Otherwise no error message is left. */ { Interp *iPtr = (Interp *) interp; @@ -736,7 +736,7 @@ TclGetIndexedScalar(interp, localIndex, leaveErrorMsg) msg = CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, NULL, TCL_TRACE_READS); if (msg != NULL) { - if (leaveErrorMsg) { + if (flags & TCL_LEAVE_ERR_MSG) { VarErrMsg(interp, varName, NULL, "read", msg); } return NULL; @@ -749,7 +749,7 @@ TclGetIndexedScalar(interp, localIndex, leaveErrorMsg) */ if (!TclIsVarScalar(varPtr) || TclIsVarUndefined(varPtr)) { - if (leaveErrorMsg) { + if (flags & TCL_LEAVE_ERR_MSG) { if (TclIsVarArray(varPtr)) { msg = isArray; } else { @@ -778,7 +778,7 @@ TclGetIndexedScalar(interp, localIndex, leaveErrorMsg) * element. If the specified array or element doesn't exist, or there * is a clash in array usage, or an error occurs while executing * variable traces, then NULL is returned and a message will be left in - * the interpreter's result if leaveErrorMsg is 1. + * the interpreter's result if TCL_LEAVE_ERR_MSG is set in flags. * * Side effects: * The ref count for the returned object is _not_ incremented to @@ -789,15 +789,15 @@ TclGetIndexedScalar(interp, localIndex, leaveErrorMsg) */ Tcl_Obj * -TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg) +TclGetElementOfIndexedArray(interp, localIndex, elemPtr, flags) Tcl_Interp *interp; /* Command interpreter in which variable is * to be looked up. */ int localIndex; /* Index of array variable in procedure's * array of local variables. */ Tcl_Obj *elemPtr; /* Points to an object holding the name of * an element to get in the array. */ - int leaveErrorMsg; /* 1 if to leave an error message in - * the interpreter's result on an error. + int flags; /* TCL_LEAVE_ERR_MSG if to leave an error + * message in interpreter's result on an error. * Otherwise no error message is left. */ { Interp *iPtr = (Interp *) interp; @@ -856,7 +856,7 @@ TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg) */ if (!TclIsVarArray(arrayPtr) || TclIsVarUndefined(arrayPtr)) { - if (leaveErrorMsg) { + if (flags & TCL_LEAVE_ERR_MSG) { VarErrMsg(interp, arrayName, elem, "read", noSuchVar); } goto errorReturn; @@ -894,7 +894,7 @@ TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg) msg = CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem, TCL_TRACE_READS); if (msg != NULL) { - if (leaveErrorMsg) { + if (flags & TCL_LEAVE_ERR_MSG) { VarErrMsg(interp, arrayName, elem, "read", msg); } goto errorReturn; @@ -909,7 +909,7 @@ TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg) return varPtr->value.objPtr; } - if (leaveErrorMsg) { + if (flags & TCL_LEAVE_ERR_MSG) { if (TclIsVarArray(varPtr)) { msg = isArray; } else { @@ -1190,8 +1190,7 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags) Var *arrayPtr; Tcl_Obj *oldValuePtr; Tcl_Obj *resultPtr = NULL; - char *bytes; - int length, result; + int result; varPtr = TclLookupVar(interp, part1, part2, flags, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); @@ -1272,10 +1271,9 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags) * We append newValuePtr's bytes but don't change its ref count. */ - bytes = Tcl_GetStringFromObj(newValuePtr, &length); if (oldValuePtr == NULL) { - varPtr->value.objPtr = Tcl_NewStringObj(bytes, length); - Tcl_IncrRefCount(varPtr->value.objPtr); + varPtr->value.objPtr = newValuePtr; + Tcl_IncrRefCount(newValuePtr); } else { if (Tcl_IsShared(oldValuePtr)) { /* append to copy */ varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr); @@ -1286,34 +1284,16 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags) Tcl_AppendObjToObj(oldValuePtr, newValuePtr); } } - } else { - if (flags & TCL_LIST_ELEMENT) { /* set var to list element */ - int neededBytes, listFlags; - - /* - * We set the variable to the result of converting newValuePtr's - * string rep to a list element. We do not change newValuePtr's - * ref count. - */ + } else if (newValuePtr != oldValuePtr) { + /* + * In this case we are replacing the value, so we don't need to + * do more than swap the objects. + */ - if (oldValuePtr != NULL) { - Tcl_DecrRefCount(oldValuePtr); /* discard old value */ - } - bytes = Tcl_GetStringFromObj(newValuePtr, &length); - neededBytes = Tcl_ScanElement(bytes, &listFlags); - oldValuePtr = Tcl_NewObj(); - oldValuePtr->bytes = (char *) - ckalloc((unsigned) (neededBytes + 1)); - oldValuePtr->length = Tcl_ConvertElement(bytes, - oldValuePtr->bytes, listFlags); - varPtr->value.objPtr = oldValuePtr; - Tcl_IncrRefCount(varPtr->value.objPtr); - } else if (newValuePtr != oldValuePtr) { - varPtr->value.objPtr = newValuePtr; - Tcl_IncrRefCount(newValuePtr); /* var is another ref */ - if (oldValuePtr != NULL) { - TclDecrRefCount(oldValuePtr); /* discard old value */ - } + varPtr->value.objPtr = newValuePtr; + Tcl_IncrRefCount(newValuePtr); /* var is another ref */ + if (oldValuePtr != NULL) { + TclDecrRefCount(oldValuePtr); /* discard old value */ } } TclSetVarScalar(varPtr); @@ -1381,8 +1361,8 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags) * variable given by localIndex. If the specified variable doesn't * exist, or there is a clash in array usage, or an error occurs while * executing variable traces, then NULL is returned and a message will - * be left in the interpreter's result if leaveErrorMsg is 1. Note - * that the returned object may not be the same one referenced by + * be left in the interpreter's result if flags has TCL_LEAVE_ERR_MSG. + * Note that the returned object may not be the same one referenced by * newValuePtr; this is because variable traces may modify the * variable's value. * @@ -1401,15 +1381,15 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags) */ Tcl_Obj * -TclSetIndexedScalar(interp, localIndex, newValuePtr, leaveErrorMsg) +TclSetIndexedScalar(interp, localIndex, newValuePtr, flags) Tcl_Interp *interp; /* Command interpreter in which variable is * to be found. */ int localIndex; /* Index of variable in procedure's array * of local variables. */ Tcl_Obj *newValuePtr; /* New value for variable. */ - int leaveErrorMsg; /* 1 if to leave an error message in - * the interpreter's result on an error. - * Otherwise no error message is left. */ + int flags; /* Various flags that tell how to set value: + * any of TCL_APPEND_VALUE, + * TCL_LIST_ELEMENT or TCL_LEAVE_ERR_MSG. */ { Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; @@ -1465,7 +1445,7 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, leaveErrorMsg) */ if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) { - if (leaveErrorMsg) { + if (flags & TCL_LEAVE_ERR_MSG) { if (TclIsVarArrayElement(varPtr)) { VarErrMsg(interp, varName, NULL, "set", danglingElement); } else { @@ -1480,19 +1460,62 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, leaveErrorMsg) */ if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) { - if (leaveErrorMsg) { + if (flags & TCL_LEAVE_ERR_MSG) { VarErrMsg(interp, varName, NULL, "set", isArray); } return NULL; } /* - * Set the variable's new value and discard its old value. We don't - * append with this "set" procedure so the old value isn't needed. + * Set the variable's new value and discard its old value. */ oldValuePtr = varPtr->value.objPtr; - if (newValuePtr != oldValuePtr) { /* set new value */ + if (flags & TCL_APPEND_VALUE) { + if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) { + Tcl_DecrRefCount(oldValuePtr); /* discard old value */ + varPtr->value.objPtr = NULL; + oldValuePtr = NULL; + } + if (flags & TCL_LIST_ELEMENT) { /* append list element */ + if (oldValuePtr == NULL) { + TclNewObj(oldValuePtr); + varPtr->value.objPtr = oldValuePtr; + Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */ + } else if (Tcl_IsShared(oldValuePtr)) { + varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr); + Tcl_DecrRefCount(oldValuePtr); + oldValuePtr = varPtr->value.objPtr; + Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */ + } + if (Tcl_ListObjAppendElement(interp, oldValuePtr, + newValuePtr) != TCL_OK) { + return NULL; + } + } else { /* append string */ + /* + * We append newValuePtr's bytes but don't change its ref count. + */ + + if (oldValuePtr == NULL) { + varPtr->value.objPtr = newValuePtr; + Tcl_IncrRefCount(newValuePtr); + } else { + if (Tcl_IsShared(oldValuePtr)) { /* append to copy */ + varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr); + TclDecrRefCount(oldValuePtr); + oldValuePtr = varPtr->value.objPtr; + Tcl_IncrRefCount(oldValuePtr); /* since var is ref */ + } + Tcl_AppendObjToObj(oldValuePtr, newValuePtr); + } + } + } else if (newValuePtr != oldValuePtr) { /* set new value */ + /* + * In this case we are replacing the value, so we don't need to + * do more than swap the objects. + */ + varPtr->value.objPtr = newValuePtr; Tcl_IncrRefCount(newValuePtr); /* var is another ref to obj */ if (oldValuePtr != NULL) { @@ -1510,7 +1533,7 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, leaveErrorMsg) char *msg = CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, (char *) NULL, TCL_TRACE_WRITES); if (msg != NULL) { - if (leaveErrorMsg) { + if (flags & TCL_LEAVE_ERR_MSG) { VarErrMsg(interp, varName, NULL, "set", msg); } goto cleanup; @@ -1557,7 +1580,7 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, leaveErrorMsg) * element. If the specified array or element doesn't exist, or there * is a clash in array usage, or an error occurs while executing * variable traces, then NULL is returned and a message will be left in - * the interpreter's result if leaveErrorMsg is 1. Note that the + * the interpreter's result if flags has TCL_LEAVE_ERR_MSG. Note that the * returned object may not be the same one referenced by newValuePtr; * this is because variable traces may modify the variable's value. * @@ -1578,8 +1601,7 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, leaveErrorMsg) */ Tcl_Obj * -TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, - leaveErrorMsg) +TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, flags) Tcl_Interp *interp; /* Command interpreter in which the array is * to be found. */ int localIndex; /* Index of array variable in procedure's @@ -1587,9 +1609,9 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, Tcl_Obj *elemPtr; /* Points to an object holding the name of * an element to set in the array. */ Tcl_Obj *newValuePtr; /* New value for variable. */ - int leaveErrorMsg; /* 1 if to leave an error message in - * the interpreter's result on an error. - * Otherwise no error message is left. */ + int flags; /* Various flags that tell how to set value: + * any of TCL_APPEND_VALUE, + * TCL_LIST_ELEMENT or TCL_LEAVE_ERR_MSG. */ { Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; @@ -1620,7 +1642,7 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, (unsigned int) varFramePtr); } if ((localIndex < 0) || (localIndex >= localCt)) { - fprintf(stderr, "\nTclSetIndexedScalar: can't set elememt of local %i in frame 0x%x with %i locals\n", + fprintf(stderr, "\nTclSetIndexedScalar: can't set element of local %i in frame 0x%x with %i locals\n", localIndex, (unsigned int) varFramePtr, localCt); panic("TclSetElementOfIndexedArray: bad local index %i in frame 0x%x", localIndex, (unsigned int) varFramePtr); @@ -1637,7 +1659,7 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, * reference to a variable in an enclosing namespace. Traverse through * any links until we find the referenced variable. */ - + while (TclIsVarLink(arrayPtr)) { arrayPtr = arrayPtr->value.linkPtr; } @@ -1651,7 +1673,7 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, */ if ((arrayPtr->flags & VAR_IN_HASHTABLE) && (arrayPtr->hPtr == NULL)) { - if (leaveErrorMsg) { + if (flags & TCL_LEAVE_ERR_MSG) { if (TclIsVarArrayElement(arrayPtr)) { VarErrMsg(interp, arrayName, elem, "set", danglingElement); } else { @@ -1672,11 +1694,11 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS); TclClearVarUndefined(arrayPtr); } else if (!TclIsVarArray(arrayPtr)) { - if (leaveErrorMsg) { + if (flags & TCL_LEAVE_ERR_MSG) { VarErrMsg(interp, arrayName, elem, "set", needArray); } goto errorReturn; - } + } /* * Look up the element. @@ -1700,23 +1722,66 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, */ if (TclIsVarArray(varPtr)) { - if (leaveErrorMsg) { + if (flags & TCL_LEAVE_ERR_MSG) { VarErrMsg(interp, arrayName, elem, "set", isArray); } goto errorReturn; } /* - * Set the variable's new value and discard the old one. We don't - * append with this "set" procedure so the old value isn't needed. + * Set the variable's new value and discard the old one. */ oldValuePtr = varPtr->value.objPtr; - if (newValuePtr != oldValuePtr) { /* set new value */ + if (flags & TCL_APPEND_VALUE) { + if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) { + Tcl_DecrRefCount(oldValuePtr); /* discard old value */ + varPtr->value.objPtr = NULL; + oldValuePtr = NULL; + } + if (flags & TCL_LIST_ELEMENT) { /* append list element */ + if (oldValuePtr == NULL) { + TclNewObj(oldValuePtr); + varPtr->value.objPtr = oldValuePtr; + Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */ + } else if (Tcl_IsShared(oldValuePtr)) { + varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr); + Tcl_DecrRefCount(oldValuePtr); + oldValuePtr = varPtr->value.objPtr; + Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */ + } + if (Tcl_ListObjAppendElement(interp, oldValuePtr, + newValuePtr) != TCL_OK) { + return NULL; + } + } else { /* append string */ + /* + * We append newValuePtr's bytes but don't change its ref count. + */ + + if (oldValuePtr == NULL) { + varPtr->value.objPtr = newValuePtr; + Tcl_IncrRefCount(newValuePtr); + } else { + if (Tcl_IsShared(oldValuePtr)) { /* append to copy */ + varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr); + TclDecrRefCount(oldValuePtr); + oldValuePtr = varPtr->value.objPtr; + Tcl_IncrRefCount(oldValuePtr); /* since var is ref */ + } + Tcl_AppendObjToObj(oldValuePtr, newValuePtr); + } + } + } else if (newValuePtr != oldValuePtr) { /* set new value */ + /* + * In this case we are replacing the value, so we don't need to + * do more than swap the objects. + */ + varPtr->value.objPtr = newValuePtr; - Tcl_IncrRefCount(newValuePtr); /* var is another ref to obj */ + Tcl_IncrRefCount(newValuePtr); /* var is another ref to obj */ if (oldValuePtr != NULL) { - TclDecrRefCount(oldValuePtr); /* discard old value */ + TclDecrRefCount(oldValuePtr); /* discard old value */ } } TclSetVarScalar(varPtr); @@ -1731,7 +1796,7 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, char *msg = CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem, TCL_TRACE_WRITES); if (msg != NULL) { - if (leaveErrorMsg) { + if (flags & TCL_LEAVE_ERR_MSG) { VarErrMsg(interp, arrayName, elem, "set", msg); } goto errorReturn; @@ -1894,8 +1959,7 @@ TclIncrIndexedScalar(interp, localIndex, incrAmount) long i; int result; - varValuePtr = TclGetIndexedScalar(interp, localIndex, - /*leaveErrorMsg*/ 1); + varValuePtr = TclGetIndexedScalar(interp, localIndex, TCL_LEAVE_ERR_MSG); if (varValuePtr == NULL) { Tcl_AddObjErrorInfo(interp, "\n (reading value of variable to increment)", -1); @@ -1929,7 +1993,7 @@ TclIncrIndexedScalar(interp, localIndex, incrAmount) */ resultPtr = TclSetIndexedScalar(interp, localIndex, varValuePtr, - /*leaveErrorMsg*/ 1); + TCL_LEAVE_ERR_MSG); if (resultPtr == NULL) { return NULL; } @@ -1982,7 +2046,7 @@ TclIncrElementOfIndexedArray(interp, localIndex, elemPtr, incrAmount) int result; varValuePtr = TclGetElementOfIndexedArray(interp, localIndex, elemPtr, - /*leaveErrorMsg*/ 1); + TCL_LEAVE_ERR_MSG); if (varValuePtr == NULL) { Tcl_AddObjErrorInfo(interp, "\n (reading value of variable to increment)", -1); @@ -2016,8 +2080,7 @@ TclIncrElementOfIndexedArray(interp, localIndex, elemPtr, incrAmount) */ resultPtr = TclSetElementOfIndexedArray(interp, localIndex, elemPtr, - varValuePtr, - /*leaveErrorMsg*/ 1); + varValuePtr, TCL_LEAVE_ERR_MSG); if (resultPtr == NULL) { return NULL; } |