tests/utfext.test - main - niceSOFT/tcl

tests/utfext.test
638 строк26 KB
jan.nijtmans
Consolidate use of ©. Indenting
10 авг 2026, 12:58
10 авг 2026, 12:5852d1487
# This file contains a collection of tests for Tcl_UtfToExternal and
# Tcl_UtfToExternal that exercise various combinations of flags,
# buffer lengths and fragmentation that cannot be tested by
# normal script level commands. There tests are NOT intended to check
# correctness of encodings; those are elsewhere.
#
# Copyright © 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]]

namespace eval utftest {
    variable enc
    variable testcases

    # Format of table, indexed by encoding. The encodings are not exhaustive
    # but one of each kind of encoding transform (algorithmic, table-driven,
    # stateful, DBCS, MBCS).
    # Each element is list of lists. Nested lists have following fields
    # 0 comment (no spaces, might be used to generate id's as well)
    #   The combination of comment and internal hex (2) should be unique.
    # 1 hex representation of internal *modified* utf-8 encoding. This is the
    #   source string for Tcl_UtfToExternal and expected result for
    #   Tcl_ExternalToUtf.
    # 2 hex representation in specified encoding. This is the source string for
    #   Tcl_ExternalToUtf and expected result for Tcl_UtfToExternal.
    # 3 internal fragmentation index - where to split field 1 for fragmentation
    #   tests. -1 to skip
    # 4 external fragmentation index - where to split field 2 for fragmentation
    #   tests. -1 to skip
    #
    # THE HEX DEFINITIONS SHOULD SEPARATE EACH CHARACTER BY WHITESPACE
    # (assumed by the charlimit tests)
    #
    # Note: The utf-8 entry takes into consideration that the implementation
    # is factored into a fastpath dealing with ascii and a separate path for
    # non-ascii. The various conditions (space limits etc.) need to be tested
    # for both as well as combinations.
    lappend utfExtMap {*}{
	ascii {
	    {basic {41 42 43} {41 42 43} -1 -1}
	}
	utf-8 {
	    {asciionly    {41 42 43}     {41 42 43} -1 -1}
	    {ascii+bmp    {41 c3a9 42}     {41 c3a9 42}      2  2}
	    {ascii+nonbmp-frag-1 {41 f09f9880 42} {41 f09f9880 42}  2  2}
	    {ascii+nonbmp-frag-2 {41 f09f9880 42} {41 f09f9880 42}  3  3}
	    {ascii+nonbmp-frag-3 {41 f09f9880 42} {41 f09f9880 42}  4  4}
	    {ascii+null   {41 c080 42} {41 00 42}    2 -1}
	    {bmp    {c3a9 c3aa}     {c3a9 c3aa}      1  3}
	    {bmp+null   {c3a9 c080 c3aa}     {c3a9 00 c3aa} 3  4}
	    {nonbmp-frag-1 {f09f9880 f09f9881} {f09f9880 f09f9881}  1  5}
	    {nonbmp-frag-2 {f09f9880 f09f9881} {f09f9880 f09f9881}  2  6}
	    {nonbmp-frag-3 {f09f9880 f09f9881} {f09f9880 f09f9881}  3  7}
	    {nonbmp+null {f09f9880 c080 f09f9881} {f09f9880 00 f09f9881}  5  7}
	}
	cesu-8 {
	    {bmp    {41 c3a9 42}     {41 c3a9 42}      2  2}
	    {nonbmp-frag-surr-low {41 f09f9880 42} {41 eda0bd edb880 42} 2 2}
	    {nonbmp-split-surr {41 f09f9880 42} {41 eda0bd edb880 42} 3 -1}
	    {nonbmp-frag-surr-high {41 f09f9880 42} {41 eda0bd edb880 42} 4 6}
	    {null   {41 c080 42} {41 00 42}    2 -1}
	}
	utf-16le {
	    {bmp    {41 c3a9 42}     {4100 e900 4200}     2  3}
	    {nonbmp {41 f09f9880 42} {4100 3dd8 00de 4200} 4  3}
	    {split-surrogate {41 f09f9080 42} {4100 3dd8 00dc 4200} 3  4}
	    {null   {41 c080 42} {4100 0000 4200}  2 3}
	}
	utf-16be {
	    {bmp    {41 c3a9 42}     {0041 00e9 0042}     2  3}
	    {nonbmp {41 f09f9880 42} {0041 d83d de00 0042} 4  3}
	    {split-surrogate {41 f09f9080 42} {0041 d83d dc00 0042} 3  4}
	    {null   {41 c080 42} {0041 0000 0042}  2 3}
	}
	utf-32le {
	    {bmp    {41 c3a9 42}     {41000000 e9000000 42000000}     2  3}
	    {nonbmp {41 f09f9880 42} {41000000 00f60100 42000000} 4  6}
	    {null   {41 c080 42} {41000000 00000000 42000000}  2 3}
	}
	utf-32be {
	    {bmp    {41 c3a9 42}     {00000041 000000e9 00000042}     2  3}
	    {nonbmp {41 f09f9880 42} {00000041 0001f600 00000042} 4  3}
	    {null   {41 c080 42} {00000041 00000000 00000042}  2 3}
	}
	iso8859-1 {
	    {basic {41 c3a9 42} {41 e9 42} 2 -1}
	    {null  {41 c080 42} {41 00 42} 2 -1}
	}
	iso8859-3 {
	    {basic {41 c4a0 42} {41 d5 42} 2 -1}
	    {null  {41 c080 42} {41 00 42} 2 -1}
	}
	shiftjis {
	    {basic {41 e4b98e 42} {41 8cc1 42} 3 2}
	}
	jis0208 {
	    {basic {e4b98e e590be} {3843 3863} 1 1}
	}
	iso2022-jp {
	    {frag-in-leadescape {58 e4b98e 5a} {58 1b2442 3843 1b2842 5a} 2 2}
	    {frag-in-char {58 e4b98e 5a} {58 1b2442 3843 1b2842 5a} 2 5}
	    {frag-in-trailescape {58 e4b98e 5a} {58 1b2442 3843 1b2842 5a} 2 8}
	}
    }

