summaryrefslogtreecommitdiffstats
path: root/generic/tclBinary.c
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2020-03-14 22:02:00 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2020-03-14 22:02:00 (GMT)
commita98d79021f17d79a3e159b3da043972466bb315d (patch)
treeeffba24c17d8545e764797ed5ce38c71ad76c44e /generic/tclBinary.c
parent49b167a3881644c6aee6b73d87e4edd13a50ce29 (diff)
parent6751485187087a5d96253b9d52e1e01b33e0c1a4 (diff)
downloadtcl-a98d79021f17d79a3e159b3da043972466bb315d.zip
tcl-a98d79021f17d79a3e159b3da043972466bb315d.tar.gz
tcl-a98d79021f17d79a3e159b3da043972466bb315d.tar.bz2
Merge 8.7
Diffstat (limited to 'generic/tclBinary.c')
-rw-r--r--generic/tclBinary.c65
1 files changed, 55 insertions, 10 deletions
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 827dabf..d368594 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -431,6 +431,53 @@ Tcl_SetByteArrayObj(
/*
*----------------------------------------------------------------------
*
+ * TclGetBytesFromObj --
+ *
+ * Attempt to extract the value from objPtr in the representation
+ * of a byte sequence. On success return the extracted byte sequence.
+ * On failures, return NULL and record error message and code in
+ * interp (if not NULL).
+ *
+ * Results:
+ * Pointer to array of bytes, or NULL. representing the ByteArray object.
+ * Writes number of bytes in array to *lengthPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+unsigned char *
+TclGetBytesFromObj(
+ Tcl_Interp *interp, /* For error reporting */
+ Tcl_Obj *objPtr, /* Value to extract from */
+ int *lengthPtr) /* If non-NULL, filled with length of the
+ * array of bytes in the ByteArray object. */
+{
+ ByteArray *baPtr;
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+
+ if (irPtr == NULL) {
+ SetByteArrayFromAny(NULL, objPtr);
+ irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected bytes but got non-byte character"));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", NULL);
+ }
+ return NULL;
+ }
+ }
+ baPtr = GET_BYTEARRAY(irPtr);
+
+ if (lengthPtr != NULL) {
+ *lengthPtr = baPtr->used;
+ }
+ return baPtr->bytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_GetByteArrayFromObj --
*
* Attempt to get the array of bytes from the Tcl object. If the object
@@ -453,18 +500,16 @@ Tcl_GetByteArrayFromObj(
* array of bytes in the ByteArray object. */
{
ByteArray *baPtr;
- const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+ const Tcl_ObjIntRep *irPtr;
+ unsigned char *result = TclGetBytesFromObj(NULL, objPtr, lengthPtr);
- if (irPtr == NULL) {
- irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
- if (irPtr == NULL) {
- SetByteArrayFromAny(NULL, objPtr);
- irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
- if (irPtr == NULL) {
- irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
- }
- }
+ if (result) {
+ return result;
}
+
+ irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
+ assert(irPtr != NULL);
+
baPtr = GET_BYTEARRAY(irPtr);
if (lengthPtr != NULL) {