diff options
Diffstat (limited to 'generic/tclTestObj.c')
| -rw-r--r-- | generic/tclTestObj.c | 31 |
1 files changed, 31 insertions, 0 deletions
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 |