diff options
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | generic/tclResult.c | 22 |
2 files changed, 21 insertions, 5 deletions
@@ -1,5 +1,9 @@ 2007-01-29 Don Porter <dgp@users.sourceforge.net> + * generic/tclResult.c: Added optimization case to TclTransferResult + to cover common case where there's big savings over the fully general + path. Thanks to Peter MacDonald. [Bug 1626518]. + * generic/tclLink.c: Broken linked float logic corrected. Thanks to Andy Goth [Bug 1602538]. diff --git a/generic/tclResult.c b/generic/tclResult.c index 37f037b..1d56e6f 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.32 2005/11/02 00:55:06 dkf Exp $ + * RCS: @(#) $Id: tclResult.c,v 1.33 2007/01/29 18:55:50 dgp Exp $ */ #include "tclInt.h" @@ -1542,15 +1542,27 @@ TclTransferResult( * should be stored. If source and target are * the same, nothing is done. */ { - Interp *iPtr = (Interp *) targetInterp; + Interp *tiPtr = (Interp *) targetInterp; + Interp *siPtr = (Interp *) sourceInterp; if (sourceInterp == targetInterp) { return; } - Tcl_SetReturnOptions(targetInterp, - Tcl_GetReturnOptions(sourceInterp, result)); - iPtr->flags &= ~(ERR_ALREADY_LOGGED); + if (result == TCL_OK && siPtr->returnOpts == NULL) { + /* + * Special optimization for the common case of normal + * command return code and no explicit return options. + */ + if (tiPtr->returnOpts) { + Tcl_DecrRefCount(tiPtr->returnOpts); + tiPtr->returnOpts = NULL; + } + } else { + Tcl_SetReturnOptions(targetInterp, + Tcl_GetReturnOptions(sourceInterp, result)); + tiPtr->flags &= ~(ERR_ALREADY_LOGGED); + } Tcl_SetObjResult(targetInterp, Tcl_GetObjResult(sourceInterp)); Tcl_ResetResult(sourceInterp); } |