    # The "." character is used as a prefix filler to test long strings except
    # for encodings that do not support the ASCII character set.
    # Generate the encoded versions of this
    variable prefixChars
    array default set prefixChars .
    set prefixChars(jis0208) \u4e4e

    # Return a binary string containing nul terminator for encoding
    proc hexnuls {enc} {
	return [binary encode hex [encoding convertto $enc \x00]]
    }

    # The C wrapper fills entire destination buffer with FF.
    # Anything beyond expected output should have FF's
    proc fill {bin buflen {prefixlen 0}} {
	return [string range "$bin[string repeat \xFF $buflen]" 0 $buflen-1]
    }

    proc testparams {direction enc prefixlen} {
	variable prefixChars

	switch $direction {
	    toutf -
	    toutfex {
		set srcPrefixChar [encoding convertto $enc $prefixChars($enc)]
		set dstPrefixChar [encoding convertto utf-8 $prefixChars($enc)]
		if {$direction eq "toutf"} {
		    set cmd Tcl_ExternalToUtf
		} else {
		    set cmd Tcl_ExternalToUtfEx
		}
	    }
	    fromutf -
	    fromutfex {
		set srcPrefixChar [encoding convertto utf-8 $prefixChars($enc)]
		set dstPrefixChar [encoding convertto $enc $prefixChars($enc)]
		if {$direction eq "fromutf"} {
		    set cmd Tcl_UtfToExternal
		} else {
		    set cmd Tcl_UtfToExternalEx
		}
	    }
	}
	set srcPrefixCharSize [string length $srcPrefixChar]
	set dstPrefixCharSize [string length $dstPrefixChar]

	# source prefixlen should be multiple of prefix char size in src encoding
	set numPrefixChars [expr {$prefixlen/$srcPrefixCharSize}]
	set srcPrefixLength [expr {$numPrefixChars * $srcPrefixCharSize}]
	set dstPrefixLength [expr {$numPrefixChars*$dstPrefixCharSize}]

	return [list $cmd $numPrefixChars \
		    $srcPrefixChar $srcPrefixLength \
		    $dstPrefixChar $dstPrefixLength]
    }

