Attachment "remove.patch" to
ticket [1175180fff]
added by
dgp
2005-04-05 00:53:30.
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.197
diff -u -r1.197 tcl.h
--- generic/tcl.h 10 Mar 2005 22:10:38 -0000 1.197
+++ generic/tcl.h 4 Apr 2005 17:34:44 -0000
@@ -430,39 +430,10 @@
/*
* Data structures defined opaquely in this module. The definitions below
- * just provide dummy types. A few fields are made visible in Tcl_Interp
- * structures, namely those used for returning a string result from
- * commands. Direct access to the result field is discouraged in Tcl 8.0.
- * The interpreter result is either an object or a string, and the two
- * values are kept consistent unless some C code sets interp->result
- * directly. Programmers should use either the procedure Tcl_GetObjResult()
- * or Tcl_GetStringResult() to read the interpreter's result. See the
- * SetResult man page for details.
- *
- * Note: any change to the Tcl_Interp definition below must be mirrored
- * in the "real" definition in tclInt.h.
- *
- * Note: Tcl_ObjCmdProc procedures do not directly set result and freeProc.
- * Instead, they set a Tcl_Obj member in the "real" structure that can be
- * accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
- */
-
-typedef struct Tcl_Interp {
- char *result; /* If the last command returned a string
- * result, this points to it. */
- void (*freeProc) _ANSI_ARGS_((char *blockPtr));
- /* 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 procedure to invoke to
- * free the result. Tcl_Eval must free it
- * before executing next command. */
- int errorLine; /* When TCL_ERROR is returned, this gives
- * the line number within the command where
- * the error occurred (1 if first line). */
-} Tcl_Interp;
+ * just provide dummy types.
+ */
+typedef struct Tcl_Interp Tcl_Interp;
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;
typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.143
diff -u -r1.143 tclBasic.c
--- generic/tclBasic.c 2 Apr 2005 02:08:29 -0000 1.143
+++ generic/tclBasic.c 4 Apr 2005 17:34:45 -0000
@@ -205,6 +205,7 @@
interp = (Tcl_Interp *) iPtr;
iPtr->result = iPtr->resultSpace;
+ strcpy(iPtr->result, "long-deprecated interp->result access is disabled");
iPtr->freeProc = NULL;
iPtr->errorLine = 0;
iPtr->objResultPtr = Tcl_NewObj();
@@ -1810,13 +1811,6 @@
result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, 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.
*/
@@ -3086,17 +3080,6 @@
code = traceCode;
}
- /*
- * If the interpreter has a non-empty string result, the result
- * object is either empty or stale because some procedure set
- * interp->result directly. If so, move the string result to the
- * result object, then reset the string result.
- */
-
- if (*(iPtr->result) != 0) {
- (void) Tcl_GetObjResult(interp);
- }
-
done:
return code;
}
@@ -3647,16 +3630,7 @@
* by previous call to Tcl_CreateInterp). */
CONST char *string; /* Pointer to TCL command to execute. */
{
- int code = Tcl_EvalEx(interp, string, -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, string, -1, 0);
}
/*
@@ -3931,13 +3905,6 @@
result = TCL_ERROR;
}
Tcl_DecrRefCount(resultPtr); /* discard the result object */
- } else {
- /*
- * Move the interpreter's object result to the string result,
- * then reset the object result.
- */
-
- (void) Tcl_GetStringResult(interp);
}
Tcl_DecrRefCount(exprPtr); /* discard the expression object */
} else {
@@ -3999,13 +3966,6 @@
result = TCL_ERROR;
}
Tcl_DecrRefCount(resultPtr); /* discard the result object */
- } else {
- /*
- * Move the interpreter's object result to the string result,
- * then reset the object result.
- */
-
- (void) Tcl_GetStringResult(interp);
}
Tcl_DecrRefCount(exprPtr); /* discard the expression object */
} else {
@@ -4054,14 +4014,6 @@
}
Tcl_DecrRefCount(resultPtr); /* discard the result object */
}
- if (result != TCL_OK) {
- /*
- * Move the interpreter's object result to the string result,
- * then reset the object result.
- */
-
- (void) Tcl_GetStringResult(interp);
- }
Tcl_DecrRefCount(exprPtr); /* discard the expression object */
} else {
/*
@@ -4374,13 +4326,6 @@
TCL_VOLATILE);
}
Tcl_DecrRefCount(resultPtr); /* discard the result object */
- } else {
- /*
- * Move the interpreter's object result to the string result,
- * then reset the object result.
- */
-
- (void) Tcl_GetStringResult(interp);
}
Tcl_DecrRefCount(exprPtr); /* discard the expression object */
} else {
@@ -4490,18 +4435,7 @@
*/
if (iPtr->errorInfo == NULL) { /* just starting to log error */
- 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(interp->result, -1);
- } else {
- iPtr->errorInfo = iPtr->objResultPtr;
- }
+ iPtr->errorInfo = iPtr->objResultPtr;
Tcl_IncrRefCount(iPtr->errorInfo);
if (!iPtr->errorCode) {
Tcl_SetErrorCode(interp, "NONE", NULL);
Index: generic/tclHistory.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclHistory.c,v
retrieving revision 1.7
diff -u -r1.7 tclHistory.c
--- generic/tclHistory.c 6 Oct 2004 14:59:02 -0000 1.7
+++ generic/tclHistory.c 4 Apr 2005 17:34:45 -0000
@@ -61,13 +61,6 @@
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.
*/
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.219
diff -u -r1.219 tclInt.h
--- generic/tclInt.h 2 Apr 2005 02:08:37 -0000 1.219
+++ generic/tclInt.h 4 Apr 2005 17:34:45 -0000
@@ -682,6 +682,7 @@
* local variables recognized at compile time.
*/
+#define Interp Tcl_Interp
typedef struct Proc {
struct Interp *iPtr; /* Interpreter for which this command
* is defined. */
@@ -1215,7 +1216,7 @@
*----------------------------------------------------------------
*/
-typedef struct Interp {
+struct Tcl_Interp {
/*
* Note: the first three fields must match exactly the fields in
@@ -1464,7 +1465,7 @@
ByteCodeStats stats; /* Holds compilation and execution
* statistics for this interpreter. */
#endif /* TCL_COMPILE_STATS */
-} Interp;
+};
/*
* EvalFlag bits for Interp structures:
Index: generic/tclResult.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclResult.c,v
retrieving revision 1.23
diff -u -r1.23 tclResult.c
--- generic/tclResult.c 23 Nov 2004 00:12:57 -0000 1.23
+++ generic/tclResult.c 4 Apr 2005 17:34:45 -0000
@@ -26,8 +26,6 @@
static Tcl_Obj ** GetKeys();
static void ReleaseKeys _ANSI_ARGS_((ClientData clientData));
static void ResetObjResult _ANSI_ARGS_((Interp *iPtr));
-static void SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,
- int newSpace));
/*
* This structure is used to take a snapshot of the interpreter
@@ -232,44 +230,6 @@
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;
}
/*
@@ -300,39 +260,6 @@
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((char *)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.
*/
@@ -364,16 +291,6 @@
Tcl_SavedResult *statePtr; /* State returned by Tcl_SaveResult. */
{
TclDecrRefCount(statePtr->objResultPtr);
-
- if (statePtr->result == statePtr->appendResult) {
- ckfree(statePtr->appendResult);
- } else if (statePtr->freeProc) {
- if (statePtr->freeProc == TCL_DYNAMIC) {
- ckfree(statePtr->result);
- } else {
- (*statePtr->freeProc)(statePtr->result);
- }
- }
}
/*
@@ -403,49 +320,15 @@
* TCL_STATIC, TCL_VOLATILE, or the address
* of a Tcl_FreeProc such as free. */
{
- Interp *iPtr = (Interp *) interp;
- int length;
- register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
- char *oldResult = iPtr->result;
-
- if (stringPtr == NULL) {
- iPtr->resultSpace[0] = 0;
- iPtr->result = iPtr->resultSpace;
- iPtr->freeProc = 0;
- } else if (freeProc == TCL_VOLATILE) {
- length = strlen(stringPtr);
- if (length > TCL_RESULT_SIZE) {
- iPtr->result = (char *) ckalloc((unsigned) length+1);
- iPtr->freeProc = TCL_DYNAMIC;
- } else {
- iPtr->result = iPtr->resultSpace;
- iPtr->freeProc = 0;
- }
- strcpy(iPtr->result, stringPtr);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(stringPtr, -1));
+ if (stringPtr == NULL) return;
+ if (freeProc == 0) return;
+ if (freeProc == TCL_VOLATILE) return;
+ if (freeProc == TCL_DYNAMIC) {
+ ckfree(stringPtr);
} else {
- iPtr->result = stringPtr;
- iPtr->freeProc = freeProc;
- }
-
- /*
- * 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);
- }
+ (*freeProc)(stringPtr);
}
-
- /*
- * Reset the object result since we just set the string result.
- */
-
- ResetObjResult(iPtr);
}
/*
@@ -469,16 +352,8 @@
Tcl_GetStringResult(interp)
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.
- */
-
- if (*(interp->result) == 0) {
- Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
- TCL_VOLATILE);
- }
- return interp->result;
+ Interp *iPtr = (Interp *)interp;
+ return Tcl_GetString(iPtr->objResultPtr);
}
/*
@@ -521,21 +396,6 @@
*/
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;
}
/*
@@ -564,32 +424,6 @@
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) {
- 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->resultSpace[0] = 0;
- }
return iPtr->objResultPtr;
}
@@ -629,23 +463,6 @@
}
Tcl_AppendStringsToObjVA(objPtr, argList);
Tcl_SetObjResult(interp, objPtr);
- /*
- * Strictly we should call Tcl_GetStringResult(interp) here to
- * make sure that interp->result is correct according to the old
- * contract, but that makes the performance of much code (e.g. in
- * Tk) absolutely awful. So we leave it out; code that really
- * wants interp->result can just insert the calls to
- * Tcl_GetStringResult() itself. [Patch 1041072 discussion]
- */
-
-#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
- /*
- * Ensure that the interp->result is legal so old Tcl 7.* code
- * still works. There's still embarrasingly much of it about...
- */
-
- (void) Tcl_GetStringResult(interp);
-#endif /* USE_DIRECT_INTERP_RESULT_ACCESS */
}
/*
@@ -713,127 +530,20 @@
* add 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(stringPtr, &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(stringPtr, dst, flags);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetupAppendBuffer --
- *
- * This procedure 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(iPtr, newSpace)
- 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.
- */
+ Tcl_Obj *elementPtr = Tcl_NewStringObj(stringPtr, -1);
+ Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
+ int length;
+ char *bytes;
- iPtr->appendUsed = strlen(iPtr->result);
+ if (Tcl_IsShared(iPtr->objResultPtr)) {
+ Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr));
}
-
- totalSpace = newSpace + iPtr->appendUsed;
- if (totalSpace >= iPtr->appendAvl) {
- char *new;
-
- if (totalSpace < 100) {
- totalSpace = 200;
- } else {
- totalSpace *= 2;
- }
- new = (char *) ckalloc((unsigned) 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);
+ 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);
}
/*
@@ -863,16 +573,6 @@
register Tcl_Interp *interp; /* Interpreter for which to free result. */
{
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);
}
@@ -903,16 +603,6 @@
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 */
Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
Index: generic/tclTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTest.c,v
retrieving revision 1.88
diff -u -r1.88 tclTest.c
--- generic/tclTest.c 28 Jan 2005 13:38:57 -0000 1.88
+++ generic/tclTest.c 4 Apr 2005 17:34:45 -0000
@@ -1675,13 +1675,13 @@
} else if (strcmp(argv[2], "staticlarge") == 0) {
Tcl_SetResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", TCL_STATIC);
} else if (strcmp(argv[2], "free") == 0) {
- Tcl_SetResult(interp, (char *) ckalloc(100), TCL_DYNAMIC);
- strcpy(interp->result, "This is a malloc-ed string");
+ char *heapString = (char *) ckalloc(100);
+ strcpy(heapString, "This is a malloc-ed string");
+ Tcl_SetResult(interp, heapString, TCL_DYNAMIC);
} else if (strcmp(argv[2], "special") == 0) {
- interp->result = (char *) ckalloc(100);
- interp->result += 4;
- interp->freeProc = SpecialFree;
- strcpy(interp->result, "This is a specially-allocated string");
+ char *heapString = (char *) ckalloc(100);
+ strcpy(heapString, "This is a specially-allocated string");
+ Tcl_SetResult(interp, heapString, SpecialFree);
} else {
Tcl_AppendResult(interp, "bad gresult option \"", argv[2],
"\": must be staticsmall, staticlarge, free, or special",
@@ -1732,7 +1732,7 @@
static void SpecialFree(blockPtr)
char *blockPtr; /* Block to free. */
{
- ckfree(blockPtr - 4);
+ ckfree(blockPtr);
}
/*
Index: generic/tclUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclUtil.c,v
retrieving revision 1.53
diff -u -r1.53 tclUtil.c
--- generic/tclUtil.c 13 Dec 2004 22:11:35 -0000 1.53
+++ generic/tclUtil.c 4 Apr 2005 17:34:46 -0000
@@ -1746,18 +1746,7 @@
Tcl_DString *dsPtr; /* Dynamic string that is to become the
* result of interp. */
{
- Tcl_ResetResult(interp);
-
- if (dsPtr->string != dsPtr->staticSpace) {
- interp->result = dsPtr->string;
- interp->freeProc = TCL_DYNAMIC;
- } else if (dsPtr->length < TCL_RESULT_SIZE) {
- interp->result = ((Interp *) interp)->resultSpace;
- strcpy(interp->result, dsPtr->string);
- } else {
- Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
- }
-
+ Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
dsPtr->string = dsPtr->staticSpace;
dsPtr->length = 0;
dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
@@ -1790,44 +1779,12 @@
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);
- }
-
- /*
- * If the string result is empty, move the object result to the
- * string result, then reset the object result.
- */
-
- (void) Tcl_GetStringResult(interp);
+ int length;
+ char *bytes = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
- 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 = (char *) ckalloc((unsigned) (dsPtr->length+1));
- strcpy(dsPtr->string, iPtr->result);
- (*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 = (char *) ckalloc((unsigned) (dsPtr->length + 1));
- dsPtr->spaceAvl = dsPtr->length + 1;
- }
- strcpy(dsPtr->string, iPtr->result);
- }
-
- iPtr->result = iPtr->resultSpace;
- iPtr->resultSpace[0] = 0;
+ Tcl_DStringFree(dsPtr);
+ Tcl_DStringAppend(dsPtr, bytes, length);
+ Tcl_ResetResult(interp);
}
/*
Index: tests/result.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/result.test,v
retrieving revision 1.9
diff -u -r1.9 result.test
--- tests/result.test 16 Aug 2004 14:11:31 -0000 1.9
+++ tests/result.test 4 Apr 2005 17:34:47 -0000
@@ -29,8 +29,9 @@
testsaveresult append {set x 42} 0
} {append result}
test result-1.3 {Tcl_SaveInterpResult} {testsaveresult} {
+ # Behavior and test changed for Tcl 8.5
testsaveresult dynamic {set x 42} 0
-} {dynamic result notCalled present}
+} {dynamic result notCalled missing}
test result-1.4 {Tcl_SaveInterpResult} {testsaveresult} {
testsaveresult object {set x 42} 0
} {object result same}
@@ -41,8 +42,9 @@
testsaveresult append {set x 42} 1
} {42}
test result-1.7 {Tcl_SaveInterpResult} {testsaveresult} {
+ # Behavior and test changed for Tcl 8.5
testsaveresult dynamic {set x 42} 1
-} {42 called missing}
+} {42 notCalled missing}
test result-1.8 {Tcl_SaveInterpResult} {testsaveresult} {
testsaveresult object {set x 42} 1
} {42 different}
