From 1c72973d895e9efb23ecda2553cee0a5a901f650 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 2 Oct 2008 20:59:45 +0000 Subject: TIP #330 IMPLEMENTATION * generic/tcl.h: Remove the "result" and "freeProc" fields * generic/tclBasic.c: from the default public declaration of the * generic/tclResult.c: Tcl_Interp struct. Code should no longer * generic/tclStubLib.c: be accessing these fields. Access can be * generic/tclTest.c: restored by defining USE_INTERP_RESULT, but * generic/tclUtil.c: that should only be a temporary migration aid. *** POTENTIAL INCOMPATIBILITY *** --- ChangeLog | 12 ++++++++++++ generic/tcl.h | 8 +++++++- generic/tclBasic.c | 6 +++--- generic/tclResult.c | 7 ++++--- generic/tclStubLib.c | 6 +++--- generic/tclTest.c | 16 +++++++++------- generic/tclUtil.c | 11 ++++++----- 7 files changed, 44 insertions(+), 22 deletions(-) diff --git a/ChangeLog b/ChangeLog index b341eb9..9b547b0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2008-10-02 Don Porter + + TIP #330 IMPLEMENTATION + + * generic/tcl.h: Remove the "result" and "freeProc" fields + * generic/tclBasic.c: from the default public declaration of the + * generic/tclResult.c: Tcl_Interp struct. Code should no longer + * generic/tclStubLib.c: be accessing these fields. Access can be + * generic/tclTest.c: restored by defining USE_INTERP_RESULT, but + * generic/tclUtil.c: that should only be a temporary migration aid. + *** POTENTIAL INCOMPATIBILITY *** + 2008-10-02 Joe Mistachkin * doc/info.n: Fix unmatched font change. diff --git a/generic/tcl.h b/generic/tcl.h index 39c578a..abe1157 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.270 2008/09/03 05:43:31 dgp Exp $ + * RCS: @(#) $Id: tcl.h,v 1.271 2008/10/02 20:59:45 dgp Exp $ */ #ifndef _TCL @@ -458,6 +458,8 @@ typedef struct stat Tcl_StatBuf; */ typedef struct Tcl_Interp { + /* TIP #330: Strongly discourage extensions from using the string result. */ +#ifdef USE_INTERP_RESULT char *result; /* If the last command returned a string * result, this points to it. */ void (*freeProc) (char *blockPtr); @@ -468,6 +470,10 @@ typedef struct Tcl_Interp { * of function to invoke to free the result. * Tcl_Eval must free it before executing next * command. */ +#else + char* unused3; + void (*unused4) (char*); +#endif int errorLine; /* When TCL_ERROR is returned, this gives the * line number within the command where the * error occurred (1 if first line). */ diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 1467523..d0a8635 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.368 2008/09/28 13:46:09 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.369 2008/10/02 20:59:45 dgp Exp $ */ #include "tclInt.h" @@ -1445,7 +1445,7 @@ DeleteInterpProc( */ Tcl_FreeResult(interp); - interp->result = NULL; + iPtr->result = NULL; Tcl_DecrRefCount(iPtr->objResultPtr); iPtr->objResultPtr = NULL; Tcl_DecrRefCount(iPtr->ecVar); @@ -6558,7 +6558,7 @@ Tcl_AddObjErrorInfo( * interp->result completely. */ - iPtr->errorInfo = Tcl_NewStringObj(interp->result, -1); + iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1); } else { iPtr->errorInfo = iPtr->objResultPtr; } diff --git a/generic/tclResult.c b/generic/tclResult.c index ea62946..b91d6ef 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclResult.c,v 1.48 2008/04/27 22:21:32 dkf Exp $ + * RCS: @(#) $Id: tclResult.c,v 1.49 2008/10/02 20:59:45 dgp Exp $ */ #include "tclInt.h" @@ -471,11 +471,12 @@ Tcl_GetStringResult( * result, then reset the object result. */ - if (*(interp->result) == 0) { + Interp* iPtr = (Interp*) interp; + if (*(iPtr->result) == 0) { Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), TCL_VOLATILE); } - return interp->result; + return iPtr->result; } /* diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 168676f..9b8f390 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubLib.c,v 1.26 2008/04/27 22:21:32 dkf Exp $ + * RCS: @(#) $Id: tclStubLib.c,v 1.27 2008/10/02 20:59:45 dgp Exp $ */ /* @@ -46,9 +46,9 @@ HasStubSupport( return iPtr->stubTable; } - interp->result = + iPtr->result = "This interpreter does not support stubs-enabled extensions."; - interp->freeProc = TCL_STATIC; + iPtr->freeProc = TCL_STATIC; return NULL; } diff --git a/generic/tclTest.c b/generic/tclTest.c index be7853e..b6230df 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTest.c,v 1.124 2008/08/20 13:14:41 dkf Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.125 2008/10/02 20:59:45 dgp Exp $ */ #define TCL_TEST @@ -1593,6 +1593,7 @@ TestdstringCmd( const char **argv) /* Argument strings. */ { int count; + Interp* iPtr = (Interp*) interp; if (argc < 2) { wrongNumArgs: @@ -1637,12 +1638,12 @@ TestdstringCmd( 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"); + strcpy(iPtr->result, "This is a malloc-ed string"); } 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"); + iPtr->result = (char *) ckalloc(100); + iPtr->result += 4; + iPtr->freeProc = SpecialFree; + strcpy(iPtr->result, "This is a specially-allocated string"); } else { Tcl_AppendResult(interp, "bad gresult option \"", argv[2], "\": must be staticsmall, staticlarge, free, or special", @@ -4847,6 +4848,7 @@ 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; @@ -4915,7 +4917,7 @@ TestsaveresultCmd( switch ((enum options) index) { case RESULT_DYNAMIC: { - int present = interp->freeProc == TestsaveresultFree; + int present = iPtr->freeProc == TestsaveresultFree; int called = freeCount; Tcl_AppendElement(interp, called ? "called" : "notCalled"); diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 22b9e73..1a93a32 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUtil.c,v 1.103 2008/08/22 18:01:00 dgp Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.104 2008/10/02 20:59:45 dgp Exp $ */ #include "tclInt.h" @@ -2065,14 +2065,15 @@ Tcl_DStringResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the * result of interp. */ { + Interp* iPtr = (Interp*) interp; Tcl_ResetResult(interp); if (dsPtr->string != dsPtr->staticSpace) { - interp->result = dsPtr->string; - interp->freeProc = TCL_DYNAMIC; + iPtr->result = dsPtr->string; + iPtr->freeProc = TCL_DYNAMIC; } else if (dsPtr->length < TCL_RESULT_SIZE) { - interp->result = ((Interp *) interp)->resultSpace; - strcpy(interp->result, dsPtr->string); + iPtr->result = iPtr->resultSpace; + strcpy(iPtr->result, dsPtr->string); } else { Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE); } -- cgit v0.12