    proc testutf_verify {result expectedOut bufLen prefixCharBytes numPrefixChars} {
	# result - the result returned from [testencoding]
	# expectedOut - expected encoded output not including prefix and trailing
	#   buffer fills
	# bufLen - the buffer length that was passed to [testencoding]
	#   and does not include space for prefix
	# prefixCharBytes - byte sequence for the prefix character in the output
	# numPrefixChars - number of prefix characters

	lassign $result status state output
	# The output includes trailing FF fillers
	set expectedOut [fill $expectedOut $bufLen]
	if {$numPrefixChars == 0} {
	    set good [string equal $output $expectedOut]
	} else {
	    # prefixes are generally very long so cannot afford to do full compare
	    set prefixCharLen [string length $prefixCharBytes]
	    # The actual prefix is a multiple of the prefixcharlen. Get the offset
	    # to end of prefix. Note assumes at least one prefix character.
	    set prefixEnd [expr {$prefixCharLen * $numPrefixChars}]
	    # Check the tail consisting of one prefix char and encoding test sample
	    set expectedTail [string cat $prefixCharBytes $expectedOut]
	    set good [string equal \
			  [string range $output $prefixEnd-$prefixCharLen end] \
			  $expectedTail]
	}
	return [list $status $state $good]
    }

    proc testutf {direction enc comment hexin hexout args} {
	variable prefixChars

	# See comments in UtfTransformFn in tclTest.c
	set id $comment-[join $hexin ""]

	set in [binary decode hex $hexin]
	set out [binary decode hex $hexout]
	set dstlen 40 ;# Should be enough for all encoding tests excluding prefix

	set status ok
	set flags [list start end]
	set constraints [list testencoding]
	set profiles [encoding profiles]
	# prefixlen - is the total number of *bytes* of prefix that [testencoding]
	#   that should be prepended to the input bytes
	set prefixlen 0
	while {[llength $args] > 1} {
	    set opt [lpop args 0]
	    switch $opt {
		-flags       { set flags [lpop args 0] }
		-constraints { lappend constraints {*}[lpop args 0] }
		-profiles    { set profiles [lpop args 0] }
		-status      { set status [lpop args 0] }
		-prefixlen   { set prefixlen [lpop args 0] }
		default {
		    error "Unknown option \"$opt\""
		}
	    }
	}
	if {[llength $args]} {
	    error "No value supplied for option [lindex $args 0]."
	}

	lassign [testparams $direction $enc $prefixlen] \
	    cmd numPrefixChars srcPrefixChar srcPrefixLength \
	    dstPrefixChar dstPrefixLength

	set totalDstSpace [expr {$dstlen+$dstPrefixLength}]

	test $cmd-$enc-$id-[join $flags -]-prefixlen-$prefixlen "$cmd - $enc - $hexin - $flags - $prefixlen" -body {
	    testutf_verify \
		[testencoding $cmd $enc $in $flags {} \
				      $totalDstSpace -prefixlen $srcPrefixLength \
				      -prefix $srcPrefixChar] \
		$out $dstlen $dstPrefixChar $numPrefixChars
	} -result [list $status {} 1] -constraints $constraints
	# For keeping runtime reasonable, only run profile tests if no prefix
	if {$prefixlen != 0} {
	    return
	}
	foreach profile $profiles {
	    set flags2 [linsert $flags end $profile]
	    test $cmd-$enc-$id-[join $flags2 -]-prefixlen-$prefixlen "$cmd - $enc - $hexin - $flags2 - $prefixlen" -body {
		testutf_verify \
		    [testencoding $cmd $enc $in $flags2 {} \
			 $totalDstSpace -prefixlen $srcPrefixLength \
			 -prefix $srcPrefixChar] \
		    $out $dstlen $dstPrefixChar $numPrefixChars
	    } -result [list $status {} 1] -constraints $constraints
	}
    }

