# 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.8 2003/05/01 22:40:12 patthoyts 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-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