From 62f180300bf74ab95b1cb7957c5ff85a66e24f6a Mon Sep 17 00:00:00 2001 From: griffin Date: Wed, 12 Jul 2023 03:06:54 +0000 Subject: Fix foreach bug [a34733451b]. Other code cleanup discovered by code review. --- generic/tclCmdAH.c | 3 +-- generic/tclExecute.c | 23 ++++++++++++++--------- generic/tclInt.h | 21 ++++++++++++++------- generic/tclListObj.c | 14 +++----------- 4 files changed, 32 insertions(+), 29 deletions(-) diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index b2e9a76..3b9e5ba 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -2787,8 +2787,7 @@ EachloopCmd( for (i=0 ; ivCopyList[i] = TclDuplicatePureObj( - interp, objv[1+i*2], &tclListType); + statePtr->vCopyList[i] = Tcl_DuplicateObj(objv[1+i*2]); if (!statePtr->vCopyList[i]) { result = TCL_ERROR; goto done; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 973ba8e..b9cf44b 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4685,6 +4685,7 @@ TEBCresume( TRACE_ERROR(interp); goto gotError; } + CACHE_STACK_INFO(); Tcl_IncrRefCount(objResultPtr); // reference held here goto lindexDone; } @@ -4768,14 +4769,18 @@ TEBCresume( /* Decode end-offset index values. */ index = TclIndexDecode(opnd, length-1); - /* Compute value @ index */ - DECACHE_STACK_INFO(); - if (TclObjTypeIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) { + if (index >= 0 && index < length) { + /* Compute value @ index */ + DECACHE_STACK_INFO(); + if (TclObjTypeIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) { + CACHE_STACK_INFO(); + TRACE_ERROR(interp); + goto gotError; + } CACHE_STACK_INFO(); - TRACE_ERROR(interp); - goto gotError; + } else { + TclNewObj(objResultPtr); } - CACHE_STACK_INFO(); pcAdjustment = 5; goto lindexFastPath2; @@ -4854,9 +4859,8 @@ TEBCresume( * Compute the new variable value. */ + DECACHE_STACK_INFO(); if (TclObjTypeHasProc(valuePtr, setElementProc)) { - - DECACHE_STACK_INFO(); objResultPtr = TclObjTypeSetElement(interp, valuePtr, numIndices, &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); @@ -4985,8 +4989,8 @@ TEBCresume( fromIdx = TclIndexDecode(fromIdx, objc - 1); + DECACHE_STACK_INFO(); if (TclObjTypeHasProc(valuePtr, sliceProc)) { - DECACHE_STACK_INFO(); if (TclObjTypeSlice(interp, valuePtr, fromIdx, toIdx, &objResultPtr) != TCL_OK) { objResultPtr = NULL; } @@ -6458,6 +6462,7 @@ TEBCresume( i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } + CACHE_STACK_INFO(); if (Tcl_IsShared(listPtr)) { objPtr = TclDuplicatePureObj( interp, listPtr, &tclListType); diff --git a/generic/tclInt.h b/generic/tclInt.h index 697b685..29b19a8 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1109,7 +1109,8 @@ MODULE_SCOPE Tcl_Size TclLengthOne(Tcl_Obj *); static inline Tcl_Size TclObjTypeLength(Tcl_Obj *objPtr) { - return TclObjTypeHasProc(objPtr, lengthProc)(objPtr); + Tcl_ObjTypeLengthProc *proc = TclObjTypeHasProc(objPtr, lengthProc); + return proc(objPtr); } static inline int TclObjTypeIndex( @@ -1118,7 +1119,8 @@ TclObjTypeIndex( Tcl_Size index, Tcl_Obj **elemObjPtr) { - return TclObjTypeHasProc(objPtr, indexProc)(interp, objPtr, index, elemObjPtr); + Tcl_ObjTypeIndexProc *proc = TclObjTypeHasProc(objPtr, indexProc); + return proc(interp, objPtr, index, elemObjPtr); } static inline int TclObjTypeSlice( @@ -1128,7 +1130,8 @@ TclObjTypeSlice( Tcl_Size toIdx, Tcl_Obj **newObjPtr) { - return TclObjTypeHasProc(objPtr, sliceProc)(interp, objPtr, fromIdx, toIdx, newObjPtr); + Tcl_ObjTypeSliceProc *proc = TclObjTypeHasProc(objPtr, sliceProc); + return proc(interp, objPtr, fromIdx, toIdx, newObjPtr); } static inline int TclObjTypeReverse( @@ -1136,7 +1139,8 @@ TclObjTypeReverse( Tcl_Obj *objPtr, Tcl_Obj **newObjPtr) { - return TclObjTypeHasProc(objPtr, reverseProc)(interp, objPtr, newObjPtr); + Tcl_ObjTypeReverseProc *proc = TclObjTypeHasProc(objPtr, reverseProc); + return proc(interp, objPtr, newObjPtr); } static inline int TclObjTypeGetElements( @@ -1145,7 +1149,8 @@ TclObjTypeGetElements( Tcl_Size *objCPtr, Tcl_Obj ***objVPtr) { - return TclObjTypeHasProc(objPtr, getElementsProc)(interp, objPtr, objCPtr, objVPtr); + Tcl_ObjTypeGetElements *proc = TclObjTypeHasProc(objPtr, getElementsProc); + return proc(interp, objPtr, objCPtr, objVPtr); } static inline Tcl_Obj* TclObjTypeSetElement( @@ -1155,7 +1160,8 @@ TclObjTypeSetElement( Tcl_Obj *const indexArray[], Tcl_Obj *valueObj) { - return TclObjTypeHasProc(objPtr, setElementProc)(interp, objPtr, indexCount, indexArray, valueObj); + Tcl_ObjTypeSetElement *proc = TclObjTypeHasProc(objPtr, setElementProc); + return proc(interp, objPtr, indexCount, indexArray, valueObj); } static inline int TclObjTypeReplace( @@ -1166,7 +1172,8 @@ TclObjTypeReplace( Tcl_Size numToInsert, Tcl_Obj *const insertObjs[]) { - return TclObjTypeHasProc(objPtr, replaceProc)(interp, objPtr, first, numToDelete, numToInsert, insertObjs); + Tcl_ObjTypeReplaceProc *proc = TclObjTypeHasProc(objPtr, replaceProc); + return proc(interp, objPtr, first, numToDelete, numToInsert, insertObjs); } #endif /* TCL_MAJOR_VERSION > 8 */ diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 4b8530c..7b7b9e9 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -156,14 +156,7 @@ const Tcl_ObjType tclListType = { DupListInternalRep, /* dupIntRepProc */ UpdateStringOfList, /* updateStringProc */ SetListFromAny, /* setFromAnyProc */ - TCL_OBJTYPE_V2( - ListLength, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL) + TCL_OBJTYPE_V1(ListLength) }; /* Macros to manipulate the List internal rep */ @@ -1626,9 +1619,8 @@ Tcl_ListObjGetElements( { ListRep listRep; - if (TclObjTypeHasProc(objPtr, getElementsProc) && - TclObjTypeGetElements(interp, objPtr, objcPtr, objvPtr) == TCL_OK) { - return TCL_OK; + if (TclObjTypeHasProc(objPtr, getElementsProc)) { + return TclObjTypeGetElements(interp, objPtr, objcPtr, objvPtr); } if (TclListObjGetRep(interp, objPtr, &listRep) != TCL_OK) { return TCL_ERROR; -- cgit v0.12