    proc testfragment {direction enc comment hexin hexout fragindex args} {

	set origargs $args
	if {$fragindex < 0} {
	    # Single byte encodings so no question of fragmentation
	    return
	}
	set id $comment-[join $hexin ""]-fragment

	set status1 multibyte; # Return status to expect after first call
	set constraints [list testencoding]
	set prefixlen 0
	while {[llength $args] > 1} {
	    set opt [lpop args 0]
	    switch $opt {
		-constraints { lappend constraints {*}[lpop args 0] }
		-status1  { set status1 [lpop args 0]}
		-prefixlen   { set prefixlen [lpop args 0] }
		default {
		    error "Unknown option \"$opt\""
		}
	    }
	}
	if {[llength $args]} {
	    error "No value supplied for option [lindex $args 0]."
	}

	lassign [testparams $direction $enc $prefixlen] \
	    cmd numPrefixChars srcPrefixChar srcPrefixLength \
	    dstPrefixChar dstPrefixLength

	set in [binary decode hex $hexin]
	set infrag [string range $in 0 $fragindex-1]
	set out [binary decode hex $hexout]
	set dstlen 40 ;# Should be enough for all encoding tests

	set totalDstSpace [expr {$dstlen+$dstPrefixLength}]

	test $cmd-$enc-$id-prefixlen-$prefixlen-0 "$cmd - $enc - $hexin - frag=$fragindex - prefixlen=$prefixlen" -constraints $constraints -body {
	    # Pass in first fragment - start flag without end flag
	    set frag1Result [testencoding $cmd $enc \
				 [string range $in 0 $fragindex-1] {start} 0 \
				 $totalDstSpace -srcreadvar frag1Read \
				 -dstwrotevar frag1Written \
				 -prefix $srcPrefixChar -prefixlen $srcPrefixLength]
	    lassign $frag1Result frag1Status frag1State frag1Decoded
	    # Just some sanity checks. Note frag1Read can be == srcPrefixLength
	    # when there is no prefix or a multi-byte prefix
	    if {$frag1Read <= $srcPrefixLength && $srcPrefixLength == 1} {
		error "Test design error. Fragment length read $frag1Read should be longer than source prefix length $srcPrefixLength. [string length $srcPrefixChar]"
	    }
	    if {$frag1Written <= $dstPrefixLength && $dstPrefixLength == 1} {
		error "Test design error. Fragment length written $frag1Written should be longer than output prefix length $dstPrefixLength"
	    }
	    # Pass in second fragment - end flag, without start flag
	    set frag2Result [testencoding $cmd $enc \
				 [string range $in \
				      [expr {$frag1Read - $srcPrefixLength}] end] \
				 {end} $frag1State $dstlen -srcreadvar frag2Read \
				 -dstwrotevar frag2Written]
	    lassign $frag2Result frag2Status frag2State frag2Decoded

	    set decoded [string cat \
			     [string range $frag1Decoded $dstPrefixLength $frag1Written-1] \
			     [string range $frag2Decoded 0 $frag2Written-1]]

	    list $frag1Status [expr {($frag1Read-$srcPrefixLength) <= $fragindex}] \
		$frag2Status [expr {$frag1Read+$frag2Read}] \
		[expr {($frag1Written-$dstPrefixLength)+$frag2Written}] $decoded
	} -result [list $status1 1 ok \
		       [expr {$srcPrefixLength+[string length $in]}] \
		       [string length $out] $out]

	# This test is not run for fromutf* because going from internal utf to
	# external encoding does not generate errors under the assumption that
	# the internal utf should always be valid otherwise all bets are off.
	# See https://core.tcl-lang.org/tcl/tktview/b69e00ecf6
	if {$direction in "toutf toutfex"} {
	    # Fragmentation but with no more data.
	    # Only check status. Content output is already checked in above test.
	    test $cmd-$enc-$id-$origargs-1 "$cmd - $enc - $hexin - frag=$fragindex - no more data" -constraints $constraints -body {
		set frag1Result  \
		    [testencoding $cmd $enc \
			 [string range $in 0 $fragindex-1] {start end} 0 \
			 $totalDstSpace -srcreadvar frag1Read \
			 -dstwrotevar frag1Written \
			 -prefix $srcPrefixChar -prefixlen $srcPrefixLength]
		lassign $frag1Result frag1Status frag1State frag1Decoded
		set frag1Status
	    } -result syntax
	}
    }

