From c3ae5e61f6ca39d349312f5e18eb1a45649844f0 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 11 Mar 2007 16:54:57 +0000 Subject: Fix [Bug 1675044] --- ChangeLog | 12 +++++++++--- generic/tclCmdIL.c | 18 +++++++++++++++--- 2 files changed, 24 insertions(+), 6 deletions(-) diff --git a/ChangeLog b/ChangeLog index af595f9..3d943df 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,8 +1,14 @@ +2007-03-11 Donal K. Fellows + + * generic/tclCmdIL.c (Tcl_LreverseObjCmd): Ensure that a list is + correctly reversed even if its internal representation is shared + without the object itself being shared. [Bug 1675044] + 2007-03-10 Miguel Sofer - * generic/tclCmdIL (Tcl_LsortObjCmd): changed fix to [Bug 1675116] - to use the cheaper TclListObjCopy() instead of Tcl_DuplicateObj() - + * generic/tclCmdIL (Tcl_LsortObjCmd): changed fix to [Bug 1675116] to + use the cheaper TclListObjCopy() instead of Tcl_DuplicateObj(). + 2007-03-09 Andreas Kupries * library/platform/shell.tcl: Made more robust if an older platform diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 94b18b7..c143304 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.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: tclCmdIL.c,v 1.110 2007/03/10 15:24:26 msofer Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.111 2007/03/11 16:54:57 dkf Exp $ */ #include "tclInt.h" @@ -3086,10 +3086,11 @@ Tcl_LreverseObjCmd( } if (Tcl_IsShared(objv[1])) { - Tcl_Obj *resultObj = Tcl_NewListObj(elemc, NULL); - Tcl_Obj **dataArray; + Tcl_Obj *resultObj, **dataArray; List *listPtr; + makeNewReversedList: + resultObj = Tcl_NewListObj(elemc, NULL); listPtr = (List *) resultObj->internalRep.twoPtrValue.ptr1; listPtr->elemCount = elemc; dataArray = &listPtr->elements; @@ -3102,12 +3103,23 @@ Tcl_LreverseObjCmd( Tcl_SetObjResult(interp, resultObj); } else { /* + * It is theoretically possible for a list object to have a shared + * internal representation, but be an unshared object. Check for this + * and use the "shared" code if we have that problem. [Bug 1675044] + */ + + if (((List *) objv[1]->internalRep.twoPtrValue.ptr1)->refCount > 1) { + goto makeNewReversedList; + } + + /* * Not shared, so swap "in place". This relies on Tcl_LOGE above * returning a pointer to the live array of Tcl_Obj values. */ for (i=0,j=elemc-1 ; i