diff options
| -rw-r--r-- | doc/StringObj.3 | 12 | ||||
| -rw-r--r-- | generic/tcl.decls | 6 | ||||
| -rw-r--r-- | generic/tclDecls.h | 13 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 43 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 3 | ||||
| -rw-r--r-- | generic/tclTestObj.c | 31 | ||||
| -rw-r--r-- | tests/stringObj.test | 21 |
7 files changed, 125 insertions, 4 deletions
diff --git a/doc/StringObj.3 b/doc/StringObj.3 index f53b670..92775f7 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings +Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj, Tcl_IsEmpty \- manipulate Tcl values as strings .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -81,6 +81,9 @@ int .sp Tcl_Obj * \fBTcl_ConcatObj\fR(\fIobjc, objv\fR) +.sp +int +\fBTcl_IsEmpty\fR(\fIfIobjPtr\fR) .fi .SH ARGUMENTS .AS "const Tcl_UniChar" *appendObjPtr in/out @@ -402,6 +405,13 @@ white space, then that value is ignored entirely. This white-space removal was added to make the output of the \fBconcat\fR command cleaner-looking. \fBTcl_ConcatObj\fR returns a pointer to a newly-created value whose ref count is zero. +.PP +The \fBTcl_IsEmpty\fR function returns 1 if \fIobjPtr\fR is the empty +string, 0 otherwise. +It doesn't generate the string representation (unless there +is no other way to do it), so it can safely be called on lists with +billions of elements, or any other data structure for which +it is impossible or expensive to construct the string representation. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_NewStringObj\fR, \fBTcl_NewUnicodeObj\fR, \fBTcl_Format\fR, diff --git a/generic/tcl.decls b/generic/tcl.decls index 78f61ec..cd337cc 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2363,6 +2363,12 @@ declare 689 { # ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- # declare 690 { + int Tcl_IsEmpty(Tcl_Obj *obj) +} + +# ----- BASELINE -- FOR -- 9.1.0 ----- # + +declare 691 { void TclUnusedStubEntry(void) } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 487d524..c8f2eaf 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1867,6 +1867,8 @@ EXTERN Tcl_Obj * Tcl_NewWideUIntObj(Tcl_WideUInt wideValue); EXTERN void Tcl_SetWideUIntObj(Tcl_Obj *objPtr, Tcl_WideUInt uwideValue); /* 690 */ +EXTERN int Tcl_IsEmpty(Tcl_Obj *obj); +/* 691 */ EXTERN void TclUnusedStubEntry(void); typedef struct { @@ -2569,7 +2571,8 @@ typedef struct TclStubs { int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 687 */ Tcl_Obj * (*tcl_NewWideUIntObj) (Tcl_WideUInt wideValue); /* 688 */ void (*tcl_SetWideUIntObj) (Tcl_Obj *objPtr, Tcl_WideUInt uwideValue); /* 689 */ - void (*tclUnusedStubEntry) (void); /* 690 */ + int (*tcl_IsEmpty) (Tcl_Obj *obj); /* 690 */ + void (*tclUnusedStubEntry) (void); /* 691 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3898,8 +3901,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_NewWideUIntObj) /* 688 */ #define Tcl_SetWideUIntObj \ (tclStubsPtr->tcl_SetWideUIntObj) /* 689 */ +#define Tcl_IsEmpty \ + (tclStubsPtr->tcl_IsEmpty) /* 690 */ #define TclUnusedStubEntry \ - (tclStubsPtr->tclUnusedStubEntry) /* 690 */ + (tclStubsPtr->tclUnusedStubEntry) /* 691 */ #endif /* defined(USE_TCL_STUBS) */ @@ -4242,4 +4247,8 @@ extern const TclStubs *tclStubsPtr; #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ Tcl_GetBytesFromObj(NULL, (objPtr), (sizePtr)) +#if TCL_MINOR_VERSION < 1 +# undef Tcl_IsEmpty +#endif + #endif /* _TCLDECLS */ diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 059f8dd..b3e6dec 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -4360,6 +4360,49 @@ ExtendUnicodeRepWithString( } *dst = 0; } + +/* + *---------------------------------------------------------------------- + * + * Tcl_IsEmpty -- + * + * Check whether the obj is the empty string. + * + * Results: + * 1 if the obj is "" + * 0 otherwise + * + * Side effects: + * If there is no other way to determine whethere the string + * representation is the empty string, the string representation + * is generated. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_IsEmpty( + Tcl_Obj *objPtr) +{ + if (objPtr == NULL) { + Tcl_Panic("%s: objPtr is NULL", "Tcl_IsEmpty"); + } + if (!objPtr->bytes) { + if (TclHasInternalRep(objPtr, &tclDictType)) { + /* Since "dict" doesn't have a lengthProc */ + Tcl_Size size; + Tcl_DictObjSize(NULL, objPtr, &size); + return !size; + } + + Tcl_ObjTypeLengthProc *proc = TclObjTypeHasProc(objPtr, lengthProc); + if (proc != NULL) { + return !proc(objPtr); + } + (void)TclGetString(objPtr); + } + return !objPtr->length; +} /* *---------------------------------------------------------------------- diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 6ecd8dc..74c709e 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1509,7 +1509,8 @@ const TclStubs tclStubs = { Tcl_UtfNcasecmp, /* 687 */ Tcl_NewWideUIntObj, /* 688 */ Tcl_SetWideUIntObj, /* 689 */ - TclUnusedStubEntry, /* 690 */ + Tcl_IsEmpty, /* 690 */ + TclUnusedStubEntry, /* 691 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index f73483b..89478fb 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -46,6 +46,7 @@ static Tcl_ObjCmdProc TestlistobjCmd; static Tcl_ObjCmdProc TestobjCmd; static Tcl_ObjCmdProc TeststringobjCmd; static Tcl_ObjCmdProc TestbigdataCmd; +static Tcl_ObjCmdProc TestisemptyCmd; #define VARPTR_KEY "TCLOBJTEST_VARPTR" #define NUMBER_OF_OBJECT_VARS 20 @@ -133,6 +134,8 @@ TclObjTest_Init( Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testisempty", TestisemptyCmd, + NULL, NULL); if (sizeof(Tcl_Size) == sizeof(Tcl_WideInt)) { Tcl_CreateObjCommand(interp, "testbigdata", TestbigdataCmd, NULL, NULL); @@ -1829,6 +1832,34 @@ CheckIfVarUnset( } /* + * Throw-away illustrative case to illustrate Tcl_IsEmpty bug + * No error checks etc... + */ +static int +TestisemptyCmd ( + TCL_UNUSED(void *), + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Tcl_Obj *result; + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "value"); + return TCL_ERROR; + } + result = Tcl_NewIntObj(Tcl_IsEmpty(objv[1])); + if (!objv[1]->bytes) { + Tcl_AppendToObj(result, " pure", TCL_INDEX_NONE); + } + if (objv[1]->typePtr) { + Tcl_AppendToObj(result, " ", TCL_INDEX_NONE); + Tcl_AppendToObj(result, objv[1]->typePtr->name, TCL_INDEX_NONE); + } + Tcl_SetObjResult(interp, result); + return TCL_OK; +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/tests/stringObj.test b/tests/stringObj.test index 4c78d82..fb7e796 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -21,6 +21,7 @@ if {"::tcltest" ni [namespace children]} { catch [list package require -exact tcl::test [info patchlevel]] testConstraint testobj [llength [info commands testobj]] +testConstraint testisempty [llength [info commands testisempty]] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testdstring [llength [info commands testdstring]] @@ -527,6 +528,26 @@ test stringObj-16.12 {Tcl_GetRange: first = last = SIZE_MAX-1} testobj { set i [expr {$SIZE_MAX - 1}] teststringobj range 1 $i $i } {} + +test stringObj-17.1 {Tcl_StringIsEmpty, handle list} testisempty { + set x "abc" + lappend x "def" + testisempty $x +} {0 pure list} +test stringObj-17.2 {Tcl_StringIsEmpty, handle empty list} testisempty { + set x "abc" + set x [lreplace x 0 end] + list $x {*}[testisempty $x] +} {{} 1 pure list} +test stringObj-17.3 {Tcl_StringIsEmpty, handle dict} testisempty { + set x "1 abc" + set x [dict set $x 2 "def"] + testisempty $x +} {0 pure dict} +test stringObj-17.4 {Tcl_StringIsEmpty, handle integer} testisempty { + testisempty [expr {3+4}] +} {0 pure int} + if {[testConstraint testobj]} { testobj freeallvars |