From 2d54b6822452d67937fbcd365c9af9041f9f99f1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 15 Feb 2018 18:02:00 +0000 Subject: Distingish between boolean and int when checking whether a boolean is true or not: The internal representation might be either long or wideInt. --- generic/tclCmdMZ.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 7f38eca..a11e693 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1572,11 +1572,11 @@ StringIsCmd( string1 = TclGetStringFromObj(objPtr, &length1); result = length1 == 0; } - } else if (((index == STR_IS_TRUE) && - objPtr->internalRep.longValue == 0) - || ((index == STR_IS_FALSE) && - objPtr->internalRep.longValue != 0)) { - result = 0; + } else if (index != STR_IS_BOOL) { + TclGetBooleanFromObj(NULL, objPtr, &i); + if ((index == STR_IS_TRUE) ^ i) { + result = 0; + } } break; case STR_IS_CONTROL: -- cgit v0.12 From 455b61dce391118995a7762609a6f42035cf43a4 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 22 Feb 2018 18:57:20 +0000 Subject: [89dfecb6b7] Make thread IDs in testing commands consistent. --- generic/tclTest.c | 6 +++--- generic/tclThreadTest.c | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 8a59b83..45cca5a 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -5234,7 +5234,7 @@ TestmainthreadCmd( const char **argv) /* Argument strings. */ { if (argc == 1) { - Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread()); + Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread()); Tcl_SetObjResult(interp, idObj); return TCL_OK; @@ -5631,8 +5631,8 @@ TestChannelCmd( return TCL_ERROR; } - TclFormatInt(buf, (size_t) Tcl_GetChannelThread(chan)); - Tcl_AppendResult(interp, buf, NULL); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj( + (Tcl_WideInt) (size_t) Tcl_GetChannelThread(chan))); return TCL_OK; } diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index fcf3880..6fc0e52 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -248,7 +248,7 @@ ThreadObjCmd( switch ((enum options)option) { case THREAD_CANCEL: { - long id; + Tcl_WideInt id; const char *result; int flags, arg; @@ -264,7 +264,7 @@ ThreadObjCmd( arg++; } } - if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) { return TCL_ERROR; } arg++; -- cgit v0.12 From 812174d5782d57e4dbe97e9a1e378a2a2a4eac1f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 22 Feb 2018 20:03:56 +0000 Subject: Correctly distinguish between internalrep.longValue (in case of boolean) and internalre.wideValue (in case of int). Add comment warning for that --- generic/tclGet.c | 2 +- generic/tclObj.c | 12 ++++++++---- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/generic/tclGet.c b/generic/tclGet.c index 2d611fa..12e0e79 100644 --- a/generic/tclGet.c +++ b/generic/tclGet.c @@ -142,7 +142,7 @@ Tcl_GetBoolean( Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } if (code == TCL_OK) { - *boolPtr = (int)obj.internalRep.wideValue; + TclGetBooleanFromObj(NULL, &obj, boolPtr); } return code; } diff --git a/generic/tclObj.c b/generic/tclObj.c index 8d4c492..6d365a2 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1899,7 +1899,7 @@ Tcl_GetBooleanFromObj( return TCL_OK; } if (objPtr->typePtr == &tclBooleanType) { - *boolPtr = (int) objPtr->internalRep.longValue; + *boolPtr = objPtr->internalRep.longValue != 0; return TCL_OK; } if (objPtr->typePtr == &tclDoubleType) { @@ -1943,7 +1943,12 @@ Tcl_GetBooleanFromObj( * * Side effects: * If no error occurs, an integer 1 or 0 is stored as "objPtr"s internal - * representation and the type of "objPtr" is set to boolean. + * representation and the type of "objPtr" is set to boolean or int/wideInt. + * + * Warning: If the returned type is "wideInt" (32-bit platforms) and your + * platform is bigendian, you cannot use internalRep.longValue to distinguish + * between false and true. On Windows and most other platforms this still will + * work fine, but basically it is non-portable. * *---------------------------------------------------------------------- */ @@ -1961,8 +1966,7 @@ TclSetBooleanFromAny( if (objPtr->bytes == NULL) { if (objPtr->typePtr == &tclIntType) { - switch (objPtr->internalRep.wideValue) { - case 0L: case 1L: + if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) { return TCL_OK; } goto badBoolean; -- cgit v0.12 From 4ad7747c62ec01498c6452f516702b1fe7e5f775 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 23 Feb 2018 15:44:10 +0000 Subject: Cease registration of the "end-offset" Tcl_ObjType. Give it file scope. Remove the updateStringProc that can never be called. --- generic/tclObj.c | 1 - generic/tclUtil.c | 53 +++++++++-------------------------------------------- 2 files changed, 9 insertions(+), 45 deletions(-) diff --git a/generic/tclObj.c b/generic/tclObj.c index 6d365a2..7b9488e 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -400,7 +400,6 @@ TclInitObjSubsystem(void) Tcl_RegisterObjType(&tclByteArrayType); Tcl_RegisterObjType(&tclDoubleType); - Tcl_RegisterObjType(&tclEndOffsetType); Tcl_RegisterObjType(&tclStringType); Tcl_RegisterObjType(&tclListType); Tcl_RegisterObjType(&tclDictType); diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 9557aac..a5a129d 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -110,7 +110,6 @@ static void FreeThreadHash(ClientData clientData); static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr); static int SetEndOffsetFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); -static void UpdateStringOfEndOffset(Tcl_Obj *objPtr); static int FindElement(Tcl_Interp *interp, const char *string, int stringLength, const char *typeStr, const char *typeCode, const char **elementPtr, @@ -119,15 +118,18 @@ static int FindElement(Tcl_Interp *interp, const char *string, /* * The following is the Tcl object type definition for an object that * represents a list index in the form, "end-offset". It is used as a - * performance optimization in TclGetIntForIndex. The internal rep is an - * integer, so no memory management is required for it. + * performance optimization in TclGetIntForIndex. The internal rep is + * stored directly in the wideValue, so no memory management is required + * for it. This is a caching intrep, keeping the result of a parse + * around. This type is only created from a pre-existing string, so an + * updateStringProc will never be called and need not exist. */ -const Tcl_ObjType tclEndOffsetType = { +static const Tcl_ObjType endOffsetType = { "end-offset", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ - UpdateStringOfEndOffset, /* updateStringProc */ + NULL, /* updateStringProc */ SetEndOffsetFromAny }; @@ -3652,43 +3654,6 @@ TclGetIntForIndex( /* *---------------------------------------------------------------------- * - * UpdateStringOfEndOffset -- - * - * Update the string rep of a Tcl object holding an "end-offset" - * expression. - * - * Results: - * None. - * - * Side effects: - * Stores a valid string in the object's string rep. - * - * This function does NOT free any earlier string rep. If it is called on an - * object that already has a valid string rep, it will leak memory. - * - *---------------------------------------------------------------------- - */ - -static void -UpdateStringOfEndOffset( - register Tcl_Obj *objPtr) -{ - char buffer[TCL_INTEGER_SPACE + 5]; - register int len = 3; - - memcpy(buffer, "end", 4); - if (objPtr->internalRep.wideValue != 0) { - buffer[len++] = '-'; - len += TclFormatInt(buffer+len, -(objPtr->internalRep.wideValue)); - } - objPtr->bytes = ckalloc((unsigned) len+1); - memcpy(objPtr->bytes, buffer, (unsigned) len+1); - objPtr->length = len; -} - -/* - *---------------------------------------------------------------------- - * * SetEndOffsetFromAny -- * * Look for a string of the form "end[+-]offset" and convert it to an @@ -3717,7 +3682,7 @@ SetEndOffsetFromAny( * If it's already the right type, we're fine. */ - if (objPtr->typePtr == &tclEndOffsetType) { + if (objPtr->typePtr == &endOffsetType) { return TCL_OK; } @@ -3783,7 +3748,7 @@ SetEndOffsetFromAny( TclFreeIntRep(objPtr); objPtr->internalRep.wideValue = offset; - objPtr->typePtr = &tclEndOffsetType; + objPtr->typePtr = &endOffsetType; return TCL_OK; } -- cgit v0.12 From 85233a46935b192d7baf5fa81c9ad21bfebeca77 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 23 Feb 2018 16:55:49 +0000 Subject: [8e6a9ac221] Stop false matching with bytearrays. (string-11.55) --- generic/tclUtil.c | 3 ++- tests/string.test | 3 +++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 34d4be2..d782ea1 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2340,7 +2340,8 @@ TclStringMatchObj( udata = Tcl_GetUnicodeFromObj(strObj, &length); uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen); match = TclUniCharMatch(udata, length, uptn, plen, flags); - } else if (TclIsPureByteArray(strObj) && !flags) { + } else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj) + && !flags) { unsigned char *data, *ptn; data = Tcl_GetByteArrayFromObj(strObj, &length); diff --git a/tests/string.test b/tests/string.test index 7a7a749..39abd86 100644 --- a/tests/string.test +++ b/tests/string.test @@ -1111,6 +1111,9 @@ test string-11.54 {string match, failure} { [string match *a*l*\u0000*cba* $longString] \ [string match *===* $longString] } {0 1 1 1 0 0} +test string-11.55 {string match, invalid binary optimization} { + [format string] match \u0141 [binary format c 65] +} 0 test string-12.1 {string range} { list [catch {string range} msg] $msg -- cgit v0.12 From 9090aca429d0d8ba6abfa8a1f8fc9f91338052cd Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 23 Feb 2018 17:17:47 +0000 Subject: Remove tests of "end-offset" Tcl_ObjType, taken private. --- tests/obj.test | 47 ----------------------------------------------- 1 file changed, 47 deletions(-) diff --git a/tests/obj.test b/tests/obj.test index 833c906..cb62d3f 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -30,7 +30,6 @@ test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} tes bytecode cmdName dict - end-offset regexp string } { @@ -52,15 +51,6 @@ test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} testobj { lappend result [testobj refcount 1] } {{} 12 12 bytearray 3} -test obj-3.1 {Tcl_ConvertToType error} testobj { - list [testdoubleobj set 1 12.34] \ - [catch {testobj convert 1 end-offset} msg] \ - $msg -} {12.34 1 {bad index "12.34": must be end?[+-]integer?}} -test obj-3.2 {Tcl_ConvertToType error, "empty string" object} testobj { - list [testobj newobj 1] [catch {testobj convert 1 end-offset} msg] $msg -} {{} 1 {bad index "": must be end?[+-]integer?}} - test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} testobj { set result "" lappend result [testobj freeallvars] @@ -551,43 +541,6 @@ test obj-30.1 {Ref counting and object deletion, simple types} testobj { } {{} 1024 1024 int 4 4 0 int 3 2} -test obj-31.1 {regenerate string rep of "end"} testobj { - testobj freeallvars - teststringobj set 1 end - testobj convert 1 end-offset - testobj invalidateStringRep 1 -} end -test obj-31.2 {regenerate string rep of "end-1"} testobj { - testobj freeallvars - teststringobj set 1 end-0x1 - testobj convert 1 end-offset - testobj invalidateStringRep 1 -} end-1 -test obj-31.3 {regenerate string rep of "end--1"} testobj { - testobj freeallvars - teststringobj set 1 end--0x1 - testobj convert 1 end-offset - testobj invalidateStringRep 1 -} end--1 -test obj-31.4 {regenerate string rep of "end-bigInteger"} testobj { - testobj freeallvars - teststringobj set 1 end-0x7fffffff - testobj convert 1 end-offset - testobj invalidateStringRep 1 -} end-2147483647 -test obj-31.5 {regenerate string rep of "end--bigInteger"} testobj { - testobj freeallvars - teststringobj set 1 end--0x7fffffff - testobj convert 1 end-offset - testobj invalidateStringRep 1 -} end--2147483647 -test obj-31.6 {regenerate string rep of "end--bigInteger"} {testobj longIs32bit} { - testobj freeallvars - teststringobj set 1 end--0x80000000 - testobj convert 1 end-offset - testobj invalidateStringRep 1 -} end--2147483648 - test obj-32.1 {freeing very large object trees} { set x {} for {set i 0} {$i<100000} {incr i} { -- cgit v0.12 From 6faf2feff2aa8ca778eccc29cb8c43c14ea6199d Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 23 Feb 2018 17:49:23 +0000 Subject: Don't let presence of a string rep prevent optimizations on "pure" bytearrays. --- generic/tclStringObj.c | 32 ++++++++++++++------------------ 1 file changed, 14 insertions(+), 18 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index f527426..26a3a28 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -481,8 +481,7 @@ Tcl_GetUniChar( /* * Optimize the case where we're really dealing with a bytearray object - * without string representation; we don't need to convert to a string to - * perform the indexing operation. + * we don't need to convert to a string to perform the indexing operation. */ if (TclIsPureByteArray(objPtr)) { @@ -615,8 +614,7 @@ Tcl_GetRange( /* * Optimize the case where we're really dealing with a bytearray object - * without string representation; we don't need to convert to a string to - * perform the substring operation. + * we don't need to convert to a string to perform the substring operation. */ if (TclIsPureByteArray(objPtr)) { @@ -1224,9 +1222,9 @@ Tcl_AppendObjToObj( /* * Handle append of one bytearray object to another as a special case. - * Note that we only do this when the objects don't have string reps; if - * it did, then appending the byte arrays together could well lose - * information; this is a special-case optimization only. + * Note that we only do this when the objects are pure so that the + * bytearray faithfully represent the true value; Otherwise + * appending the byte arrays together could lose information; */ if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString) @@ -2915,7 +2913,9 @@ TclStringCat( do { Tcl_Obj *objPtr = *ov++; - if (objPtr->bytes) { + if (TclIsPureByteArray(objPtr)) { + allowUniChar = 0; + } else if (objPtr->bytes) { /* Value has a string rep. */ if (objPtr->length) { /* @@ -2930,17 +2930,13 @@ TclStringCat( } } else { /* assert (objPtr->typePtr != NULL) -- stork! */ - if (TclIsPureByteArray(objPtr)) { - allowUniChar = 0; + binary = 0; + if (objPtr->typePtr == &tclStringType) { + /* Have a pure Unicode value; ask to preserve it */ + requestUniChar = 1; } else { - binary = 0; - if (objPtr->typePtr == &tclStringType) { - /* Have a pure Unicode value; ask to preserve it */ - requestUniChar = 1; - } else { - /* Have another type; prevent shimmer */ - allowUniChar = 0; - } + /* Have another type; prevent shimmer */ + allowUniChar = 0; } } } while (--oc && (binary || allowUniChar)); -- cgit v0.12