    proc testcharlimit {direction enc comment hexin hexout args} {
	if {$direction in "fromutf fromutfex"} {
	    error "Tcl_UtfToExternal and Tcl_UtfToExternalEx do not support char limits"
	}

	set id $comment-[join $hexin ""]-charlimit

	set constraints [list testencoding]
	set prefixlen 0
	while {[llength $args] > 1} {
	    set opt [lpop args 0]
	    switch $opt {
		-constraints { lappend constraints {*}[lpop args 0] }
		-prefixlen   { set prefixlen [lpop args 0] }
		default {
		    error "Unknown option \"$opt\""
		}
	    }
	}
	if {[llength $args]} {
	    error "No value supplied for option [lindex $args 0]."
	}
	lassign [testparams $direction $enc $prefixlen] \
	    cmd numPrefixChars srcPrefixChar srcPrefixLength \
	    dstPrefixChar dstPrefixLength

	set maxchars [llength $hexout]
	set in [binary decode hex $hexin]
	set out [binary decode hex $hexout]
	set dstlen 40 ;# Should be enough for all encoding tests
	set totalDstSpace [expr {$dstlen+$dstPrefixLength}]

	for {set nchars 0} {$nchars <= $maxchars} {incr nchars} {
	    if {$prefixlen != 0 && $nchars != ($maxchars-1)} {
		# For prefixes, only do one test for test run time reasons
		continue
	    }
	    set expected_bytes [binary decode hex [lrange $hexout 0 $nchars-1]]
	    set expected_nwritten \
		[expr {
		       $dstPrefixLength+[string length $expected_bytes]
		   }]
	    test $cmd-$enc-$id-$nchars-prefix-$prefixlen "$cmd - $enc - $hexin - nchars $nchars - $prefixlen" -constraints $constraints -body {
		set charlimit [expr {$numPrefixChars+$nchars}]
		lassign \
		    [testencoding $cmd $enc $in \
			 {start end charlimit} 0 $totalDstSpace \
			 -srcreadvar nread -dstwrotevar nwritten \
			 -dstcharsvar charlimit -prefix $srcPrefixChar \
			 -prefixlen $prefixlen] \
		    status state buf
		list $status $nwritten [string range $buf $dstPrefixLength $nwritten-1]
	    } -result [list ok $expected_nwritten $expected_bytes]
	}
    }

