diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclBinary.c | 574 | ||||
| -rw-r--r-- | tests/binary.test | 324 |
3 files changed, 879 insertions, 24 deletions
@@ -1,3 +1,8 @@ +2008-06-04 Pat Thoyts <patthoyts@users.sourceforge.net> + + * generic/tclBinary.c: TIP #317 implementation + * tests/binary.test: + 2008-06-02 Kevin B. Kenny <kennykb@acm.org> * generic/tclOO.c (ReleaseClassContents): Fix the one remaining diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 8adf524..6d626d5 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBinary.c,v 1.43 2008/05/02 20:08:52 patthoyts Exp $ + * RCS: @(#) $Id: tclBinary.c,v 1.44 2008/06/03 23:52:51 patthoyts Exp $ */ #include "tclInt.h" @@ -77,15 +77,66 @@ static int BinaryFormatCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int BinaryScanCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +/* Binary encoding sub-ensemble commands */ +static int BinaryEncodeHex(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int BinaryDecodeHex(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int BinaryEncode64(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int BinaryDecodeUu(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int BinaryDecode64(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); + +#if defined(DEBUG) || defined(_DEBUG) +#define TRACE LocalTrace +#else +#define TRACE 1 ? ((void)0) : LocalTrace +#endif +static void +LocalTrace(const char *format, ...) +{ + va_list args; + static char buffer[1024]; + + va_start(args, format); + _vsnprintf(buffer, 1023, format, args); + OutputDebugString(buffer); + va_end(args); +} /* - * Default description of the "binary" ensemble + * The following tables are used by the binary encoders */ -static const EnsembleImplMap defaultBinaryMap[] = { - { "format", BinaryFormatCmd, NULL}, - { "scan", BinaryScanCmd, NULL}, - { NULL, NULL, NULL } +static const char HexDigits[16] = { + '0', '1', '2', '3', '4', '5', '6', '7', + '8', '9', 'a', 'b', 'c', 'd', 'e', 'f' +}; + +static const char UueDigits[65] = { + '`', '!', '"', '#', '$', '%', '&', '\'', + '(', ')', '*', '+', ',', '-', '.', '/', + '0', '1', '2', '3', '4', '5', '6', '7', + '8', '9', ':', ';', '<', '=', '>', '?', + '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G', + 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', + 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', + 'X', 'Y', 'Z', '[', '\\',']', '^', '_', + '`' +}; + +static const char B64Digits[65] = { + 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', + 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', + 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', + 'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f', + 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', + 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', + 'w', 'x', 'y', 'z', '0', '1', '2', '3', + '4', '5', '6', '7', '8', '9', '+', '/', + '=' }; /* @@ -574,7 +625,89 @@ UpdateStringOfByteArray( Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp) { - return TclMakeEnsemble(interp, "binary", defaultBinaryMap); + Tcl_Namespace *nsTclPtr, *nsBinPtr, *nsEncPtr, *nsDecPtr; + Tcl_Command binEnsemble, encEnsemble, decEnsemble; + Tcl_Obj *binDict, *encDict, *decDict; + + /* + * FIX ME: I so ugly - please make me pretty ... + */ + + nsTclPtr = Tcl_FindNamespace(interp, "::tcl", + NULL, TCL_CREATE_NS_IF_UNKNOWN); + if (nsTclPtr == NULL) { + Tcl_Panic("unable to find or create ::tcl namespace!"); + } + nsBinPtr = Tcl_FindNamespace(interp, "::tcl::binary", + NULL, TCL_CREATE_NS_IF_UNKNOWN); + if (nsBinPtr == NULL) { + Tcl_Panic("unable to find or create ::tcl::binary namespace!"); + } + binEnsemble = Tcl_CreateEnsemble(interp, "::binary", + nsBinPtr, TCL_ENSEMBLE_PREFIX); + + nsEncPtr = Tcl_FindNamespace(interp, "::tcl::binary::encode", + NULL, TCL_CREATE_NS_IF_UNKNOWN); + if (nsEncPtr == NULL) { + Tcl_Panic("unable to find or create ::tcl::binary::encode namespace!"); + } + encEnsemble = Tcl_CreateEnsemble(interp, "encode", + nsBinPtr, 0); + + nsDecPtr = Tcl_FindNamespace(interp, "::tcl::binary::decode", + NULL, TCL_CREATE_NS_IF_UNKNOWN); + if (nsDecPtr == NULL) { + Tcl_Panic("unable to find or create ::tcl::binary::decode namespace!"); + } + decEnsemble = Tcl_CreateEnsemble(interp, "decode", + nsBinPtr, 0); + + TclNewObj(binDict); + Tcl_DictObjPut(NULL, binDict, Tcl_NewStringObj("format",-1), + Tcl_NewStringObj("::tcl::binary::format",-1)); + Tcl_DictObjPut(NULL, binDict, Tcl_NewStringObj("scan",-1), + Tcl_NewStringObj("::tcl::binary::scan",-1)); + Tcl_DictObjPut(NULL, binDict, Tcl_NewStringObj("encode",-1), + Tcl_NewStringObj("::tcl::binary::encode",-1)); + Tcl_DictObjPut(NULL, binDict, Tcl_NewStringObj("decode",-1), + Tcl_NewStringObj("::tcl::binary::decode",-1)); + Tcl_CreateObjCommand(interp, "::tcl::binary::format", + BinaryFormatCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tcl::binary::scan", + BinaryScanCmd, NULL, NULL); + Tcl_SetEnsembleMappingDict(interp, binEnsemble, binDict); + + TclNewObj(encDict); + Tcl_DictObjPut(NULL, encDict, Tcl_NewStringObj("hex",-1), + Tcl_NewStringObj("::tcl::binary::encode::hex",-1)); + Tcl_DictObjPut(NULL, encDict, Tcl_NewStringObj("uuencode",-1), + Tcl_NewStringObj("::tcl::binary::encode::uuencode",-1)); + Tcl_DictObjPut(NULL, encDict, Tcl_NewStringObj("base64",-1), + Tcl_NewStringObj("::tcl::binary::encode::base64",-1)); + Tcl_CreateObjCommand(interp, "::tcl::binary::encode::hex", + BinaryEncodeHex, (ClientData)HexDigits, NULL); + Tcl_CreateObjCommand(interp, "::tcl::binary::encode::uuencode", + BinaryEncode64, (ClientData)UueDigits, NULL); + Tcl_CreateObjCommand(interp, "::tcl::binary::encode::base64", + BinaryEncode64, (ClientData)B64Digits, NULL); + Tcl_SetEnsembleMappingDict(interp, encEnsemble, encDict); + + TclNewObj(decDict); + Tcl_DictObjPut(NULL, decDict, Tcl_NewStringObj("hex",-1), + Tcl_NewStringObj("::tcl::binary::decode::hex",-1)); + Tcl_DictObjPut(NULL, decDict, Tcl_NewStringObj("uuencode",-1), + Tcl_NewStringObj("::tcl::binary::decode::uuencode",-1)); + Tcl_DictObjPut(NULL, decDict, Tcl_NewStringObj("base64",-1), + Tcl_NewStringObj("::tcl::binary::decode::base64",-1)); + Tcl_CreateObjCommand(interp, "::tcl::binary::decode::hex", + BinaryDecodeHex, (ClientData)NULL, NULL); + Tcl_CreateObjCommand(interp, "::tcl::binary::decode::uuencode", + BinaryDecodeUu, (ClientData)NULL, NULL); + Tcl_CreateObjCommand(interp, "::tcl::binary::decode::base64", + BinaryDecode64, (ClientData)NULL, NULL); + Tcl_SetEnsembleMappingDict(interp, decEnsemble, decDict); + + return binEnsemble; } /* @@ -2121,6 +2254,433 @@ DeleteScanNumberCache( } /* + * ---------------------------------------------------------------------- + * + * NOTES -- + * + * Some measurements show that it is faster to use a table to + * to perform uuencode and base64 value encoding than to calculate + * the output (at least on intel P4 arch). + * + * Conversely using a lookup table for the decoding is slower than + * just calculating the values. We therefore use the fastest of + * each method. + * + * Presumably this has to do with the size of the tables. The + * base64 decode table is 255 bytes while the encode table is only + * 65 bytes. The choice likely depends on CPU memory cache sizes. + */ + +/* + *---------------------------------------------------------------------- + * + * BinaryEncodeHex -- + * + * Implement the [binary encode hex] binary encoding. + * clientData must be a table to convert values to hexadecimal digits. + * + * Results: + * Interp result set to an encoded byte array object + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +static int +BinaryEncodeHex(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + Tcl_Obj *resultObj = NULL; + unsigned char *data = NULL; + unsigned char *cursor = NULL; + const char *digits = clientData; + int offset = 0, count = 0; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "data"); + return TCL_ERROR; + } + + TclNewObj(resultObj); + data = Tcl_GetByteArrayFromObj(objv[1], &count); + cursor = Tcl_SetByteArrayLength(resultObj, count * 2); + for (offset = 0; offset < count; ++offset) { + *cursor++ = digits[((data[offset] >> 4) & 0x0f)]; + *cursor++ = digits[( data[offset] & 0x0f)]; + } + Tcl_SetObjResult(interp, resultObj); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * BinaryDecodeHex -- + * + * Implement the [binary decode hex] binary encoding. + * + * Results: + * Interp result set to an decoded byte array object + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +static int +BinaryDecodeHex(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + Tcl_Obj *resultObj = NULL; + unsigned char *data, *datastart, *dataend; + unsigned char *begin, *cursor; + int i, index, value, size, count = 0, cut = 0, strict = 0; + enum {OPT_STRICT }; + static const char *optStrings[] = { "-strict", NULL }; + + if (objc < 2 || objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "data"); + return TCL_ERROR; + } + for (i = 1; i < objc-1; ++i) { + if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, + "option", TCL_EXACT, &index) != TCL_OK) { + return TCL_ERROR; + } + switch (index) { + case OPT_STRICT: + strict = 1; + break; + } + } + + TclNewObj(resultObj); + datastart = data = TclGetStringFromObj(objv[objc-1], &count); + dataend = data + count; + size = (count + 1) / 2; + begin = cursor = Tcl_SetByteArrayLength(resultObj, size); + while (data < dataend) { + value = 0; + i = 0; + while (i < 2) { + if (data < dataend) { + unsigned char c = *data++; + if (!isxdigit((char)c)) { + if (strict) { + char sz[2] = {0, 0}, pos[TCL_INTEGER_SPACE]; + sz[0] = c; + sprintf(pos, "%d", data - datastart - 1); + TclDecrRefCount(resultObj); + Tcl_AppendResult(interp, "invalid hexadecimal digit \"", + sz, "\" at position ", pos, NULL); + return TCL_ERROR; + } + continue; + } + value <<= 4; + c -= '0'; + if (c > 9) { + c += ('0' - 'A') + 10; + } + if (c > 16) { + c += ('A' - 'a'); + } + value |= (c & 0xf); + } else { + value <<= 4; + ++cut; + } + ++i; + } + *cursor++ = (unsigned char) value; + value = 0; + } + Tcl_SetByteArrayLength(resultObj, cursor - begin - cut); + Tcl_SetObjResult(interp, resultObj); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * BinaryEncode64 -- + * + * This implements a generic 6 bit binary encoding. Input is broken + * into 6 bit chunks and a lookup table passed in via clientData is + * used to turn these values into output characters. This is used + * to implement base64 and uuencode binary encodings. + * + * Results: + * Interp result set to an encoded byte array object + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +#define OUTPUT(c) \ + *cursor++ = (c); \ + ++outindex; \ + if (maxlen > 0 && cursor != limit) { \ + if (outindex == maxlen) { \ + memcpy(cursor, wrapchar, wrapcharlen); \ + cursor += wrapcharlen; \ + outindex = 0; \ + } \ + } \ + if (cursor > limit) Tcl_Panic("limit hit\n"); + +static int +BinaryEncode64(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + Tcl_Obj *resultObj; + unsigned char *data, *cursor, *limit; + const char *digits = clientData; + int maxlen = 0; + const char *wrapchar = "\n"; + int wrapcharlen = 1; + int offset, i, index, size, outindex = 0, count = 0; + enum {OPT_MAXLEN, OPT_WRAPCHAR }; + static const char *optStrings[] = { "-maxlen", "-wrapchar", NULL }; + + if (objc < 2 || objc%2 != 0) { + Tcl_WrongNumArgs(interp, 1, objv, + "?-maxlen len? ?-wrapchar char? data"); + return TCL_ERROR; + } + for (i = 1; i < objc-1; i += 2) { + if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, + "option", TCL_EXACT, &index) != TCL_OK) { + return TCL_ERROR; + } + switch (index) { + case OPT_MAXLEN: + if (Tcl_GetIntFromObj(interp, objv[i+1], &maxlen) != TCL_OK) + return TCL_ERROR; + break; + case OPT_WRAPCHAR: + wrapchar = Tcl_GetStringFromObj(objv[i+1], NULL); + wrapcharlen = strlen(wrapchar); + if (wrapcharlen == 0) maxlen = 0; + break; + } + } + + resultObj = Tcl_NewObj(); + data = Tcl_GetByteArrayFromObj(objv[objc-1], &count); + if (count > 0) { + size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */ + if (maxlen > 0 && size > maxlen) { + int adjusted = size + (wrapcharlen * (size / maxlen)); + if (size % maxlen == 0) adjusted -= wrapcharlen; + size = adjusted; + } + cursor = Tcl_SetByteArrayLength(resultObj, size); + limit = cursor + size; + for (offset = 0; offset < count; offset+=3) { + unsigned char d[3] = {0, 0, 0}; + for (i = 0; i < 3 && offset+i < count; ++i) + d[i] = data[offset + i]; + OUTPUT(digits[ d[0] >> 2]); + OUTPUT(digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]); + if (offset+1 < count) { + OUTPUT(digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]); + } else { + OUTPUT(digits[64]); + } + if (offset+2 < count) { + OUTPUT(digits[ d[2] & 0x3f]); + } else { + OUTPUT(digits[64]); + } + } + } + Tcl_SetObjResult(interp, resultObj); + return TCL_OK; +} +#undef OUTPUT + +/* + *---------------------------------------------------------------------- + * + * BinaryDecodeUu -- + * + * Decode a uuencoded string. + * + * Results: + * Interp result set to an byte array object + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +static int +BinaryDecodeUu(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + Tcl_Obj *resultObj = NULL; + unsigned char *data, *datastart, *dataend; + unsigned char *begin, *cursor; + int i, index, size, count = 0, cut = 0, strict = 0; + enum {OPT_STRICT }; + static const char *optStrings[] = { "-strict", NULL }; + + if (objc < 2 || objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "data"); + return TCL_ERROR; + } + for (i = 1; i < objc-1; ++i) { + if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, + "option", TCL_EXACT, &index) != TCL_OK) { + return TCL_ERROR; + } + switch (index) { + case OPT_STRICT: + strict = 1; + break; + } + } + + TclNewObj(resultObj); + datastart = data = TclGetStringFromObj(objv[objc-1], &count); + dataend = data + count; + size = ((count + 3) & ~3) * 3 / 4; + begin = cursor = Tcl_SetByteArrayLength(resultObj, size); + while (data < dataend) { + char d[4] = {0, 0, 0, 0}; + i = 0; + while (i < 4) { + if (data < dataend) { + d[i] = *data++; + if (d[i] < 33 || d[i] > 96) { + if (strict) { + char sz[2] = {0, 0}, pos[TCL_INTEGER_SPACE]; + sz[0] = d[i]; + sprintf(pos, "%d", data - datastart - 1); + TclDecrRefCount(resultObj); + Tcl_AppendResult(interp, "invalid uuencode character \"", + sz, "\" at position ", pos, NULL); + return TCL_ERROR; + } + continue; + } + } else { + ++cut; + } + ++i; + } + *cursor++ = (((d[0] - 0x20) & 0x3f) << 2) | (((d[1] - 0x20) & 0x3f) >> 4); + *cursor++ = (((d[1] - 0x20) & 0x3f) << 4) | (((d[2] - 0x20) & 0x3f) >> 2); + *cursor++ = (((d[2] - 0x20) & 0x3f) << 6) | (((d[3] - 0x20) & 0x3f) ); + } + Tcl_SetByteArrayLength(resultObj, cursor - begin - cut); + Tcl_SetObjResult(interp, resultObj); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * BinaryDecode64 -- + * + * Decode a base64 encoded string. + * + * Results: + * Interp result set to an byte array object + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +static int +BinaryDecode64(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + Tcl_Obj *resultObj = NULL; + unsigned char *data, *datastart, *dataend; + unsigned char *begin = NULL; + unsigned char *cursor = NULL; + int strict = 0; + int i, index, size, cut = 0, count = 0; + enum {OPT_STRICT }; + static const char *optStrings[] = { "-strict", NULL }; + + if (objc < 2 || objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "data"); + return TCL_ERROR; + } + for (i = 1; i < objc-1; ++i) { + if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, + "option", TCL_EXACT, &index) != TCL_OK) { + return TCL_ERROR; + } + switch (index) { + case OPT_STRICT: + strict = 1; + break; + } + } + + TclNewObj(resultObj); + datastart = data = TclGetStringFromObj(objv[objc-1], &count); + dataend = data + count; + size = ((count + 3) & ~3) * 3 / 4; + begin = cursor = Tcl_SetByteArrayLength(resultObj, size); + while (data < dataend) { + int i = 0; + unsigned long value = 0; + while (i < 4) { + if (data < dataend) { + unsigned char c = *data++; + if (c >= 'A' && c <= 'Z') { + value = (value << 6) | ((c - 'A') & 0x3f); + } else if (c >= 'a' && c <= 'z') { + value = (value << 6) | ((c - 'a' + 26) & 0x3f); + } else if (c >= '0' && c <= '9') { + value = (value << 6) | ((c - '0' + 52) & 0x3f); + } else if (c == '+') { + value = (value << 6) | 0x3e; + } else if (c == '/') { + value = (value << 6) | 0x3f; + } else if (c == '=') { + value <<= 6; + if (cut < 2) ++cut; + } else { + if (strict) { + char sz[2] = {0, 0}, pos[TCL_INTEGER_SPACE]; + sz[0] = c; + sprintf(pos, "%d", data - datastart - 1); + TclDecrRefCount(resultObj); + Tcl_AppendResult(interp, "invalid base64 character \"", + sz, "\" at position ", pos, NULL); + return TCL_ERROR; + } + continue; + } + } else { + value <<= 6; + ++cut; + } + ++i; + } + *cursor++ = (unsigned char)((value >> 16) & 0xff); + *cursor++ = (unsigned char)((value >> 8) & 0xff); + *cursor++ = (unsigned char)(value & 0xff); + } + Tcl_SetByteArrayLength(resultObj, cursor - begin - cut); + Tcl_SetObjResult(interp, resultObj); + return TCL_OK; +} +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/tests/binary.test b/tests/binary.test index 28e9c78..77306b4 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: binary.test,v 1.33 2008/05/02 20:08:53 patthoyts Exp $ +# RCS: @(#) $Id: binary.test,v 1.34 2008/06/03 23:52:51 patthoyts Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -29,19 +29,20 @@ test binary-0.1 {DupByteArrayInternalRep} { string length $data } 11 -test binary-1.1 {Tcl_BinaryObjCmd: bad args} { - list [catch {binary} msg] $msg -} {1 {wrong # args: should be "binary subcommand ?argument ...?"}} -test binary-1.2 {Tcl_BinaryObjCmd: bad args} { - list [catch {binary foo} msg] $msg -} {1 {unknown or ambiguous subcommand "foo": must be format, or scan}} - -test binary-1.3 {Tcl_BinaryObjCmd: format error} { - list [catch {binary f} msg] $msg -} {1 {wrong # args: should be "binary format formatString ?arg arg ...?"}} -test binary-1.4 {Tcl_BinaryObjCmd: format} { +test binary-1.1 {Tcl_BinaryObjCmd: bad args} -body { + binary +} -returnCodes error -match glob -result {wrong # args: *} +test binary-1.2 {Tcl_BinaryObjCmd: bad args} -body { + binary foo +} -returnCodes error -match glob -result {unknown or ambiguous subcommand "foo": *} + +test binary-1.3 {Tcl_BinaryObjCmd: format error} -body { + binary f +} -returnCodes error \ + -result {wrong # args: should be "binary format formatString ?arg arg ...?"} +test binary-1.4 {Tcl_BinaryObjCmd: format} -body { binary format "" -} {} +} -result {} test binary-2.1 {Tcl_BinaryObjCmd: format} { @@ -1538,10 +1539,9 @@ test binary-41.8 {ScanNumber: word alignment} littleEndian { list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2 } {2 1 1.6} -test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} {} { - catch {binary ?} result - set result -} {unknown or ambiguous subcommand "?": must be format, or scan} +test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} -constraints {} -body { + binary ? +} -returnCodes error -match glob -result {unknown or ambiguous subcommand "?": *} # Wide int (guaranteed at least 64-bit) handling test binary-43.1 {Tcl_BinaryObjCmd: format wide int} {} { @@ -2410,6 +2410,296 @@ test binary-65.9 {largest significand} ieeeFloatingPoint { set d } 18014398509481988.0 +test binary-70.1 {binary encode hex} -body { + binary encode hex +} -returnCodes error -match glob -result "wrong # args: *" +test binary-70.2 {binary encode hex} -body { + binary encode hex a +} -result {61} +test binary-70.3 {binary encode hex} -body { + binary encode hex {} +} -result {} +test binary-70.4 {binary encode hex} -body { + binary encode hex [string repeat a 20] +} -result [string repeat 61 20] +test binary-70.5 {binary encode hex} -body { + binary encode hex \0\1\2\3\4\0\1\2\3\4 +} -result {00010203040001020304} + +test binary-71.1 {binary decode hex} -body { + binary decode hex +} -returnCodes error -match glob -result "wrong # args: *" +test binary-71.2 {binary decode hex} -body { + binary decode hex 61 +} -result {a} +test binary-71.3 {binary decode hex} -body { + binary decode hex {} +} -result {} +test binary-71.4 {binary decode hex} -body { + binary decode hex [string repeat 61 20] +} -result [string repeat a 20] +test binary-71.5 {binary decode hex} -body { + binary decode hex 00010203040001020304 +} -result "\0\1\2\3\4\0\1\2\3\4" +test binary-71.6 {binary decode hex} -body { + binary decode hex "61 61" +} -result {aa} +test binary-71.7 {binary decode hex} -body { + binary decode hex "61\n\n\n61" +} -result {aa} +test binary-71.8 {binary decode hex} -body { + binary decode hex -strict "61 61" +} -returnCodes error -result {invalid hexadecimal digit " " at position 2} +test binary-71.9 {binary decode hex} -body { + set r [binary decode hex "6"] + list [string length $r] $r +} -result {0 {}} + +test binary-72.1 {binary encode base64} -body { + binary encode base64 +} -returnCodes error -match glob -result "wrong # args: *" +test binary-72.2 {binary encode base64} -body { + binary encode base64 abc +} -result {YWJj} +test binary-72.3 {binary encode base64} -body { + binary encode base64 {} +} -result {} +test binary-72.4 {binary encode base64} -body { + binary encode base64 [string repeat abc 20] +} -result [string repeat YWJj 20] +test binary-72.5 {binary encode base64} -body { + binary encode base64 \0\1\2\3\4\0\1\2\3 +} -result {AAECAwQAAQID} +test binary-72.6 {binary encode base64} -body { + binary encode base64 \0 +} -result {AA==} +test binary-72.7 {binary encode base64} -body { + binary encode base64 \0\0 +} -result {AAA=} +test binary-72.8 {binary encode base64} -body { + binary encode base64 \0\0\0 +} -result {AAAA} +test binary-72.9 {binary encode base64} -body { + binary encode base64 \0\0\0\0 +} -result {AAAAAA==} +test binary-72.10 {binary encode base64} -body { + binary encode base64 -maxlen 0 -wrapchar : abcabcabc +} -result {YWJjYWJjYWJj} +test binary-72.11 {binary encode base64} -body { + binary encode base64 -maxlen 1 -wrapchar : abcabcabc +} -result {Y:W:J:j:Y:W:J:j:Y:W:J:j} +test binary-72.12 {binary encode base64} -body { + binary encode base64 -maxlen 2 -wrapchar : abcabcabc +} -result {YW:Jj:YW:Jj:YW:Jj} +test binary-72.13 {binary encode base64} -body { + binary encode base64 -maxlen 3 -wrapchar : abcabcabc +} -result {YWJ:jYW:JjY:WJj} +test binary-72.14 {binary encode base64} -body { + binary encode base64 -maxlen 4 -wrapchar : abcabcabc +} -result {YWJj:YWJj:YWJj} +test binary-72.15 {binary encode base64} -body { + binary encode base64 -maxlen 5 -wrapchar : abcabcabc +} -result {YWJjY:WJjYW:Jj} +test binary-72.16 {binary encode base64} -body { + binary encode base64 -maxlen 6 -wrapchar : abcabcabc +} -result {YWJjYW:JjYWJj} +test binary-72.17 {binary encode base64} -body { + binary encode base64 -maxlen 7 -wrapchar : abcabcabc +} -result {YWJjYWJ:jYWJj} +test binary-72.18 {binary encode base64} -body { + binary encode base64 -maxlen 8 -wrapchar : abcabcabc +} -result {YWJjYWJj:YWJj} +test binary-72.19 {binary encode base64} -body { + binary encode base64 -maxlen 9 -wrapchar : abcabcabc +} -result {YWJjYWJjY:WJj} +test binary-72.20 {binary encode base64} -body { + binary encode base64 -maxlen 10 -wrapchar : abcabcabc +} -result {YWJjYWJjYW:Jj} +test binary-72.21 {binary encode base64} -body { + binary encode base64 -maxlen 11 -wrapchar : abcabcabc +} -result {YWJjYWJjYWJ:j} +test binary-72.22 {binary encode base64} -body { + binary encode base64 -maxlen 12 -wrapchar : abcabcabc +} -result {YWJjYWJjYWJj} +test binary-72.23 {binary encode base64} -body { + binary encode base64 -maxlen 13 -wrapchar : abcabcabc +} -result {YWJjYWJjYWJj} +test binary-72.24 {binary encode base64} -body { + binary encode base64 -maxlen 60 -wrapchar : abcabcabc +} -result {YWJjYWJjYWJj} +test binary-72.25 {binary encode base64} -body { + binary encode base64 -maxlen 2 -wrapchar * abcabcabc +} -result {YW*Jj*YW*Jj*YW*Jj} +test binary-72.26 {binary encode base64} -body { + binary encode base64 -maxlen 6 -wrapchar -*- abcabcabc +} -result {YWJjYW-*-JjYWJj} +test binary-72.27 {binary encode base64} -body { + binary encode base64 -maxlen 4 -wrapchar -*- abcabcabc +} -result {YWJj-*-YWJj-*-YWJj} +test binary-72.28 {binary encode base64} -body { + binary encode base64 -maxlen 6 -wrapchar 0123456789 abcabcabc +} -result {YWJjYW0123456789JjYWJj} + +test binary-73.1 {binary decode base64} -body { + binary decode base64 +} -returnCodes error -match glob -result "wrong # args: *" +test binary-73.2 {binary decode base64} -body { + binary decode base64 YWJj +} -result {abc} +test binary-73.3 {binary decode base64} -body { + binary decode base64 {} +} -result {} +test binary-73.4 {binary decode base64} -body { + binary decode base64 [string repeat YWJj 20] +} -result [string repeat abc 20] +test binary-73.5 {binary encode base64} -body { + binary decode base64 AAECAwQAAQID +} -result "\0\1\2\3\4\0\1\2\3" +test binary-73.6 {binary encode base64} -body { + binary decode base64 AA== +} -result "\0" +test binary-73.7 {binary encode base64} -body { + binary decode base64 AAA= +} -result "\0\0" +test binary-73.8 {binary encode base64} -body { + binary decode base64 AAAA +} -result "\0\0\0" +test binary-73.9 {binary encode base64} -body { + binary decode base64 AAAAAA== +} -result "\0\0\0\0" +test binary-73.10 {binary decode base64} -body { + set s "[string repeat YWJj 10]\n[string repeat YWJj 10]" + binary decode base64 $s +} -result [string repeat abc 20] +test binary-73.11 {binary decode base64} -body { + set s "[string repeat YWJj 10]\n [string repeat YWJj 10]" + binary decode base64 $s +} -result [string repeat abc 20] +test binary-73.12 {binary decode base64} -body { + binary decode base64 -strict ":YWJj" +} -returnCodes error -match glob -result {invalid base64 character ":" at position 0} +test binary-73.13 {binary decode base64} -body { + set s "[string repeat YWJj 10]:[string repeat YWJj 10]" + binary decode base64 -strict $s +} -returnCodes error -match glob -result {invalid base64 character ":" at position 40} +test binary-73.14 {binary decode base64} -body { + set s "[string repeat YWJj 10]\n [string repeat YWJj 10]" + binary decode base64 -strict $s +} -returnCodes error -match glob -result {invalid base64 character *} +test binary-73.20 {binary decode base64} -body { + set r [binary decode base64 Y] + list [string length $r] $r +} -result {0 {}} +test binary-73.21 {binary decode base64} -body { + set r [binary decode base64 YW] + list [string length $r] $r +} -result {1 a} +test binary-73.22 {binary decode base64} -body { + set r [binary decode base64 YWJ] + list [string length $r] $r +} -result {2 ab} +test binary-73.23 {binary decode base64} -body { + set r [binary decode base64 YWJj] + list [string length $r] $r +} -result {3 abc} + +test binary-74.1 {binary encode uuencode} -body { + binary encode uuencode +} -returnCodes error -match glob -result "wrong # args: *" +test binary-74.2 {binary encode uuencode} -body { + binary encode uuencode abc +} -result {86)C} +test binary-74.3 {binary encode uuencode} -body { + binary encode uuencode {} +} -result {} +test binary-74.4 {binary encode uuencode} -body { + binary encode uuencode [string repeat abc 20] +} -result [string repeat 86)C 20] +test binary-74.5 {binary encode uuencode} -body { + binary encode uuencode \0\1\2\3\4\0\1\2\3 +} -result "``\$\"`P0``0(#" +test binary-74.6 {binary encode uuencode} -body { + binary encode uuencode \0 +} -result {````} +test binary-74.7 {binary encode uuencode} -body { + binary encode uuencode \0\0 +} -result {````} +test binary-74.8 {binary encode uuencode} -body { + binary encode uuencode \0\0\0 +} -result {````} +test binary-74.9 {binary encode uuencode} -body { + binary encode uuencode \0\0\0\0 +} -result {````````} +test binary-74.10 {binary encode uuencode} -body { + binary encode uuencode -maxlen 0 -wrapchar | abcabcabc +} -result {86)C86)C86)C} +test binary-74.11 {binary encode uuencode} -body { + binary encode uuencode -maxlen 1 -wrapchar | abcabcabc +} -result {8|6|)|C|8|6|)|C|8|6|)|C} + +test binary-75.1 {binary decode uuencode} -body { + binary decode uuencode +} -returnCodes error -match glob -result "wrong # args: *" +test binary-75.2 {binary decode uuencode} -body { + binary decode uuencode 86)C +} -result {abc} +test binary-75.3 {binary decode uuencode} -body { + binary decode uuencode {} +} -result {} +test binary-75.4 {binary decode uuencode} -body { + binary decode uuencode [string repeat "86)C" 20] +} -result [string repeat abc 20] +test binary-75.5 {binary encode uuencode} -body { + binary decode uuencode "``\$\"`P0``0(#" +} -result "\0\1\2\3\4\0\1\2\3" +test binary-75.6 {binary encode uuencode} -body { + string length [binary decode uuencode {`}] +} -result 0 +test binary-75.7 {binary encode uuencode} -body { + string length [binary decode uuencode {``}] +} -result 1 +test binary-75.8 {binary encode uuencode} -body { + string length [binary decode uuencode {```}] +} -result 2 +test binary-75.9 {binary encode uuencode} -body { + string length [binary decode uuencode {````}] +} -result 3 +test binary-75.10 {binary decode uuencode} -body { + set s "[string repeat 86)C 10]\n[string repeat 86)C 10]" + binary decode uuencode $s +} -result [string repeat abc 20] +test binary-75.11 {binary decode uuencode} -body { + set s "[string repeat 86)C 10]\n [string repeat 86)C 10]" + binary decode uuencode $s +} -result [string repeat abc 20] +test binary-75.12 {binary decode uuencode} -body { + binary decode uuencode -strict "|86)C" +} -returnCodes error -match glob -result {invalid uuencode character "|" at position 0} +test binary-75.13 {binary decode uuencode} -body { + set s "[string repeat 86)C 10]|[string repeat 86)C 10]" + binary decode uuencode -strict $s +} -returnCodes error -match glob -result {invalid uuencode character "|" at position 40} +test binary-75.14 {binary decode uuencode} -body { + set s "[string repeat 86)C 10]\n [string repeat 86)C 10]" + binary decode uuencode -strict $s +} -returnCodes error -match glob -result {invalid uuencode character *} +test binary-75.20 {binary decode uuencode} -body { + set r [binary decode uuencode 8] + list [string length $r] $r +} -result {0 {}} +test binary-75.21 {binary decode uuencode} -body { + set r [binary decode uuencode 86] + list [string length $r] $r +} -result {1 a} +test binary-75.22 {binary decode uuencode} -body { + set r [binary decode uuencode 86)] + list [string length $r] $r +} -result {2 ab} +test binary-75.23 {binary decode uuencode} -body { + set r [binary decode uuencode 86)C] + list [string length $r] $r +} -result {3 abc} + # cleanup ::tcltest::cleanupTests return |