1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
# Tests for the base64 module. -*- tcl -*-
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
# All rights reserved.
#
# RCS: @(#) $Id: base64.test,v 1.10 2004/01/15 06:36:12 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import ::tcltest::*
}
if { [lsearch $auto_path [file dirname [info script]]] == -1 } {
set auto_path [linsert $auto_path 0 [file dirname [info script]]]
}
package forget base64
catch {namespace delete base64}
if {[catch {source [file join [file dirname [info script]] base64.tcl]} msg]} {
puts "skipped [file tail [info script]]: $msg"
return
}
if {[catch {package present Trf}]} {
puts "- base64 [package present base64] (pure Tcl)"
} else {
puts "- base64 [package present base64] (Trf based)"
}
test base64-1.1 {base64::encode} {
base64::encode "this is a test\n"
} "dGhpcyBpcyBhIHRlc3QK"
test base64-1.2 {base64::encode wraps lines at 60 characters} {
set str "The short red fox ran quickly through the green field "
append str "and jumped over the tall brown bear\n"
base64::encode $str
} "VGhlIHNob3J0IHJlZCBmb3ggcmFuIHF1aWNrbHkgdGhyb3VnaCB0aGUgZ3Jl
ZW4gZmllbGQgYW5kIGp1bXBlZCBvdmVyIHRoZSB0YWxsIGJyb3duIGJlYXIK"
test base64-1.3 {base64::encode with wrap length set to 76} {
set str "The short red fox ran quickly through the green field "
append str "and jumped over the tall brown bear\n"
base64::encode -maxlen 76 $str
} "VGhlIHNob3J0IHJlZCBmb3ggcmFuIHF1aWNrbHkgdGhyb3VnaCB0aGUgZ3JlZW4gZmllbGQgYW5k
IGp1bXBlZCBvdmVyIHRoZSB0YWxsIGJyb3duIGJlYXIK"
test base64-1.4 {base64::encode with wrap length set to 0} {
set str "The short red fox ran quickly through the green field "
append str "and jumped over the tall brown bear\n"
base64::encode -maxlen 0 $str
} "VGhlIHNob3J0IHJlZCBmb3ggcmFuIHF1aWNrbHkgdGhyb3VnaCB0aGUgZ3JlZW4gZmllbGQgYW5kIGp1bXBlZCBvdmVyIHRoZSB0YWxsIGJyb3duIGJlYXIK"
test base64-1.5 {base64::encode with wrap length set to 76, wrapchar to newline+space} {
set str "The short red fox ran quickly through the green field "
append str "and jumped over the tall brown bear\n"
base64::encode -maxlen 76 -wrapchar "\n " $str
} "VGhlIHNob3J0IHJlZCBmb3ggcmFuIHF1aWNrbHkgdGhyb3VnaCB0aGUgZ3JlZW4gZmllbGQgYW5k
IGp1bXBlZCBvdmVyIHRoZSB0YWxsIGJyb3duIGJlYXIK"
test base64-1.6 {base64::encode, errors} {
list [catch {base64::encode} msg] $msg
} [list 1 "wrong # args: should be \"base64::encode ?-maxlen maxlen? ?-wrapchar wrapchar? string\""]
test base64-1.7 {base64::encode, errors} {
list [catch {base64::encode -maxlen foo} msg] $msg
} [list 1 "value for \"-maxlen\" missing"]
test base64-1.8 {base64::encode, errors} {
list [catch {base64::encode -maxlen foo bar} msg] $msg
} [list 1 "expected integer but got \"foo\""]
test base64-1.9 {base64::encode, errors} {
list [catch {base64::encode -maxlen foo -wrapchar bar} msg] $msg
} [list 1 "value for \"-wrapchar\" missing"]
test base64-1.10 {base64::encode, errors} {
list [catch {base64::encode -foo bar} msg] $msg
} [list 1 "unknown option \"-foo\": must be -maxlen or -wrapchar"]
test base64-2.1 {base64::decode} {
base64::decode "dGhpcyBpcyBhIHRlc3QK"
} "this is a test\n"
test base64-2.2 {base64::decode ignores newlines} {
set str "VGhlIHNob3J0IHJlZCBmb3ggcmFuIHF1aWNrbHkgdGhyb3VnaCB0aGUgZ3Jl\n"
append str "ZW4gZmllbGQgYW5kIGp1bXBlZCBvdmVyIHRoZSB0YWxsIGJyb3duIGJlYXIK"
base64::decode $str
} "The short red fox ran quickly through the green field and jumped over the tall brown bear\n"
test base64-2.3 {base64::decode handles equal sign padding} {
# decode the encoding of a string that will be padded in the encoding with
# one padding char
base64::decode [base64::encode "01234"]
} "01234"
test base64-2.4 {base64::decode handles equal sign padding} {
# decode the encoding of a string that will be padded in the encoding with
# two padding chars
base64::decode [base64::encode "0123"]
} "0123"
test base64-2.5 {base64::decode} {
base64::decode ""
} ""
test base64-2.6 {base64::decode} {
base64::decode " "
} ""
test base64-3.1 {base64 identity test} {
base64::decode [base64::encode "this is a test"]
} "this is a test"
test base64-3.2 {base64 identity test} {
# This test fails on version 1.5 because of the format %04x bug
# when handling the last characters
set x \f\xee
set y [base64::decode [base64::encode $x]]
string compare $x $y
} 0
::tcltest::cleanupTests
return
|
