Rebase to 9.1core-tip-711

5 files changed, 93 insertions, 3 deletions

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