diff options
| -rw-r--r-- | generic/tcl.h | 46 | ||||
| -rw-r--r-- | generic/tclBasic.c | 89 | ||||
| -rw-r--r-- | generic/tclHistory.c | 7 | ||||
| -rw-r--r-- | generic/tclInt.h | 40 | ||||
| -rw-r--r-- | generic/tclResult.c | 346 | ||||
| -rw-r--r-- | generic/tclStubLib.c | 7 | ||||
| -rw-r--r-- | generic/tclTest.c | 21 | ||||
| -rw-r--r-- | generic/tclUtil.c | 76 | ||||
| -rw-r--r-- | tests/all.tcl | 1 |
9 files changed, 66 insertions, 567 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index 147672c..300614c 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -498,39 +498,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; * accessed with Tcl_GetObjResult() and Tcl_SetObjResult(). */ -typedef struct Tcl_Interp -#ifndef TCL_NO_DEPRECATED -{ - /* TIP #330: Strongly discourage extensions from using the string - * result. */ -#ifdef USE_INTERP_RESULT - char *result TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult"); - /* If the last command returned a string - * result, this points to it. */ - void (*freeProc) (char *blockPtr) - TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult"); - /* Zero means the string result is statically - * allocated. TCL_DYNAMIC means it was - * allocated with ckalloc and should be freed - * with ckfree. Other values give the address - * of function to invoke to free the result. - * Tcl_Eval must free it before executing next - * command. */ -#else - char *resultDontUse; /* Don't use in extensions! */ - void (*freeProcDontUse) (char *); /* Don't use in extensions! */ -#endif -#ifdef USE_INTERP_ERRORLINE - int errorLine TCL_DEPRECATED_API("use Tcl_GetErrorLine/Tcl_SetErrorLine"); - /* When TCL_ERROR is returned, this gives the - * line number within the command where the - * error occurred (1 if first line). */ -#else - int errorLineDontUse; /* Don't use in extensions! */ -#endif -} -#endif /* TCL_NO_DEPRECATED */ -Tcl_Interp; +typedef struct Tcl_Interp Tcl_Interp; typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler; typedef struct Tcl_Channel_ *Tcl_Channel; @@ -872,13 +840,13 @@ int Tcl_IsShared(Tcl_Obj *objPtr); */ typedef struct Tcl_SavedResult { - char *result; - Tcl_FreeProc *freeProc; + char *unused1; + Tcl_FreeProc *unused2; Tcl_Obj *objResultPtr; - char *appendResult; - int appendAvl; - int appendUsed; - char resultSpace[TCL_RESULT_SIZE+1]; + char *unused3; + int unused4; + int unused5; + char unused6[TCL_RESULT_SIZE+1]; } Tcl_SavedResult; /* diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 562cca6..971ae36 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -502,8 +502,6 @@ Tcl_CreateInterp(void) iPtr = ckalloc(sizeof(Interp)); interp = (Tcl_Interp *) iPtr; - iPtr->result = iPtr->resultSpace; - iPtr->freeProc = NULL; iPtr->errorLine = 0; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); @@ -559,10 +557,6 @@ Tcl_CreateInterp(void) iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - iPtr->appendUsed = 0; - Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; @@ -590,7 +584,6 @@ Tcl_CreateInterp(void) iPtr->emptyObjPtr = Tcl_NewObj(); /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); - iPtr->resultSpace[0] = 0; iPtr->threadId = Tcl_GetCurrentThread(); /* TIP #378 */ @@ -1492,7 +1485,6 @@ DeleteInterpProc( */ Tcl_FreeResult(interp); - iPtr->result = NULL; Tcl_DecrRefCount(iPtr->objResultPtr); iPtr->objResultPtr = NULL; Tcl_DecrRefCount(iPtr->ecVar); @@ -1514,10 +1506,6 @@ DeleteInterpProc( if (iPtr->returnOpts) { Tcl_DecrRefCount(iPtr->returnOpts); } - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - iPtr->appendResult = NULL; - } TclFreePackageInfo(iPtr); while (iPtr->tracePtr != NULL) { Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr); @@ -2391,7 +2379,7 @@ TclInvokeStringCommand( * in the Command structure. * * Results: - * A standard Tcl string result value. + * A standard Tcl result value. * * Side effects: * Besides those side effects of the called Tcl_CmdProc, @@ -2432,13 +2420,6 @@ TclInvokeObjectCommand( } /* - * Move the interpreter's object result to the string result, then reset - * the object result. - */ - - (void) Tcl_GetStringResult(interp); - - /* * Decrement the ref counts for the argument objects created above, then * free the objv array if malloc'ed storage was used. */ @@ -3794,7 +3775,7 @@ Tcl_ListMathFuncs( * otherwise. * * Side effects: - * The interpreters object and string results are cleared. + * The interpreter's result is cleared. * *---------------------------------------------------------------------- */ @@ -3806,8 +3787,8 @@ TclInterpReady( register Interp *iPtr = (Interp *) interp; /* - * Reset both the interpreter's string and object results and clear out - * any previous error information. + * Reset the interpreter's result and clear out any previous error + * information. */ Tcl_ResetResult(interp); @@ -4325,24 +4306,9 @@ TclNRRunCallbacks( /* All callbacks down to rootPtr not inclusive * are to be run. */ { - Interp *iPtr = (Interp *) interp; NRE_callback *callbackPtr; Tcl_NRPostProc *procPtr; - /* - * If the interpreter has a non-empty string result, the result object is - * either empty or stale because some function set interp->result - * directly. If so, move the string result to the result object, then - * reset the string result. - * - * This only needs to be done for the first item in the list: all other - * are for NR function calls, and those are Tcl_Obj based. - */ - - if (*(iPtr->result) != 0) { - (void) Tcl_GetObjResult(interp); - } - while (TOP_CB(interp) != rootPtr) { callbackPtr = TOP_CB(interp); procPtr = callbackPtr->procPtr; @@ -5820,16 +5786,7 @@ Tcl_Eval( * previous call to Tcl_CreateInterp). */ const char *script) /* Pointer to TCL command to execute. */ { - int code = Tcl_EvalEx(interp, script, -1, 0); - - /* - * For backwards compatibility with old C code that predates the object - * system in Tcl 8.0, we have to mirror the object result back into the - * string result (some callers may expect it there). - */ - - (void) Tcl_GetStringResult(interp); - return code; + return Tcl_EvalEx(interp, script, -1, 0); } /* @@ -6327,9 +6284,6 @@ Tcl_ExprLong( Tcl_IncrRefCount(exprPtr); result = Tcl_ExprLongObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); - if (result != TCL_OK) { - (void) Tcl_GetStringResult(interp); - } } return result; } @@ -6356,9 +6310,6 @@ Tcl_ExprDouble( result = Tcl_ExprDoubleObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); /* Discard the expression object. */ - if (result != TCL_OK) { - (void) Tcl_GetStringResult(interp); - } } return result; } @@ -6384,14 +6335,6 @@ Tcl_ExprBoolean( Tcl_IncrRefCount(exprPtr); result = Tcl_ExprBooleanObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); - if (result != TCL_OK) { - /* - * Move the interpreter's object result to the string result, then - * reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - } return result; } } @@ -6717,12 +6660,6 @@ Tcl_ExprString( Tcl_DecrRefCount(resultPtr); } } - - /* - * Force the string rep of the interp result. - */ - - (void) Tcl_GetStringResult(interp); return code; } @@ -6826,19 +6763,7 @@ Tcl_AddObjErrorInfo( iPtr->flags |= ERR_LEGACY_COPY; if (iPtr->errorInfo == NULL) { - if (iPtr->result[0] != 0) { - /* - * The interp's string result is set, apparently by some extension - * making a deprecated direct write to it. That extension may - * expect interp->result to continue to be set, so we'll take - * special pains to avoid clearing it, until we drop support for - * interp->result completely. - */ - - iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1); - } else { - iPtr->errorInfo = iPtr->objResultPtr; - } + iPtr->errorInfo = iPtr->objResultPtr; Tcl_IncrRefCount(iPtr->errorInfo); if (!iPtr->errorCode) { Tcl_SetErrorCode(interp, "NONE", NULL); @@ -6916,7 +6841,7 @@ Tcl_VarEvalVA( * * Results: * A standard Tcl return result. An error message or other result may be - * left in interp->result. + * left in the interp. * * Side effects: * Depends on what was done by the command. diff --git a/generic/tclHistory.c b/generic/tclHistory.c index b10d423..c44ba4c 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -75,13 +75,6 @@ Tcl_RecordAndEval( result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); /* - * Move the interpreter's object result to the string result, then - * reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - /* * Discard the Tcl object created to hold the command. */ diff --git a/generic/tclInt.h b/generic/tclInt.h index 1d04c82..9e062ad 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1804,27 +1804,16 @@ typedef struct Interp { * Tcl_Interp struct (see tcl.h). If you change one, be sure to change the * other. * - * The interpreter's result is held in both the string and the - * objResultPtr fields. These fields hold, respectively, the result's - * string or object value. The interpreter's result is always in the - * result field if that is non-empty, otherwise it is in objResultPtr. - * The two fields are kept consistent unless some C code sets - * interp->result directly. Programs should not access result and - * objResultPtr directly; instead, they should always get and set the - * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and - * Tcl_GetStringResult. See the SetResult man page for details. + * The interpreter's result is held in the objResultPtr field. This field + * holds the result's object value. The interpreter's result is always in + * objResultPtr. Programs should not access objResultPtr directly; + * instead, they should always get and set the result using procedures + * such as Tcl_SetObjResult, Tcl_GetObjResult, and Tcl_GetStringResult. + * See the SetResult man page for details. */ - char *result; /* If the last command returned a string - * result, this points to it. Should not be - * accessed directly; see comment above. */ - Tcl_FreeProc *freeProc; /* Zero means a string result is statically - * allocated. TCL_DYNAMIC means string result - * was allocated with ckalloc and should be - * freed with ckfree. Other values give - * address of procedure to invoke to free the - * string result. Tcl_Eval must free it before - * executing next command. */ + char *unused3; + Tcl_FreeProc *unused4; int errorLine; /* When TCL_ERROR is returned, this gives the * line number in the command where the error * occurred (1 means first line). */ @@ -1882,13 +1871,9 @@ typedef struct Interp { * See Tcl_AppendResult code for details. */ - char *appendResult; /* Storage space for results generated by - * Tcl_AppendResult. Ckalloc-ed. NULL means - * not yet allocated. */ - int appendAvl; /* Total amount of space available at - * partialResult. */ - int appendUsed; /* Number of non-null bytes currently stored - * at partialResult. */ + char *unused5; + int unused6; + int unused7; /* * Information about packages. Used only in tclPkg.c. @@ -1950,8 +1935,7 @@ typedef struct Interp { * string. Returned by Tcl_ObjSetVar2 when * variable traces change a variable in a * gross way. */ - char resultSpace[TCL_RESULT_SIZE+1]; - /* Static space holding small results. */ + char unused8[TCL_RESULT_SIZE+1]; Tcl_Obj *objResultPtr; /* If the last command returned an object * result, this points to it. Should not be * accessed directly; see comment above. */ diff --git a/generic/tclResult.c b/generic/tclResult.c index 9707f20..b8f9c92 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -27,7 +27,6 @@ enum returnKeys { static Tcl_Obj ** GetKeys(void); static void ReleaseKeys(ClientData clientData); static void ResetObjResult(Interp *iPtr); -static void SetupAppendBuffer(Interp *iPtr, int newSpace); /* * This structure is used to take a snapshot of the interpreter state in @@ -246,44 +245,6 @@ Tcl_SaveResult( statePtr->objResultPtr = iPtr->objResultPtr; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); - - /* - * Save the string result. - */ - - statePtr->freeProc = iPtr->freeProc; - if (iPtr->result == iPtr->resultSpace) { - /* - * Copy the static string data out of the interp buffer. - */ - - statePtr->result = statePtr->resultSpace; - strcpy(statePtr->result, iPtr->result); - statePtr->appendResult = NULL; - } else if (iPtr->result == iPtr->appendResult) { - /* - * Move the append buffer out of the interp. - */ - - statePtr->appendResult = iPtr->appendResult; - statePtr->appendAvl = iPtr->appendAvl; - statePtr->appendUsed = iPtr->appendUsed; - statePtr->result = statePtr->appendResult; - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - iPtr->appendUsed = 0; - } else { - /* - * Move the dynamic or static string out of the interpreter. - */ - - statePtr->result = iPtr->result; - statePtr->appendResult = NULL; - } - - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; - iPtr->freeProc = 0; } /* @@ -314,39 +275,6 @@ Tcl_RestoreResult( Tcl_ResetResult(interp); /* - * Restore the string result. - */ - - iPtr->freeProc = statePtr->freeProc; - if (statePtr->result == statePtr->resultSpace) { - /* - * Copy the static string data into the interp buffer. - */ - - iPtr->result = iPtr->resultSpace; - strcpy(iPtr->result, statePtr->result); - } else if (statePtr->result == statePtr->appendResult) { - /* - * Move the append buffer back into the interp. - */ - - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - } - - iPtr->appendResult = statePtr->appendResult; - iPtr->appendAvl = statePtr->appendAvl; - iPtr->appendUsed = statePtr->appendUsed; - iPtr->result = iPtr->appendResult; - } else { - /* - * Move the dynamic or static string back into the interpreter. - */ - - iPtr->result = statePtr->result; - } - - /* * Restore the object result. */ @@ -377,14 +305,6 @@ Tcl_DiscardResult( Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ { TclDecrRefCount(statePtr->objResultPtr); - - if (statePtr->result == statePtr->appendResult) { - ckfree(statePtr->appendResult); - } else if (statePtr->freeProc == TCL_DYNAMIC) { - ckfree(statePtr->result); - } else if (statePtr->freeProc) { - statePtr->freeProc(statePtr->result); - } } /* @@ -414,49 +334,15 @@ Tcl_SetResult( * TCL_STATIC, TCL_VOLATILE, or the address of * a Tcl_FreeProc such as free. */ { - Interp *iPtr = (Interp *) interp; - register Tcl_FreeProc *oldFreeProc = iPtr->freeProc; - char *oldResult = iPtr->result; - - if (result == NULL) { - iPtr->resultSpace[0] = 0; - iPtr->result = iPtr->resultSpace; - iPtr->freeProc = 0; - } else if (freeProc == TCL_VOLATILE) { - int length = strlen(result); - - if (length > TCL_RESULT_SIZE) { - iPtr->result = ckalloc(length + 1); - iPtr->freeProc = TCL_DYNAMIC; - } else { - iPtr->result = iPtr->resultSpace; - iPtr->freeProc = 0; - } - memcpy(iPtr->result, result, (unsigned) length+1); - } else { - iPtr->result = (char *) result; - iPtr->freeProc = freeProc; + Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1)); + if (result == NULL || freeProc == NULL || freeProc == TCL_VOLATILE) { + return; } - - /* - * If the old result was dynamically-allocated, free it up. Do it here, - * rather than at the beginning, in case the new result value was part of - * the old result value. - */ - - if (oldFreeProc != 0) { - if (oldFreeProc == TCL_DYNAMIC) { - ckfree(oldResult); - } else { - oldFreeProc(oldResult); - } + if (freeProc == TCL_DYNAMIC) { + ckfree(result); + } else { + (*freeProc)(result); } - - /* - * Reset the object result since we just set the string result. - */ - - ResetObjResult(iPtr); } /* @@ -480,18 +366,9 @@ const char * Tcl_GetStringResult( register Tcl_Interp *interp)/* Interpreter whose result to return. */ { - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - Interp *iPtr = (Interp *) interp; - if (*(iPtr->result) == 0) { - Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), - TCL_VOLATILE); - } - return iPtr->result; + return Tcl_GetString(iPtr->objResultPtr); } /* @@ -532,21 +409,6 @@ Tcl_SetObjResult( */ TclDecrRefCount(oldObjResult); - - /* - * Reset the string result since we just set the result object. - */ - - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; } /* @@ -575,32 +437,7 @@ Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { register Interp *iPtr = (Interp *) interp; - Tcl_Obj *objResultPtr; - int length; - - /* - * If the string result is non-empty, move the string result to the object - * result, then reset the string result. - */ - - if (iPtr->result[0] != 0) { - ResetObjResult(iPtr); - objResultPtr = iPtr->objResultPtr; - length = strlen(iPtr->result); - TclInitStringRep(objResultPtr, iPtr->result, length); - - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->result[0] = 0; - } return iPtr->objResultPtr; } @@ -719,129 +556,20 @@ Tcl_AppendElement( * to result. */ { Interp *iPtr = (Interp *) interp; - char *dst; - int size; - int flags; - - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - /* - * See how much space is needed, and grow the append buffer if needed to - * accommodate the list element. - */ - - size = Tcl_ScanElement(element, &flags) + 1; - if ((iPtr->result != iPtr->appendResult) - || (iPtr->appendResult[iPtr->appendUsed] != 0) - || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) { - SetupAppendBuffer(iPtr, size+iPtr->appendUsed); - } - - /* - * Convert the string into a list element and copy it to the buffer that's - * forming, with a space separator if needed. - */ - - dst = iPtr->appendResult + iPtr->appendUsed; - if (TclNeedSpace(iPtr->appendResult, dst)) { - iPtr->appendUsed++; - *dst = ' '; - dst++; - - /* - * If we need a space to separate this element from preceding stuff, - * then this element will not lead a list, and need not have it's - * leading '#' quoted. - */ - - flags |= TCL_DONT_QUOTE_HASH; - } - iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags); -} - -/* - *---------------------------------------------------------------------- - * - * SetupAppendBuffer -- - * - * This function makes sure that there is an append buffer properly - * initialized, if necessary, from the interpreter's result, and that it - * has at least enough room to accommodate newSpace new bytes of - * information. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static void -SetupAppendBuffer( - Interp *iPtr, /* Interpreter whose result is being set up. */ - int newSpace) /* Make sure that at least this many bytes of - * new information may be added. */ -{ - int totalSpace; - - /* - * Make the append buffer larger, if that's necessary, then copy the - * result into the append buffer and make the append buffer the official - * Tcl result. - */ - - if (iPtr->result != iPtr->appendResult) { - /* - * If an oversized buffer was used recently, then free it up so we go - * back to a smaller buffer. This avoids tying up memory forever after - * a large operation. - */ - - if (iPtr->appendAvl > 500) { - ckfree(iPtr->appendResult); - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - } - iPtr->appendUsed = strlen(iPtr->result); - } else if (iPtr->result[iPtr->appendUsed] != 0) { - /* - * Most likely someone has modified a result created by - * Tcl_AppendResult et al. so that it has a different size. Just - * recompute the size. - */ - - iPtr->appendUsed = strlen(iPtr->result); - } - - totalSpace = newSpace + iPtr->appendUsed; - if (totalSpace >= iPtr->appendAvl) { - char *new; - - if (totalSpace < 100) { - totalSpace = 200; - } else { - totalSpace *= 2; - } - new = ckalloc(totalSpace); - strcpy(new, iPtr->result); - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - } - iPtr->appendResult = new; - iPtr->appendAvl = totalSpace; - } else if (iPtr->result != iPtr->appendResult) { - strcpy(iPtr->appendResult, iPtr->result); + Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1); + Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr); + int length; + const char *bytes; + + if (Tcl_IsShared(iPtr->objResultPtr)) { + Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr)); + } + bytes = Tcl_GetStringFromObj(iPtr->objResultPtr, &length); + if (TclNeedSpace(bytes, bytes+length)) { + Tcl_AppendToObj(iPtr->objResultPtr, " ", 1); } - - Tcl_FreeResult((Tcl_Interp *) iPtr); - iPtr->result = iPtr->appendResult; + Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr); + Tcl_DecrRefCount(listPtr); } /* @@ -850,18 +578,17 @@ SetupAppendBuffer( * Tcl_FreeResult -- * * This function frees up the memory associated with an interpreter's - * string result. It also resets the interpreter's result object. - * Tcl_FreeResult is most commonly used when a function is about to - * replace one result value with another. + * result, resetting the interpreter's result object. Tcl_FreeResult is + * most commonly used when a function is about to replace one result + * value with another. * * Results: * None. * * Side effects: - * Frees the memory associated with interp's string result and sets - * interp->freeProc to zero, but does not change interp->result or clear - * error state. Resets interp's result object to an unshared empty - * object. + * Frees the memory associated with interp's result but does not change + * any part of the error dictionary (i.e., the errorinfo and errorcode + * remain the same). * *---------------------------------------------------------------------- */ @@ -872,15 +599,6 @@ Tcl_FreeResult( { register Interp *iPtr = (Interp *) interp; - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - ResetObjResult(iPtr); } @@ -910,16 +628,6 @@ Tcl_ResetResult( register Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; if (iPtr->errorCode) { /* Legacy support */ if (iPtr->flags & ERR_LEGACY_COPY) { diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index f569820..9e9208d 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -41,10 +41,9 @@ HasStubSupport( if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) { return iPtr->stubTable; } - - iPtr->result = - (char *)"This interpreter does not support stubs-enabled extensions."; - iPtr->freeProc = TCL_STATIC; + iPtr->unused3 + = "This interpreter does not support stubs-enabled extensions."; + iPtr->unused4 = TCL_STATIC; return NULL; } diff --git a/generic/tclTest.c b/generic/tclTest.c index a8b27fb..484f851 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -116,13 +116,6 @@ typedef struct TclEncoding { } TclEncoding; /* - * The counter below is used to determine if the TestsaveresultFree routine - * was called for a result. - */ - -static int freeCount; - -/* * Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands. */ @@ -5028,7 +5021,6 @@ TestsaveresultCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - Interp* iPtr = (Interp*) interp; int discard, result, index; Tcl_SavedResult state; Tcl_Obj *objPtr; @@ -5079,7 +5071,6 @@ TestsaveresultCmd( break; } - freeCount = 0; Tcl_SaveResult(interp, &state); if (((enum options) index) == RESULT_OBJECT) { @@ -5096,14 +5087,10 @@ TestsaveresultCmd( } switch ((enum options) index) { - case RESULT_DYNAMIC: { - int present = iPtr->freeProc == TestsaveresultFree; - int called = freeCount; - - Tcl_AppendElement(interp, called ? "called" : "notCalled"); - Tcl_AppendElement(interp, present ? "present" : "missing"); + case RESULT_DYNAMIC: + Tcl_AppendElement(interp, discard ? "called" : "notCalled"); + Tcl_AppendElement(interp, !discard ? "present" : "missing"); break; - } case RESULT_OBJECT: Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr ? "same" : "different"); @@ -5134,7 +5121,7 @@ static void TestsaveresultFree( char *blockPtr) { - freeCount++; + /* empty... */ } /* diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 13e54ec..0cbb7c9 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2796,7 +2796,6 @@ Tcl_DStringResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the * result of interp. */ { - Tcl_ResetResult(interp); Tcl_SetObjResult(interp, TclDStringToObj(dsPtr)); } @@ -2826,77 +2825,12 @@ Tcl_DStringGetResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { - Interp *iPtr = (Interp *) interp; - - if (dsPtr->string != dsPtr->staticSpace) { - ckfree(dsPtr->string); - } - - /* - * Do more efficient transfer when we know the result is a Tcl_Obj. When - * there's no st`ring result, we only have to deal with two cases: - * - * 1. When the string rep is the empty string, when we don't copy but - * instead use the staticSpace in the DString to hold an empty string. - - * 2. When the string rep is not there or there's a real string rep, when - * we use Tcl_GetString to fetch (or generate) the string rep - which - * we know to have been allocated with ckalloc() - and use it to - * populate the DString space. Then, we free the internal rep. and set - * the object's string representation back to the canonical empty - * string. - */ - - if (!iPtr->result[0] && iPtr->objResultPtr - && !Tcl_IsShared(iPtr->objResultPtr)) { - if (iPtr->objResultPtr->bytes == tclEmptyStringRep) { - dsPtr->string = dsPtr->staticSpace; - dsPtr->string[0] = 0; - dsPtr->length = 0; - dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; - } else { - dsPtr->string = Tcl_GetString(iPtr->objResultPtr); - dsPtr->length = iPtr->objResultPtr->length; - dsPtr->spaceAvl = dsPtr->length + 1; - TclFreeIntRep(iPtr->objResultPtr); - iPtr->objResultPtr->bytes = tclEmptyStringRep; - iPtr->objResultPtr->length = 0; - } - return; - } - - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - dsPtr->length = strlen(iPtr->result); - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - dsPtr->string = iPtr->result; - dsPtr->spaceAvl = dsPtr->length+1; - } else { - dsPtr->string = ckalloc(dsPtr->length+1); - memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1); - iPtr->freeProc(iPtr->result); - } - dsPtr->spaceAvl = dsPtr->length+1; - iPtr->freeProc = NULL; - } else { - if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) { - dsPtr->string = dsPtr->staticSpace; - dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; - } else { - dsPtr->string = ckalloc(dsPtr->length+1); - dsPtr->spaceAvl = dsPtr->length + 1; - } - memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1); - } + int length; + char *bytes = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length); - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; + Tcl_DStringFree(dsPtr); + Tcl_DStringAppend(dsPtr, bytes, length); + Tcl_ResetResult(interp); } /* diff --git a/tests/all.tcl b/tests/all.tcl index 05d3024..715d2e2 100644 --- a/tests/all.tcl +++ b/tests/all.tcl @@ -12,6 +12,7 @@ package prefer latest package require Tcl 8.5 +proc tcl::info::hostname {} {return localhost} package require tcltest 2.2 namespace import tcltest::* configure {*}$argv -testdir [file dir [info script]] |