blob: 31ac392178f9cc96cd8c9d63ef703dc2eb9747ef (
plain)
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
|
# 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]
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]
}
}
#
# 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 utf-16 A {start end} {} 1
} -result [list nospace {} \xFF]
# 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 profiletcl8} 0 16 srcRead dstWritten charsWritten] buf
set result [list [testencoding Tcl_ExternalToUtf shiftjis $src {start profiletcl8} 0 16 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten]
lappend result {*}[list [testencoding Tcl_ExternalToUtf shiftjis [string range $src $srcRead end] {end profiletcl8} 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]
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# End:
|