    proc testspacelimit {direction enc comment hexin hexout args} {
	set prefixlen 0
	set id $comment-[join $hexin ""]-spacelimit

	# Triple the input to avoid pathological short input case where
	# whereby nothing is written to output. The test below
	# requires $nchars > 0
	set hexin [string repeat $hexin 3]
	set hexout [string repeat $hexout 3]

	set flags [list start end]
	set constraints [list testencoding]
	set prefixlen 0
	while {[llength $args] > 1} {
	    set opt [lpop args 0]
	    switch $opt {
		-constraints { lappend constraints {*}[lpop args 0] }
		-prefixlen   { set prefixlen [lpop args 0] }
		default {
		    error "Unknown option \"$opt\""
		}
	    }
	}
	if {[llength $args]} {
	    error "No value supplied for option [lindex $args 0]."
	}
	lassign [testparams $direction $enc $prefixlen] \
	    cmd numPrefixChars srcPrefixChar srcPrefixLength \
	    dstPrefixChar dstPrefixLength

	set in [binary decode hex $hexin]
	set out [binary decode hex $hexout]
	set dstlen [expr {$dstPrefixLength+[string length $out] - 1}]; # Smaller buffer than needed

	if {$direction in {toutf toutfex}} {
	    set str [encoding convertfrom $enc $in]
	} else {
	    set str [encoding convertfrom $enc $out]
	}

	# Note the tests are loose because the some encoding operations will
	# stop even there is actually still room in the destination. For example,
	# below only one char is written though there is room in the output.
	# % testencoding Tcl_ExternalToUtf ascii abc {start end} {} 5 -srcreadvar nread -dstwrotevar nwritten -dstcharsvar nchars
	# nospace {} aÿÿÿ#
	# % puts $nread,$nwritten,$nchars
	# 1,1,1
	#

	test $cmd-$enc-$id-[join $flags -]-prefixlen-$prefixlen "$cmd - $enc - $hexin - $flags - $prefixlen" \
	    -constraints $constraints \
	    -body {
	    lassign [testencoding $cmd $enc $in $flags {} $dstlen \
			 -srcreadvar nread -dstwrotevar nwritten \
			 -dstcharsvar nchars -prefix $srcPrefixChar \
			 -prefixlen $srcPrefixLength] status state buf
	    list \
		$status \
		[expr {$nread < ($srcPrefixLength+[string length $in])}] \
		[expr {$nwritten <= ($dstPrefixLength+$dstlen)}] \
		[expr {$nchars > 0 && $nchars < ($numPrefixChars+[string length $str])}] \
		[expr {[string range $out 0 [expr {$nwritten-$dstPrefixLength-1}]] eq [string range $buf $dstPrefixLength $nwritten-1]}]
	    } -result {nospace 1 1 1 1}
    }

    #
    # Basic tests
    foreach {enc testcases} $utfExtMap {
	set encnuls [hexnuls $enc]
	foreach testcase $testcases {
	    lassign $testcase {*}{comment utfhex hex internalfragindex externalfragindex}

	    # Basic test - TCL_ENCODING_START|TCL_ENCODING_END
	    # Note by default output should be terminated with \0
	    testutf toutf $enc $comment $hex ${utfhex}00
	    testutf fromutf $enc $comment $utfhex $hex$encnuls
	    testutf toutfex $enc $comment $hex ${utfhex}00
	    testutf fromutfex $enc $comment $utfhex $hex$encnuls

	    # Test TCL_ENCODING_NO_TERMINATE
	    testutf toutf $enc $comment $hex $utfhex -flags {start end noterminate}
	    testutf fromutf $enc $comment $utfhex $hex -flags {start end noterminate}
	    testutf toutfex $enc $comment $hex $utfhex -flags {start end noterminate}
	    testutf fromutfex $enc $comment $utfhex $hex -flags {start end noterminate}

	    # Fragments
	    testfragment toutf $enc $comment $hex $utfhex $externalfragindex
	    testfragment fromutf $enc $comment $utfhex $hex $internalfragindex
	    testfragment toutfex $enc $comment $hex $utfhex $externalfragindex
	    testfragment fromutfex $enc $comment $utfhex $hex $internalfragindex

	    # Char limits - note no fromutf as Tcl_UtfToExternal does not support it
	    testcharlimit toutf $enc $comment $hex $utfhex
	    testcharlimit toutfex $enc $comment $hex $utfhex

	    # Space limits
	    testspacelimit toutf $enc $comment $hex $utfhex
	    testspacelimit fromutf $enc $comment $utfhex $hex
	    testspacelimit toutfex $enc $comment $hex $utfhex
	    testspacelimit fromutfex $enc $comment $utfhex $hex
	}

	# Cannot afford to test every single encoding for large strings. Test
	# only the first two cases at the INT_MAX and UINT_MAX boundaries.
	foreach testcase [lrange $testcases 0 1] {
	    lassign $testcase {*}{comment utfhex hex internalfragindex externalfragindex}
	    foreach prefixlen {0x7ffffffe 0xfffffffe} {
		# Basic tests
		testutf toutfex $enc $comment $hex ${utfhex}00 -prefixlen $prefixlen -constraints bigdata
		testutf fromutfex $enc $comment $utfhex $hex$encnuls -prefixlen $prefixlen -constraints bigdata
		testutf toutfex $enc $comment $hex $utfhex \
		    -flags {start end noterminate} -prefixlen $prefixlen -constraints bigdata
		testutf fromutfex $enc $comment $utfhex $hex \
		    -flags {start end noterminate} -prefixlen $prefixlen -constraints bigdata
		# Test fragments across chunks
		testfragment toutfex $enc $comment $hex $utfhex $externalfragindex -prefixlen $prefixlen -constraints bigdata
		testfragment fromutfex $enc $comment $utfhex $hex $internalfragindex -prefixlen $prefixlen -constraints bigdata

		# Char limits - no fromutf as Tcl_UtfToExternalEx does not support it
		testcharlimit toutfex $enc $comment $hex $utfhex -prefixlen $prefixlen -constraints bigdata

		# Test space limits at INT_MAX/UINT_MAX
		testspacelimit toutfex $enc $comment $hex $utfhex -prefixlen $prefixlen -constraints bigdata
		testspacelimit fromutfex $enc $comment $utfhex $hex -prefixlen $prefixlen -constraints bigdata
	    }
	}
    }


