Compare commits
9
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
0ebbd86bb7 | ||
|
|
e9cf99c212 | ||
|
|
b339d4bf03 | ||
|
|
1e58e8e42d | ||
|
|
91af7f6f90 | ||
|
|
68191ded75 | ||
|
|
ac3d0b69d3 | ||
|
|
96f611f896 | ||
|
|
ec9c29c80d |
+7
-39
@@ -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;
|
||||
|
||||
/*
|
||||
|
||||
+7
-82
@@ -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,
|
||||
@@ -2431,13 +2419,6 @@ TclInvokeObjectCommand(
|
||||
cmdPtr->objClientData, argc, objv);
|
||||
}
|
||||
|
||||
/*
|
||||
* 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.
|
||||
|
||||
@@ -74,13 +74,6 @@ Tcl_RecordAndEval(
|
||||
Tcl_IncrRefCount(cmdPtr);
|
||||
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.
|
||||
*/
|
||||
|
||||
+12
-28
@@ -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. */
|
||||
|
||||
+26
-318
@@ -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;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -313,39 +274,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);
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
|
||||
if (result == NULL || freeProc == NULL || freeProc == TCL_VOLATILE) {
|
||||
return;
|
||||
}
|
||||
if (freeProc == TCL_DYNAMIC) {
|
||||
ckfree(result);
|
||||
} else {
|
||||
iPtr->result = (char *) result;
|
||||
iPtr->freeProc = freeProc;
|
||||
(*freeProc)(result);
|
||||
}
|
||||
|
||||
/*
|
||||
* 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);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* 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;
|
||||
Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1);
|
||||
Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
|
||||
int length;
|
||||
const char *bytes;
|
||||
|
||||
/*
|
||||
* 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);
|
||||
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);
|
||||
}
|
||||
|
||||
/*
|
||||
* 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_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) {
|
||||
|
||||
@@ -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;
|
||||
}
|
||||
|
||||
|
||||
+4
-17
@@ -115,13 +115,6 @@ typedef struct TclEncoding {
|
||||
char *fromUtfCmd;
|
||||
} 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... */
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
+5
-71
@@ -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;
|
||||
int length;
|
||||
char *bytes = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
iPtr->resultSpace[0] = 0;
|
||||
Tcl_DStringFree(dsPtr);
|
||||
Tcl_DStringAppend(dsPtr, bytes, length);
|
||||
Tcl_ResetResult(interp);
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
Reference in New Issue
Block a user