TIP #317 implementation

1 files changed, 307 insertions, 17 deletions

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