Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Make creating variables work correctly. |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | tip-450 |
Files: | files | file ages | folders |
SHA3-256: |
795b52feb77a3ddff7d42676977bdd96 |
User & Date: | dkf 2019-06-15 07:46:39.162 |
Context
2019-06-15
| ||
11:13 | remove temporary page feed check-in: 241db3a03a user: dkf tags: tip-450 | |
07:46 | Make creating variables work correctly. check-in: 795b52feb7 user: dkf tags: tip-450 | |
07:03 | Rewrote to do modifications in-place unless Tcl_Obj is shared. check-in: 5c1e5aa513 user: dkf tags: tip-450 | |
Changes
Changes to generic/tclBinary.c.
︙ | ︙ | |||
1395 1396 1397 1398 1399 1400 1401 | * See the user documentation. * *---------------------------------------------------------------------- */ static int BinarySetCmd( | | < | > > > > < | > > > > | | | < > < < < < < < | < < < < < | | | > | 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 | * See the user documentation. * *---------------------------------------------------------------------- */ static int BinarySetCmd( ClientData ignored, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int arg; /* Index of next argument to consume. */ int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ int count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format * string. */ Tcl_Obj *valuePtr; /* Object holding binary value buffer, which * might be value read from variable, or might * be duplicate or new. */ int originalLength; /* Length of the starting value read from the * variable. */ unsigned char *buffer; /* Start of result buffer. */ unsigned char *cursor; /* Current position within result buffer. */ unsigned char *maxPos; /* Greatest position within result buffer that * cursor has visited.*/ const char *errorString; const char *errorValue, *str; int offset, size, length, i, argLength; const unsigned char *bytes; /* Working buffer for testing arguments. */ Tcl_Obj **listv; /* Used for parsing list arguments. */ int listc; /* Used for parsing list arguments. */ int isFloat; /* What type of number parsing to use. */ int type; /* Used for parsing numbers. */ ClientData data; /* Used for parsing numbers. */ Tcl_WideInt wide; /* Used for parsing numbers. */ double dummy; /* Used for parsing numbers. */ if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "varName formatString ?arg ...?"); return TCL_ERROR; } valuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0); if (valuePtr == NULL) { originalLength = 0; } else { (void) Tcl_GetByteArrayFromObj(valuePtr, &originalLength); } length = originalLength; /* * To avoid copying the data, we format the string in two passes. The * first pass computes the size of the output buffer and checks that the * supplied values are legal. The second pass places the formatted data * into the buffer. |
︙ | ︙ | |||
1589 1590 1591 1592 1593 1594 1595 | * of elements in the list stored in a single argument. If no * count is specified, then the argument is taken as a single * non-list value. */ if (count == BINARY_NOCOUNT) { if (isFloat) { | < | 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 | * of elements in the list stored in a single argument. If no * count is specified, then the argument is taken as a single * non-list value. */ if (count == BINARY_NOCOUNT) { if (isFloat) { if (TclGetNumberFromObj(NULL, objv[arg], &data, &type) != TCL_OK) { return Tcl_GetDoubleFromObj(interp, objv[arg], &dummy); } } else { if (Tcl_GetWideIntFromObj(interp, objv[arg], &wide) != TCL_OK) { |
︙ | ︙ | |||
1620 1621 1622 1623 1624 1625 1626 | } else if (count > listc) { errorString = "number of elements in list does not match count"; goto error; } for (i = 0; i < count; i++) { if (isFloat) { | < | 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 | } else if (count > listc) { errorString = "number of elements in list does not match count"; goto error; } for (i = 0; i < count; i++) { if (isFloat) { if (TclGetNumberFromObj(NULL, listv[i], &data, &type) != TCL_OK) { return Tcl_GetDoubleFromObj(interp, listv[i], &dummy); } } else { if (Tcl_GetWideIntFromObj(interp, listv[i], |
︙ | ︙ | |||
1687 1688 1689 1690 1691 1692 1693 | /* * Prepare the result object by preallocating the caclulated number of * bytes and filling with nulls. Note that if we use an operation that can * fail part way through, we must duplicate here even if the object is * unshared because we mustn't mutate anything on failure. Bother. */ | > > | < | 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 | /* * Prepare the result object by preallocating the caclulated number of * bytes and filling with nulls. Note that if we use an operation that can * fail part way through, we must duplicate here even if the object is * unshared because we mustn't mutate anything on failure. Bother. */ if (valuePtr == NULL) { valuePtr = Tcl_NewObj(); } else if (Tcl_IsShared(valuePtr)) { valuePtr = Tcl_DuplicateObj(valuePtr); } buffer = Tcl_SetByteArrayLength(valuePtr, length); if (length > originalLength) { memset(buffer + originalLength, 0, length - originalLength); } /* |
︙ | ︙ | |||
1754 1755 1756 1757 1758 1759 1760 | count = 1; } last = cursor + ((count + 7) / 8); if (count > length) { count = length; } value = 0; | < | 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 | count = 1; } last = cursor + ((count + 7) / 8); if (count > length) { count = length; } value = 0; if (cmd == 'B') { for (offset = 0; offset < count; offset++) { value <<= 1; if (str[offset] == '1') { value |= 1; } if (((offset + 1) % 8) == 0) { |
︙ | ︙ | |||
1808 1809 1810 1811 1812 1813 1814 | count = 1; } last = cursor + ((count + 1) / 2); if (count > length) { count = length; } value = 0; | < | 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 | count = 1; } last = cursor + ((count + 1) / 2); if (count > length) { count = length; } value = 0; if (cmd == 'H') { for (offset = 0; offset < count; offset++) { value <<= 4; c = str[offset] - '0'; if (c > 9) { c += ('0' - 'A') + 10; } |
︙ | ︙ | |||
1871 1872 1873 1874 1875 1876 1877 | case 'w': case 'W': case 'r': case 'R': case 'd': case 'q': case 'Q': | | < | 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 | case 'w': case 'W': case 'r': case 'R': case 'd': case 'q': case 'Q': case 'f': if (count == BINARY_NOCOUNT) { /* * Note that we are casting away the const-ness of objv, but * this is safe since we aren't going to modify the array. */ listv = (Tcl_Obj **) (objv + arg); |
︙ | ︙ | |||
1897 1898 1899 1900 1901 1902 1903 | /* * Already checked the error cases. */ (void) FormatNumber(interp, cmd, listv[i], &cursor); } break; | < | 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 | /* * Already checked the error cases. */ (void) FormatNumber(interp, cmd, listv[i], &cursor); } break; case 'x': if (count == BINARY_NOCOUNT) { count = 1; } memset(cursor, 0, count); cursor += count; break; |
︙ | ︙ | |||
1930 1931 1932 1933 1934 1935 1936 | cursor = maxPos; } else { cursor = buffer + count; } break; } } | | > > > > > > > | < | < > | 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 | cursor = maxPos; } else { cursor = buffer + count; } break; } } /* * Store the value back in the variable. This is vital if the value was * allocated in this function, which could be the case if either we * duplicated a shared value or we are assigning the variable anew. */ Tcl_IncrRefCount(valuePtr); if (!Tcl_ObjSetVar2(interp, objv[1], NULL, valuePtr, TCL_LEAVE_ERR_MSG)) { /* * Failure here with an in-place modification means there are traces * applying shenanigans. */ TclDecrRefCount(valuePtr); return TCL_ERROR; } TclDecrRefCount(valuePtr); return TCL_OK; badValue: Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected %s string but got \"%s\" instead", errorString, errorValue)); |
︙ | ︙ |
Changes to tests/binary.test.
︙ | ︙ | |||
2951 2952 2953 2954 2955 2956 2957 | } -result {1 {expected integer but got "gorp"} foobar} test binary-79.7 {binary set: errors prevent creation} -setup { unset -nocomplain nosuchvar } -body { list [catch {binary set nosuchvar ci 70 gorp} msg] $msg \ [info exist nosuchvar] } -cleanup { | | > > > > > > > > | 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 | } -result {1 {expected integer but got "gorp"} foobar} test binary-79.7 {binary set: errors prevent creation} -setup { unset -nocomplain nosuchvar } -body { list [catch {binary set nosuchvar ci 70 gorp} msg] $msg \ [info exist nosuchvar] } -cleanup { unset -nocomplain nosuchvar } -result {1 {expected integer but got "gorp"} 0} test binary-79.8 {binary set: create variable} -setup { unset -nocomplain nosuchvar } -body { binary set nosuchvar "c3" {65 66 67} return $nosuchvar } -cleanup { unset -nocomplain nosuchvar } -result ABC test binary-80.1 {binary set: a} { set x abc binary set x a A binary encode hex $x } 416263 test binary-80.2 {binary set: a} { |
︙ | ︙ |