Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Purge the old and broken Tcl_ObjType. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | dgp-properbytearray |
Files: | files | file ages | folders |
SHA1: |
ea03de5a23af915fc67d34ab97097123 |
User & Date: | dgp 2016-12-06 20:09:00 |
Context
2016-12-07
| ||
18:57 | Create a narrowing procedure to make the operation explicit when needed. check-in: ba8e57d76c user: dgp tags: dgp-properbytearray | |
2016-12-06
| ||
20:09 | Purge the old and broken Tcl_ObjType. check-in: ea03de5a23 user: dgp tags: dgp-properbytearray | |
18:55 | Several commands should be picky about expecting byte-valued arguments. Make them so. check-in: 1b7d737ce6 user: dgp tags: dgp-properbytearray | |
Changes
Changes to generic/tclBinary.c.
︙ | ︙ | |||
156 157 158 159 160 161 162 | /* * The following object types represent an array of bytes. The intent is * to allow arbitrary binary data to pass through Tcl as a Tcl value * without loss or damage. Such values are useful for things like * encoded strings or Tk images to name just two. * | < < < < | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 | /* * The following object types represent an array of bytes. The intent is * to allow arbitrary binary data to pass through Tcl as a Tcl value * without loss or damage. Such values are useful for things like * encoded strings or Tk images to name just two. * * A bytearray is an ordered sequence of bytes. Each byte is an integer * value in the range [0-255]. To be a Tcl value type, we need a way to * encode each value in the value set as a Tcl string. The simplest * encoding is to represent each byte value as the same codepoint value. * A bytearray of N bytes is encoded into a Tcl string of N characters * where the codepoint of each character is the value of corresponding byte. * This approach creates a one-to-one map between all bytearray values * and a subset of Tcl string values. * * When converting a Tcl string value to the bytearray internal rep, and * the string value is outside that subset, an error is raised. */ static const Tcl_ObjType properByteArrayType = { "bytearray", FreeByteArrayInternalRep, DupByteArrayInternalRep, UpdateStringOfByteArray, NULL }; /* * The following structure is the internal rep for a ByteArray object. Keeps * track of how much memory has been used and how much has been allocated for * the byte array to enable growing and shrinking of the ByteArray object with * fewer mallocs. */ |
︙ | ︙ | |||
446 447 448 449 450 451 452 | Tcl_GetByteArrayFromObj( Tcl_Obj *objPtr, /* The ByteArray object. */ int *lengthPtr) /* If non-NULL, filled with length of the * array of bytes in the ByteArray object. */ { ByteArray *baPtr; | | < | 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 | Tcl_GetByteArrayFromObj( Tcl_Obj *objPtr, /* The ByteArray object. */ int *lengthPtr) /* If non-NULL, filled with length of the * array of bytes in the ByteArray object. */ { ByteArray *baPtr; if (objPtr->typePtr != &properByteArrayType) { if (TCL_ERROR == SetByteArrayFromAny(NULL, objPtr)) { if (lengthPtr != NULL) { *lengthPtr = 0; } return NULL; } } |
︙ | ︙ | |||
495 496 497 498 499 500 501 | int length) /* New length for internal byte array. */ { ByteArray *byteArrayPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); } | | < | 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 | int length) /* New length for internal byte array. */ { ByteArray *byteArrayPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); } if (objPtr->typePtr != &properByteArrayType) { if (TCL_ERROR == SetByteArrayFromAny(NULL, objPtr)) { return NULL; } } byteArrayPtr = GET_BYTEARRAY(objPtr); if (length > byteArrayPtr->allocated) { |
︙ | ︙ | |||
543 544 545 546 547 548 549 | unsigned char *dst; ByteArray *byteArrayPtr; Tcl_UniChar ch; if (objPtr->typePtr == &properByteArrayType) { return TCL_OK; } | < < < | 462 463 464 465 466 467 468 469 470 471 472 473 474 475 | unsigned char *dst; ByteArray *byteArrayPtr; Tcl_UniChar ch; if (objPtr->typePtr == &properByteArrayType) { return TCL_OK; } src = TclGetStringFromObj(objPtr, &length); srcEnd = src + length; byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length)); for (dst = byteArrayPtr->bytes; src < srcEnd; ) { src += Tcl_UtfToUniChar(src, &ch); |
︙ | ︙ | |||
735 736 737 738 739 740 741 | Tcl_Panic("%s must be called with definite number of bytes to append", "TclAppendBytesToByteArray"); } if (len == 0) { /* Append zero bytes is a no-op. */ return; } | | < | 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 | Tcl_Panic("%s must be called with definite number of bytes to append", "TclAppendBytesToByteArray"); } if (len == 0) { /* Append zero bytes is a no-op. */ return; } if (objPtr->typePtr != &properByteArrayType) { if (TCL_ERROR == SetByteArrayFromAny(NULL, objPtr)) { Tcl_Panic("attempt to append bytes to non-bytearray"); } } byteArrayPtr = GET_BYTEARRAY(objPtr); if (len > INT_MAX - byteArrayPtr->used) { |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
2640 2641 2642 2643 2644 2645 2646 | /* * Variables denoting the Tcl object types defined in the core. */ MODULE_SCOPE const Tcl_ObjType tclBignumType; MODULE_SCOPE const Tcl_ObjType tclBooleanType; | < | 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 | /* * Variables denoting the Tcl object types defined in the core. */ MODULE_SCOPE const Tcl_ObjType tclBignumType; MODULE_SCOPE const Tcl_ObjType tclBooleanType; MODULE_SCOPE const Tcl_ObjType tclByteCodeType; MODULE_SCOPE const Tcl_ObjType tclDoubleType; MODULE_SCOPE const Tcl_ObjType tclEndOffsetType; MODULE_SCOPE const Tcl_ObjType tclIntType; MODULE_SCOPE const Tcl_ObjType tclListType; MODULE_SCOPE const Tcl_ObjType tclDictType; MODULE_SCOPE const Tcl_ObjType tclProcBodyType; |
︙ | ︙ |
Changes to generic/tclObj.c.
︙ | ︙ | |||
390 391 392 393 394 395 396 | TclInitObjSubsystem(void) { Tcl_MutexLock(&tableMutex); typeTableInitialized = 1; Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS); Tcl_MutexUnlock(&tableMutex); | < | 390 391 392 393 394 395 396 397 398 399 400 401 402 403 | TclInitObjSubsystem(void) { Tcl_MutexLock(&tableMutex); typeTableInitialized = 1; Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS); Tcl_MutexUnlock(&tableMutex); Tcl_RegisterObjType(&tclDoubleType); Tcl_RegisterObjType(&tclEndOffsetType); Tcl_RegisterObjType(&tclIntType); Tcl_RegisterObjType(&tclStringType); Tcl_RegisterObjType(&tclListType); Tcl_RegisterObjType(&tclDictType); Tcl_RegisterObjType(&tclByteCodeType); |
︙ | ︙ |
Changes to tests/execute.test.
︙ | ︙ | |||
989 990 991 992 993 994 995 | } else { set result SUCCESS } set result } SUCCESS test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} { | | | 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 | } else { set result SUCCESS } set result } SUCCESS test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} { apply {s {binary scan [binary format a $s] c x; list $x [scan $s$s %c%c]}} \u0130 } {48 {304 304}} test execute-10.2 {Bug 2802881} -setup { interp create slave } -body { # If [Bug 2802881] is not fixed, this will segfault slave eval { trace add variable ::errorInfo write {expr {$foo} ;#} |
︙ | ︙ |
Changes to tests/obj.test.
︙ | ︙ | |||
23 24 25 26 27 28 29 | testConstraint longIs32bit [expr {int(0x80000000) < 0}] testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}] test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj { set r 1 foreach {t} { {array search} | < | | | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | testConstraint longIs32bit [expr {int(0x80000000) < 0}] testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}] test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj { set r 1 foreach {t} { {array search} bytecode cmdName dict end-offset regexp string } { set first [string first $t [testobj types]] set r [expr {$r && ($first != -1)}] } set result $r } {1} test obj-2.1 {Tcl_GetObjType error} testobj { list [testintobj set 1 0] [catch {testobj convert 1 foo} msg] $msg } {0 1 {no type foo found}} test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} testobj { set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 12] lappend result [testobj convert 1 string] lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} 12 12 string 3} test obj-3.1 {Tcl_ConvertToType error} testobj { list [testdoubleobj set 1 12.34] \ [catch {testobj convert 1 end-offset} msg] \ $msg } {12.34 1 {bad index "12.34": must be end?[+-]integer?}} test obj-3.2 {Tcl_ConvertToType error, "empty string" object} testobj { |
︙ | ︙ |