    # Special case - cesu2 high and low surrogates in separate fragments
    # This will (correctly) return "ok", not "multibyte" after first frag
    testfragment toutf cesu-8 nonbmp-split-surr \
	{41 eda0bd edb880 42} {41 f09f9880 42} 4 -status1 ok

    # Bug regression tests
    test Tcl_UtfToExternal-bug-183a1adcc0 {buffer overflow} -body {
	testencoding Tcl_UtfToExternal utf-16 A {start end} {} 1
    } -result [list nospace {} \xFF] -constraints testencoding

    test Tcl_ExternalToUtf-bug-5be203d6ca {
	truncated prefix in table encoding
    } -constraints testencoding -body {
	set src \x82\x4F\x82\x50\x82
	set result [list [testencoding Tcl_ExternalToUtf shiftjis $src {start tcl8} 0 16 -srcreadvar srcRead -dstwrotevar dstWritten -dstcharsvar charsWritten] $srcRead $dstWritten $charsWritten]
	lappend result {*}[list [testencoding Tcl_ExternalToUtf shiftjis [string range $src $srcRead end] {end tcl8} 0 10 -srcreadvar srcRead -dstwrotevar dstWritten -dstcharsvar 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]

    test Tcl_ExternalToUtf-bug-7346adc50f-strict-0 {
	truncated input in escape encoding (strict)
    } -constraints testencoding -body {
	set src [binary decode hex 1b2442242a3b6e24]
	list {*}[testencoding Tcl_ExternalToUtf iso2022-jp $src {start end strict} 0 16 -srcreadvar srcRead -dstwrotevar dstWritten -dstcharsvar charsWritten] $srcRead $dstWritten $charsWritten
    } -result [list syntax 2 [binary decode hex e3818ae8a9a600ffffffffffffffffff] 7 6 2]

    test Tcl_ExternalToUtf-bug-7346adc50f-strict-1 {
	truncated input in escape encoding (strict, partial)
    } -constraints testencoding -body {
	set src [binary decode hex 1b2442242a3b6e24]
	list {*}[testencoding Tcl_ExternalToUtf iso2022-jp $src {start strict} 0 16 -srcreadvar srcRead -dstwrotevar dstWritten -dstcharsvar charsWritten] $srcRead $dstWritten $charsWritten
    } -result [list multibyte 2 [binary decode hex e3818ae8a9a600ffffffffffffffffff] 7 6 2]

    test Tcl_ExternalToUtf-bug-7346adc50f-replace-0 {
	truncated input in escape encoding (replace)
    } -constraints testencoding -body {
	set src [binary decode hex 1b2442242a3b6e24]
	list {*}[testencoding Tcl_ExternalToUtf iso2022-jp $src {start end replace} 0 16 -srcreadvar srcRead -dstwrotevar dstWritten -dstcharsvar charsWritten] $srcRead $dstWritten $charsWritten
    } -result [list ok 2 [binary decode hex e3818ae8a9a6efbfbd00ffffffffffff] 8 9 3]

    test Tcl_ExternalToUtf-bug-7346adc50f-replace-1 {
	truncated input in escape encoding (replace, partial)
    } -constraints testencoding -body {
	set src [binary decode hex 1b2442242a3b6e24]
	list {*}[testencoding Tcl_ExternalToUtf iso2022-jp $src {start replace} 0 16 -srcreadvar srcRead -dstwrotevar dstWritten -dstcharsvar charsWritten] $srcRead $dstWritten $charsWritten
    } -result [list multibyte 2 [binary decode hex e3818ae8a9a600ffffffffffffffffff] 7 6 2]

    test Tcl_ExternalToUtf-bug-7346adc50f-tcl8-0 {
	truncated input in escape encoding (tcl8)
    } -constraints testencoding -body {
	set src [binary decode hex 1b2442242a3b6e24]
	list {*}[testencoding Tcl_ExternalToUtf iso2022-jp $src {start end tcl8} 0 16 -srcreadvar srcRead -dstwrotevar dstWritten -dstcharsvar charsWritten] $srcRead $dstWritten $charsWritten
    } -result [list ok 2 [binary decode hex e3818ae8a9a6efbfbd00ffffffffffff] 8 9 3]

    test Tcl_ExternalToUtf-bug-7346adc50f-tcl8-1 {
	truncated input in escape encoding (tcl8, partial)
    } -constraints testencoding -body {
	set src [binary decode hex 1b2442242a3b6e24]
	list {*}[testencoding Tcl_ExternalToUtf iso2022-jp $src {start tcl8} 0 16 -srcreadvar srcRead -dstwrotevar dstWritten -dstcharsvar charsWritten] $srcRead $dstWritten $charsWritten
    } -result [list multibyte 2 [binary decode hex e3818ae8a9a600ffffffffffffffffff] 7 6 2]

    # 9.0 compatibility tests. Detect errors on counter overflow
    test Tcl_ExternalToUtf-srcread-overflow-0 {
	Test error generated if srcRead does not fit in int and srcRead specified
    } -constraints {testencoding bigdata} -body {
	lindex [testencoding Tcl_ExternalToUtf utf-32le X\0\0\0 {start end} 0 0x40000000 -srcreadvar srcRead -prefix [encoding convertto utf-32le .] -prefixlen 0x80000000] 0
    } -returnCodes error -result "Tcl_ExternalToUtf does not support lengths greater than INT_MAX. Use Tcl_ExternalToUtfEx instead."

    test Tcl_ExternalToUtf-srcread-overflow-1 {
	Success if srcRead does not fit in int but srcRead not specified
    } -constraints {testencoding bigdata} -body {
	lindex [testencoding Tcl_ExternalToUtf utf-32le X\0\0\0 {start end} 0 0x40000000 -prefix [encoding convertto utf-32le .] -prefixlen 0x80000000] 0
    } -result ok

    test Tcl_UtfToExternal-dstwrote-overflow-0 {
	Test error generated if dstWrote does not fit in int and dstWrote specified
    } -constraints {testencoding bigdata} -body {
	lindex [testencoding Tcl_UtfToExternal utf-32le X {start end} 0 0x80000100 -dstwrote dstWritten -prefix . -prefixlen 0x20000000] 0
    } -returnCodes error -result "Tcl_UtfToExternal does not support lengths greater than INT_MAX. Use Tcl_UtfToExternalEx instead."

    test Tcl_UtfToExternal-dstwrote-overflow-1 {
	Success if dstWrote does not fit in int but dstWrote not specified
    } -constraints {testencoding bigdata} -body {
	lindex [testencoding Tcl_UtfToExternal utf-32le X {start end} 0 0x80000100 -prefix . -prefixlen 0x20000000] 0
    } -result ok

}

namespace delete utftest

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End: