diff options
Diffstat (limited to 'generic/tclObj.c')
-rw-r--r-- | generic/tclObj.c | 40 |
1 files changed, 39 insertions, 1 deletions
diff --git a/generic/tclObj.c b/generic/tclObj.c index edc203c..46758fa 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclObj.c,v 1.153 2009/06/18 09:41:29 dkf Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.154 2009/08/02 13:03:47 dkf Exp $ */ #include "tclInt.h" @@ -3962,6 +3962,44 @@ SetCmdNameFromAny( } /* + *---------------------------------------------------------------------- + * + * Tcl_RepresentationCmd -- + * + * Implementation of the "tcl::unsupported::representation" command. + * + * Results: + * Reports the current representation (Tcl_Obj type) of its argument. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_RepresentationCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "value"); + return TCL_ERROR; + } + + if (objv[1]->typePtr == NULL) { + Tcl_AppendResult(interp, "value has no internal representation set", + NULL); + } else { + Tcl_AppendResult(interp, "value has internal representation of ", + objv[1]->typePtr->name, " currently", NULL); + } + return TCL_OK; +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 |