# This file contains a collection of tests for Tcl_UtfToExternal and
# Tcl_UtfToExternal. Sourcing this file into Tcl runs the tests and generates
# errors. No output means no errors found.
#
# Copyright (c) 2023 Ashok P. Nadkarni
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testencoding [llength [info commands testencoding]]

# Maps encoded bytes string to utf-8 equivalents, both in hex
# encoding utf-8 encdata
lappend utfExtMap {*}{
    ascii 414243 414243
}

# Simple test with basic flags
proc testbasic {direction enc hexin hexout {flags {start end}}} {
    if {$direction eq "toutf"} {
        set cmd Tcl_ExternalToUtf
    } else {
        set cmd Tcl_UtfToExternal
    }
    set in [binary decode hex $hexin]
    set out [binary decode hex $hexout]
    set dstlen 40 ;# Should be enough for all encoding tests

    # The C wrapper fills entire destination buffer with FF.
    # Anything beyond expected output should have FF's
    set filler [string repeat \xFF $dstlen]
    set result [string range "$out$filler" 0 $dstlen-1]
    test $cmd-$enc-$hexin-[join $flags -] "$cmd - $enc - $hexin - $flags" -body \
        [list testencoding $cmd $enc $in $flags {} $dstlen] \
        -result [list ok {} $result] -constraints testencoding
    foreach profile [encoding profiles] {
        set flags2 [linsert $flags end profile$profile]
        test $cmd-$enc-$hexin-[join $flags2 -] "$cmd - $enc - $hexin - $flags" -body \
            [list testencoding $cmd $enc $in $flags2 {} $dstlen] \
            -result [list ok {} $result] -constraints testencoding
    }
}

#
# Basic tests
foreach {enc utfhex hex} $utfExtMap {
    # Basic test - TCL_ENCODING_START|TCL_ENCODING_END
    # Note by default output should be terminated with \0
    testbasic toutf $enc $hex ${utfhex}00 {start end}
    testbasic fromutf $enc $utfhex ${hex}00 {start end}

    # Test TCL_ENCODING_NO_TERMINATE
    testbasic toutf $enc $hex $utfhex {start end noterminate}
    # knownBug - noterminate not obeyed by fromutf
    # testbasic fromutf $enc $utfhex $hex {start end noterminate}
}

# Test for insufficient space
test xx-bufferoverflow {buffer overflow Tcl_ExternalToUtf} -body {
    testencoding Tcl_UtfToExternal ucs-2 A {start end} {} 1
} -result [list nospace {} \xFF] -constraints testencoding

# Another bug - char limit not obeyed
# % set cv 2
# % testencoding Tcl_ExternalToUtf utf-8 abcdefgh {start end noterminate charlimit} {} 20 rv wv cv
# nospace {} abcÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ

test TableToUtf-bug-5be203d6ca {Bug 5be203d6ca - truncated prefix in table encoding} -body {
    set src \x82\x4f\x82\x50\x82
    lassign [testencoding Tcl_ExternalToUtf shiftjis $src {start} 0 16 srcRead dstWritten charsWritten] buf
    set result [list [testencoding Tcl_ExternalToUtf shiftjis $src {start} 0 16 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten]
    lappend result {*}[list [testencoding Tcl_ExternalToUtf shiftjis [string range $src $srcRead end] {end} 0 10 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten]
} -result [list [list multibyte 0 \xEF\xBC\x90\xEF\xBC\x91\x00\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF] 4 6 2 [list ok 0 \xC2\x82\x00\xFF\xFF\xFF\xFF\xFF\xFF\xFF] 1 2 1] -constraints testencoding


::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End: