summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorferrieux <ferrieux@users.sourceforge.net>2009-09-16 21:17:22 (GMT)
committerferrieux <ferrieux@users.sourceforge.net>2009-09-16 21:17:22 (GMT)
commitb7c880a857b80f8c7e8c5338bf18a0bedd499061 (patch)
tree5b098fcc2b22eb3c9f5896fcabaf6f38583316c8
parent251f50f6236ef99b2bf52ce136bb8d31798d86d6 (diff)
downloadtcl-b7c880a857b80f8c7e8c5338bf18a0bedd499061.zip
tcl-b7c880a857b80f8c7e8c5338bf18a0bedd499061.tar.gz
tcl-b7c880a857b80f8c7e8c5338bf18a0bedd499061.tar.bz2
Extended ::tcl::unsupported::representation.
-rw-r--r--ChangeLog4
-rw-r--r--generic/tclObj.c52
2 files changed, 50 insertions, 6 deletions
diff --git a/ChangeLog b/ChangeLog
index b0efb5e..af6e767 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2009-09-16 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclObj.c: Extended ::tcl::unsupported::representation.
+
2009-09-11 Don Porter <dgp@users.sourceforge.net>
* generic/tclBasic.c: Completed the NR-enabling of [subst].
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 0bdb371..a6621e3 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.156 2009/08/25 21:03:25 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.157 2009/09/16 21:17:24 ferrieux Exp $
*/
#include "tclInt.h"
@@ -4379,18 +4379,56 @@ Tcl_RepresentationCmd(
int objc,
Tcl_Obj *const objv[])
{
+ char s_refcount[TCL_INTEGER_SPACE+1];
+ char s_tclobj[TCL_INTEGER_SPACE+1];
+ char s_intrep[2*TCL_INTEGER_SPACE+3];
+#define TCLOBJ_TRUNCATE_STREP 16
+ char s_strep[TCLOBJ_TRUNCATE_STREP+1];
+
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
return TCL_ERROR;
}
+
+ /*
+ value is a bignum with a refcount of 14, object pointer at
+ 0x12345678 and intrep 0x45671234:0x98765432, strep: "1872361827361287"...
+ */
+
+ sprintf(s_refcount,"%d",objv[1]->refCount);
+ sprintf(s_tclobj,"%p",(void *)objv[1]);
+ Tcl_AppendResult(interp,
+ "value is a ",
+ (objv[1]->typePtr != NULL)?objv[1]->typePtr->name:"pure string",
+ " with a refcount of ",
+ s_refcount,
+ ", object pointer at ",
+ s_tclobj,
+ NULL);
+
+ if (objv[1]->typePtr != NULL) {
+ sprintf(s_intrep,"%p:%p",(void *)objv[1]->internalRep.twoPtrValue.ptr1,(void *)objv[1]->internalRep.twoPtrValue.ptr2);
+ Tcl_AppendResult(interp,
+ " and intrep ",
+ s_intrep,
+ NULL);
+ }
- if (objv[1]->typePtr == NULL) {
- Tcl_AppendResult(interp, "value has no internal representation set",
- NULL);
+ if (objv[1]->bytes != NULL) {
+ strncpy(s_strep,objv[1]->bytes,TCLOBJ_TRUNCATE_STREP);
+ s_strep[TCLOBJ_TRUNCATE_STREP]=0;
+ Tcl_AppendResult(interp,
+ ", strep: \"",
+ s_strep,
+ (objv[1]->length>TCLOBJ_TRUNCATE_STREP)?"\"...":"\".",
+ NULL);
} else {
- Tcl_AppendResult(interp, "value has internal representation of ",
- objv[1]->typePtr->name, " currently", NULL);
+ Tcl_AppendResult(interp,
+ ", no strep.",
+ NULL);
+
}
+
return TCL_OK;
}
@@ -4399,5 +4437,7 @@ Tcl_RepresentationCmd(
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
* End:
*/