# 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.

# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.5
testsNeedTcltest 1.0

testing {
    useLocal base64.tcl base64
}

# -------------------------------------------------------------------------

tcltest::testConstraint tcl86 0
tcltest::testConstraint trf   0

if {[package vsatisfies [package present Tcl] 8.6 9]} {
    puts "> Core based"
    tcltest::testConstraint tcl86 1
} elseif {![catch {package present Trf}]} {
    puts "> Trf based"
    tcltest::testConstraint trf 1
} else {
    puts "> pure Tcl"
}

# -------------------------------------------------------------------------

test base64-1.1 {base64::encode} {
    base64::encode "this is a test\n"
} "dGhpcyBpcyBhIHRlc3QK"
test base64-1.2 {base64::encode wraps lines at 76 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
} "VGhlIHNob3J0IHJlZCBmb3ggcmFuIHF1aWNrbHkgdGhyb3VnaCB0aGUgZ3JlZW4gZmllbGQgYW5k
IGp1bXBlZCBvdmVyIHRoZSB0YWxsIGJyb3duIGJlYXIK"
test base64-1.3 {base64::encode with wrap length set to 60} {
    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 60 $str
} "VGhlIHNob3J0IHJlZCBmb3ggcmFuIHF1aWNrbHkgdGhyb3VnaCB0aGUgZ3Jl
ZW4gZmllbGQgYW5kIGp1bXBlZCBvdmVyIHRoZSB0YWxsIGJyb3duIGJlYXIK"
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} !tcl86 {
    list [catch {base64::encode} msg] $msg
} {1 {wrong # args: should be "base64::encode ?-maxlen maxlen? ?-wrapchar wrapchar? string"}}

test base64-1.6 {base64::encode, errors} tcl86 {
    list [catch {base64::encode} msg] $msg
} {1 {wrong # args: should be "binary encode base64 ?-maxlen len? ?-wrapchar char? data"}}

test base64-1.7 {base64::encode, errors} !tcl86 {
    list [catch {base64::encode -maxlen foo} msg] $msg
} {1 {value for "-maxlen" missing}}

test base64-1.7 {base64::encode, errors} tcl86 {
    list [catch {base64::encode -maxlen foo} msg] $msg
} {1 {wrong # args: should be "binary encode base64 ?-maxlen len? ?-wrapchar char? data"}}

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} !tcl86 {
    list [catch {base64::encode -maxlen foo -wrapchar bar} msg] $msg
} {1 {value for "-wrapchar" missing}}

test base64-1.9 {base64::encode, errors} tcl86 {
    list [catch {base64::encode -maxlen foo -wrapchar bar} msg] $msg
} {1 {wrong # args: should be "binary encode base64 ?-maxlen len? ?-wrapchar char? data"}}

test base64-1.10 {base64::encode, errors} !tcl86 {
    list [catch {base64::encode -foo bar} msg] $msg
} {1 {unknown option "-foo": must be -maxlen or -wrapchar}}

test base64-1.10 {base64::encode, errors} tcl86 {
    list [catch {base64::encode -foo bar} msg] $msg
} {1 {wrong # args: should be "binary encode base64 ?-maxlen len? ?-wrapchar char? data"}}

test base64-1.11 {base64::encode with bogus wrap length (< 0)} !tcl86 {
    set str "The short red fox ran quickly through the green field "
    append str "and jumped over the tall brown bear\n"
    list [catch { base64::encode -maxlen -3 $str } msg] $msg
} {1 {expected positive integer but got "-3"}}

test base64-1.11 {base64::encode with bogus wrap length (< 0)} tcl86 {
    set str "The short red fox ran quickly through the green field "
    append str "and jumped over the tall brown bear\n"
    list [catch { base64::encode -maxlen -3 $str } msg] $msg
} {1 {line length out of range}}

test base64-1.12 {base64::encode with bogus wrap length (non-numeric)} {
    set str "The short red fox ran quickly through the green field "
    append str "and jumped over the tall brown bear\n"
    list [catch { base64::encode -maxlen foo $str } msg] $msg
} {1 {expected integer but got "foo"}}
test base64-1.13 {base64::encode with bogus wrap length (non-integer)} {
    set str "The short red fox ran quickly through the green field "
    append str "and jumped over the tall brown bear\n"
    list [catch { base64::encode -maxlen 1.5 $str } msg] $msg
} {1 {expected integer but got "1.5"}}
test base64-1.14 {base64::encode with wrap length set to 20} {
    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 20 $str
} "VGhlIHNob3J0IHJlZCBm
b3ggcmFuIHF1aWNrbHkg
dGhyb3VnaCB0aGUgZ3Jl
ZW4gZmllbGQgYW5kIGp1
bXBlZCBvdmVyIHRoZSB0
YWxsIGJyb3duIGJlYXIK"
test base64-1.15 {base64::encode with wrap length set to 23 (prime)} {
    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 23 $str
} "VGhlIHNob3J0IHJlZCBmb3g
gcmFuIHF1aWNrbHkgdGhyb3
VnaCB0aGUgZ3JlZW4gZmllb
GQgYW5kIGp1bXBlZCBvdmVy
IHRoZSB0YWxsIGJyb3duIGJ
lYXIK"


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

# -------------------------------------------------------------------------

test base64-4.0 {base64 -- sf bug 2976290} {!tcl86 !trf} {
    list [catch {
	::base64::decode s=
    } msg] $msg
} {1 {Not enough data to process padding}}

test base64-4.0 {base64 -- sf bug 2976290} {tcl86} {
    list [catch {
	::base64::decode s=
    } msg] [regsub { \(U\+000073\)} $msg {} msg; set msg]
} {1 {invalid base64 character "s" at position 0}}

test base64-4.0 {base64 -- sf bug 2976290} {trf} {
    list [catch {
	::base64::decode s=
    } msg] $msg
} {1 {illegal character found in input}}

test base64-4.1 {base64 -- sf bug 2976290} {!tcl86 !trf} {
    list [catch {
	::base64::decode s
    } msg] $msg
} {1 {Not enough data to process padding}}

test base64-4.1 {base64 -- sf bug 2976290} {tcl86} {
    list [catch {
	::base64::decode s
    } msg] [regsub { \(U\+000073\)} $msg {} msg; set msg]
} {1 {invalid base64 character "s" at position 0}}

test base64-4.1 {base64 -- sf bug 2976290} {trf} {
    list [catch {
	::base64::decode s
    } msg] $msg
} {1 {illegal character found in input}}

# -------------------------------------------------------------------------
## Higher unicode

set text    "\uFFFE\u0000\u0001\u0002"
set encoded "77++AAEC"

test base64-5.0 "Encode \"$text\"" -body {
    ::base64::encode [encoding convertto utf-8 $text]
} -result $encoded ; # {}

test base64-6.0 "Decode \"$encoded\"" -body {
    encoding convertfrom utf-8 [::base64::decode $encoded]
} -result $text ; # {}

unset text encoded

# -------------------------------------------------------------------------

testsuiteCleanup
return