Attachment "1175180.patch" to
ticket [1175180fff]
added by
dgp
2005-04-05 00:26:09.
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:09:10 -0000
@@ -430,7 +430,11 @@
/*
* Data structures defined opaquely in this module. The definitions below
- * just provide dummy types. A few fields are made visible in Tcl_Interp
+ * just provide dummy types.
+ */
+
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
+/* 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
@@ -462,6 +466,9 @@
* the line number within the command where
* the error occurred (1 if first line). */
} Tcl_Interp;
+#else
+typedef struct Tcl_Interp Tcl_Interp;
+#endif
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;
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:09:10 -0000
@@ -205,6 +205,9 @@
interp = (Tcl_Interp *) iPtr;
iPtr->result = iPtr->resultSpace;
+#ifndef USE_DIRECT_INTERP_RESULT_ACCESS
+ strcpy(iPtr->result, "long-deprecated interp->result access is disabled");
+#endif
iPtr->freeProc = NULL;
iPtr->errorLine = 0;
iPtr->objResultPtr = Tcl_NewObj();
@@ -1809,12 +1812,14 @@
result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, argc, objv);
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
/*
* Move the interpreter's object result to the string result,
* then reset the object result.
*/
(void) Tcl_GetStringResult(interp);
+#endif
/*
* Decrement the ref counts for the argument objects created above,
@@ -3086,6 +3091,7 @@
code = traceCode;
}
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
/*
* If the interpreter has a non-empty string result, the result
* object is either empty or stale because some procedure set
@@ -3096,6 +3102,7 @@
if (*(iPtr->result) != 0) {
(void) Tcl_GetObjResult(interp);
}
+#endif
done:
return code;
@@ -3649,6 +3656,7 @@
{
int code = Tcl_EvalEx(interp, string, -1, 0);
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
/*
* For backwards compatibility with old C code that predates the
* object system in Tcl 8.0, we have to mirror the object result
@@ -3656,6 +3664,7 @@
*/
(void) Tcl_GetStringResult(interp);
+#endif
return code;
}
@@ -3931,6 +3940,7 @@
result = TCL_ERROR;
}
Tcl_DecrRefCount(resultPtr); /* discard the result object */
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
} else {
/*
* Move the interpreter's object result to the string result,
@@ -3938,6 +3948,7 @@
*/
(void) Tcl_GetStringResult(interp);
+#endif
}
Tcl_DecrRefCount(exprPtr); /* discard the expression object */
} else {
@@ -3999,6 +4010,7 @@
result = TCL_ERROR;
}
Tcl_DecrRefCount(resultPtr); /* discard the result object */
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
} else {
/*
* Move the interpreter's object result to the string result,
@@ -4006,6 +4018,7 @@
*/
(void) Tcl_GetStringResult(interp);
+#endif
}
Tcl_DecrRefCount(exprPtr); /* discard the expression object */
} else {
@@ -4054,6 +4067,7 @@
}
Tcl_DecrRefCount(resultPtr); /* discard the result object */
}
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
if (result != TCL_OK) {
/*
* Move the interpreter's object result to the string result,
@@ -4062,6 +4076,7 @@
(void) Tcl_GetStringResult(interp);
}
+#endif
Tcl_DecrRefCount(exprPtr); /* discard the expression object */
} else {
/*
@@ -4374,6 +4389,7 @@
TCL_VOLATILE);
}
Tcl_DecrRefCount(resultPtr); /* discard the result object */
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
} else {
/*
* Move the interpreter's object result to the string result,
@@ -4381,6 +4397,7 @@
*/
(void) Tcl_GetStringResult(interp);
+#endif
}
Tcl_DecrRefCount(exprPtr); /* discard the expression object */
} else {
@@ -4490,6 +4507,7 @@
*/
if (iPtr->errorInfo == NULL) { /* just starting to log error */
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
if (iPtr->result[0] != 0) {
/*
* The interp's string result is set, apparently by some
@@ -4499,7 +4517,9 @@
* it, until we drop support for interp->result completely.
*/
iPtr->errorInfo = Tcl_NewStringObj(interp->result, -1);
- } else {
+ } else
+#endif
+ {
iPtr->errorInfo = iPtr->objResultPtr;
}
Tcl_IncrRefCount(iPtr->errorInfo);
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:09:10 -0000
@@ -60,12 +60,14 @@
Tcl_IncrRefCount(cmdPtr);
result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
/*
* Move the interpreter's object result to the string result,
* then reset the object result.
*/
(void) Tcl_GetStringResult(interp);
+#endif
/*
* 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:09:10 -0000
@@ -682,6 +682,9 @@
* local variables recognized at compile time.
*/
+#ifndef USE_DIRECT_INTERP_RESULT_ACCESS
+#define Interp Tcl_Interp
+#endif
typedef struct Proc {
struct Interp *iPtr; /* Interpreter for which this command
* is defined. */
@@ -1215,7 +1218,11 @@
*----------------------------------------------------------------
*/
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
typedef struct Interp {
+#else
+struct Tcl_Interp {
+#endif
/*
* Note: the first three fields must match exactly the fields in
@@ -1464,7 +1471,11 @@
ByteCodeStats stats; /* Holds compilation and execution
* statistics for this interpreter. */
#endif /* TCL_COMPILE_STATS */
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
} Interp;
+#else
+};
+#endif
/*
* 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:09:11 -0000
@@ -26,8 +26,10 @@
static Tcl_Obj ** GetKeys();
static void ReleaseKeys _ANSI_ARGS_((ClientData clientData));
static void ResetObjResult _ANSI_ARGS_((Interp *iPtr));
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
static void SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,
int newSpace));
+#endif
/*
* This structure is used to take a snapshot of the interpreter
@@ -233,6 +235,7 @@
iPtr->objResultPtr = Tcl_NewObj();
Tcl_IncrRefCount(iPtr->objResultPtr);
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
/*
* Save the string result.
*/
@@ -270,6 +273,7 @@
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
iPtr->freeProc = 0;
+#endif
}
/*
@@ -299,6 +303,7 @@
Tcl_ResetResult(interp);
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
/*
* Restore the string result.
*/
@@ -331,6 +336,7 @@
iPtr->result = statePtr->result;
}
+#endif
/*
* Restore the object result.
@@ -365,6 +371,7 @@
{
TclDecrRefCount(statePtr->objResultPtr);
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
if (statePtr->result == statePtr->appendResult) {
ckfree(statePtr->appendResult);
} else if (statePtr->freeProc) {
@@ -374,6 +381,7 @@
(*statePtr->freeProc)(statePtr->result);
}
}
+#endif
}
/*
@@ -403,6 +411,7 @@
* TCL_STATIC, TCL_VOLATILE, or the address
* of a Tcl_FreeProc such as free. */
{
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
Interp *iPtr = (Interp *) interp;
int length;
register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
@@ -446,6 +455,17 @@
*/
ResetObjResult(iPtr);
+#else
+ 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 {
+ (*freeProc)(stringPtr);
+ }
+#endif
}
/*
@@ -469,6 +489,7 @@
Tcl_GetStringResult(interp)
register Tcl_Interp *interp; /* Interpreter whose result to return. */
{
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
/*
* If the string result is empty, move the object result to the
* string result, then reset the object result.
@@ -479,6 +500,10 @@
TCL_VOLATILE);
}
return interp->result;
+#else
+ Interp *iPtr = (Interp *)interp;
+ return Tcl_GetString(iPtr->objResultPtr);
+#endif
}
/*
@@ -522,6 +547,7 @@
TclDecrRefCount(oldObjResult);
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
/*
* Reset the string result since we just set the result object.
*/
@@ -536,6 +562,7 @@
}
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
+#endif
}
/*
@@ -564,6 +591,7 @@
Tcl_Interp *interp; /* Interpreter whose result to return. */
{
register Interp *iPtr = (Interp *) interp;
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
Tcl_Obj *objResultPtr;
int length;
@@ -590,6 +618,7 @@
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
}
+#endif
return iPtr->objResultPtr;
}
@@ -713,6 +742,7 @@
* add to result. */
{
Interp *iPtr = (Interp *) interp;
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
char *dst;
int size;
int flags;
@@ -754,7 +784,24 @@
flags |= TCL_DONT_QUOTE_HASH;
}
iPtr->appendUsed += Tcl_ConvertElement(stringPtr, dst, flags);
+#else
+ Tcl_Obj *elementPtr = Tcl_NewStringObj(stringPtr, -1);
+ Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
+ int length;
+ 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_AppendObjToObj(iPtr->objResultPtr, listPtr);
+ Tcl_DecrRefCount(listPtr);
+#endif
}
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
/*
*----------------------------------------------------------------------
@@ -835,6 +882,7 @@
Tcl_FreeResult((Tcl_Interp *) iPtr);
iPtr->result = iPtr->appendResult;
}
+#endif
/*
*----------------------------------------------------------------------
@@ -864,6 +912,7 @@
{
register Interp *iPtr = (Interp *) interp;
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
if (iPtr->freeProc != NULL) {
if (iPtr->freeProc == TCL_DYNAMIC) {
ckfree(iPtr->result);
@@ -872,6 +921,7 @@
}
iPtr->freeProc = 0;
}
+#endif
ResetObjResult(iPtr);
}
@@ -903,6 +953,7 @@
register Interp *iPtr = (Interp *) interp;
ResetObjResult(iPtr);
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
if (iPtr->freeProc != NULL) {
if (iPtr->freeProc == TCL_DYNAMIC) {
ckfree(iPtr->result);
@@ -913,6 +964,7 @@
}
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
+#endif
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:09:11 -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:09:12 -0000
@@ -1746,6 +1746,7 @@
Tcl_DString *dsPtr; /* Dynamic string that is to become the
* result of interp. */
{
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
Tcl_ResetResult(interp);
if (dsPtr->string != dsPtr->staticSpace) {
@@ -1757,6 +1758,9 @@
} else {
Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
}
+#else
+ Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
+#endif
dsPtr->string = dsPtr->staticSpace;
dsPtr->length = 0;
@@ -1790,6 +1794,7 @@
Tcl_DString *dsPtr; /* Dynamic string that is to become the
* result of interp. */
{
+#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
Interp *iPtr = (Interp *) interp;
if (dsPtr->string != dsPtr->staticSpace) {
@@ -1828,6 +1833,14 @@
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
+#else
+ int length;
+ char *bytes = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
+
+ Tcl_DStringFree(dsPtr);
+ Tcl_DStringAppend(dsPtr, bytes, length);
+ Tcl_ResetResult(interp);
+#endif
}
/*
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:09:13 -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}
