summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2007-01-29 18:55:48 (GMT)
committerdgp <dgp@users.sourceforge.net>2007-01-29 18:55:48 (GMT)
commit078360ebb5939a61b1b6d922a1f35571a5bcd9de (patch)
tree70e75346e6d63c2b2637bf7008595e9223b9b8e3 /generic
parent7f51139e3d27166a80151f2c150f84fbc3ee28b2 (diff)
downloadtcl-078360ebb5939a61b1b6d922a1f35571a5bcd9de.zip
tcl-078360ebb5939a61b1b6d922a1f35571a5bcd9de.tar.gz
tcl-078360ebb5939a61b1b6d922a1f35571a5bcd9de.tar.bz2
* 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].
Diffstat (limited to 'generic')
-rw-r--r--generic/tclResult.c22
1 files changed, 17 insertions, 5 deletions
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);
}