diff options
| -rw-r--r-- | generic/tclExecute.c | 54 | ||||
| -rw-r--r-- | generic/tclInt.h | 11 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 45 |
3 files changed, 105 insertions, 5 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index c0dc9c0..b9dbdf6 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5299,22 +5299,58 @@ TEBCresume( } } else { /* - * strcmp can't do a simple memcmp in order to handle the - * special Tcl \xC0\x80 null encoding for utf-8. + * In order to handle the special Tcl \xC0\x80 null encoding + * for utf-8, strcmp can't do a simple memcmp. */ - s1 = TclGetStringFromObj(valuePtr, &s1len); - s2 = TclGetStringFromObj(value2Ptr, &s2len); + if (TclCheckEmptyString(valuePtr) > 0) { + s1 = ""; + s1len = 0; + switch (TclCheckEmptyString(value2Ptr)) { + case -1: + s2 = TclGetStringFromObj(value2Ptr, &s2len); + break; + case 0: + /* Synthesize a value for comparison */ + s2 = "1"; + s2len = 1; + break; + case 1: + s2 = ""; + s2len = 0; + } + } else if (TclCheckEmptyString(value2Ptr) > 0) { + s2 = ""; + s2len = 0; + switch (TclCheckEmptyString(valuePtr)) { + case -1: + s1 = TclGetStringFromObj(valuePtr, &s1len); + break; + case 0: + /* Synthesize a value for comparison */ + s1 = "1"; + s1len = 1; + break; + case 1: + s1 = ""; + s1len = 0; + } + } else { + s1 = TclGetStringFromObj(valuePtr, &s1len); + s2 = TclGetStringFromObj(value2Ptr, &s2len); + } + if (checkEq) { memCmpFn = memcmp; } else { memCmpFn = (memCmpFn_t) TclpUtfNcmp2; } + } if (checkEq && (s1len != s2len)) { match = 1; - } else { + } else { /* * The comparison function should compare up to the minimum * byte length only. @@ -5950,6 +5986,14 @@ TEBCresume( value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; + /* + Try to determine, without triggering generation of a string + representation, whether one value is not a number. + */ + if (TclCheckEmptyString(valuePtr) > 0 || TclCheckEmptyString(value2Ptr) > 0) { + goto stringCompare; + } + if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK || GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) { /* diff --git a/generic/tclInt.h b/generic/tclInt.h index 5074378..d353504 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2748,6 +2748,10 @@ MODULE_SCOPE long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS]; MODULE_SCOPE char * tclEmptyStringRep; MODULE_SCOPE char tclEmptyString; +enum CheckEmptyStringResult { + TCL_EMPTYSTRING_UNKNOWN = -1, TCL_EMPTYSTRING_NO, TCL_EMPTYSTRING_YES +}; + /* *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside world, @@ -3953,6 +3957,7 @@ MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr); /* * Functions defined in generic/tclVar.c and currenttly exported only for use @@ -4437,6 +4442,12 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); +#define TclIsPureDict(objPtr) \ + (((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType)) + +#define TclIsPureList(objPtr) \ + (((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclListType)) + /* *---------------------------------------------------------------- * Macro used by the Tcl core to compare Unicode strings. On big-endian diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index db233b3..6cbdd73 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -430,6 +430,7 @@ Tcl_GetCharLength( return length; } + /* * OK, need to work with the object as a string. */ @@ -448,6 +449,50 @@ Tcl_GetCharLength( } return numChars; } + + + +/* + *---------------------------------------------------------------------- + * + * TclCheckEmptyString -- + * + * Determine whether the string value of an object is or would be the + * empty string, without generating a string representation. + * + * Results: + * Returns 1 if empty, 0 if not, and -1 if unknown. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +int +TclCheckEmptyString ( + Tcl_Obj *objPtr +) { + int length = -1; + + if (objPtr->bytes == tclEmptyStringRep) { + return TCL_EMPTYSTRING_YES; + } + + if (TclIsPureList(objPtr)) { + Tcl_ListObjLength(NULL, objPtr, &length); + return length == 0; + } + + if (TclIsPureDict(objPtr)) { + Tcl_DictObjSize(NULL, objPtr, &length); + return length == 0; + } + + if (objPtr->bytes == NULL) { + return TCL_EMPTYSTRING_UNKNOWN; + } + return objPtr->length == 0; +} /* *---------------------------------------------------------------------- |