|
sl@0
|
1 |
# This file contains a collection of tests for tclEncoding.c
|
|
sl@0
|
2 |
# Sourcing this file into Tcl runs the tests and generates output for
|
|
sl@0
|
3 |
# errors. No output means no errors were found.
|
|
sl@0
|
4 |
#
|
|
sl@0
|
5 |
# Copyright (c) 1997 Sun Microsystems, Inc.
|
|
sl@0
|
6 |
# Copyright (c) 1998-1999 by Scriptics Corporation.
|
|
sl@0
|
7 |
#
|
|
sl@0
|
8 |
# See the file "license.terms" for information on usage and redistribution
|
|
sl@0
|
9 |
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
sl@0
|
10 |
#
|
|
sl@0
|
11 |
# RCS: @(#) $Id: encoding.test,v 1.16.2.3 2006/10/05 21:24:56 hobbs Exp $
|
|
sl@0
|
12 |
|
|
sl@0
|
13 |
package require tcltest 2
|
|
sl@0
|
14 |
namespace import -force ::tcltest::*
|
|
sl@0
|
15 |
|
|
sl@0
|
16 |
proc toutf {args} {
|
|
sl@0
|
17 |
global x
|
|
sl@0
|
18 |
lappend x "toutf $args"
|
|
sl@0
|
19 |
}
|
|
sl@0
|
20 |
proc fromutf {args} {
|
|
sl@0
|
21 |
global x
|
|
sl@0
|
22 |
lappend x "fromutf $args"
|
|
sl@0
|
23 |
}
|
|
sl@0
|
24 |
|
|
sl@0
|
25 |
# Some tests require the testencoding command
|
|
sl@0
|
26 |
testConstraint testencoding [llength [info commands testencoding]]
|
|
sl@0
|
27 |
testConstraint exec [llength [info commands exec]]
|
|
sl@0
|
28 |
|
|
sl@0
|
29 |
# TclInitEncodingSubsystem is tested by the rest of this file
|
|
sl@0
|
30 |
# TclFinalizeEncodingSubsystem is not currently tested
|
|
sl@0
|
31 |
|
|
sl@0
|
32 |
test encoding-1.1 {Tcl_GetEncoding: system encoding} {testencoding} {
|
|
sl@0
|
33 |
testencoding create foo toutf fromutf
|
|
sl@0
|
34 |
set old [encoding system]
|
|
sl@0
|
35 |
encoding system foo
|
|
sl@0
|
36 |
set x {}
|
|
sl@0
|
37 |
encoding convertto abcd
|
|
sl@0
|
38 |
encoding system $old
|
|
sl@0
|
39 |
testencoding delete foo
|
|
sl@0
|
40 |
set x
|
|
sl@0
|
41 |
} {{fromutf }}
|
|
sl@0
|
42 |
test encoding-1.2 {Tcl_GetEncoding: existing encoding} {testencoding} {
|
|
sl@0
|
43 |
testencoding create foo toutf fromutf
|
|
sl@0
|
44 |
set x {}
|
|
sl@0
|
45 |
encoding convertto foo abcd
|
|
sl@0
|
46 |
testencoding delete foo
|
|
sl@0
|
47 |
set x
|
|
sl@0
|
48 |
} {{fromutf }}
|
|
sl@0
|
49 |
test encoding-1.3 {Tcl_GetEncoding: load encoding} {
|
|
sl@0
|
50 |
list [encoding convertto jis0208 \u4e4e] \
|
|
sl@0
|
51 |
[encoding convertfrom jis0208 8C]
|
|
sl@0
|
52 |
} "8C \u4e4e"
|
|
sl@0
|
53 |
|
|
sl@0
|
54 |
test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} {
|
|
sl@0
|
55 |
encoding convertto jis0208 \u4e4e
|
|
sl@0
|
56 |
} {8C}
|
|
sl@0
|
57 |
test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} {testencoding} {
|
|
sl@0
|
58 |
set system [encoding system]
|
|
sl@0
|
59 |
set path [testencoding path]
|
|
sl@0
|
60 |
encoding system shiftjis ;# incr ref count
|
|
sl@0
|
61 |
testencoding path [list [pwd]]
|
|
sl@0
|
62 |
set x [encoding convertto shiftjis \u4e4e] ;# old one found
|
|
sl@0
|
63 |
encoding system identity
|
|
sl@0
|
64 |
lappend x [catch {encoding convertto shiftjis \u4e4e} msg] $msg
|
|
sl@0
|
65 |
encoding system identity
|
|
sl@0
|
66 |
testencoding path $path
|
|
sl@0
|
67 |
encoding system $system
|
|
sl@0
|
68 |
set x
|
|
sl@0
|
69 |
} "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"
|
|
sl@0
|
70 |
|
|
sl@0
|
71 |
test encoding-3.1 {Tcl_GetEncodingName, NULL} {
|
|
sl@0
|
72 |
set old [encoding system]
|
|
sl@0
|
73 |
encoding system shiftjis
|
|
sl@0
|
74 |
set x [encoding system]
|
|
sl@0
|
75 |
encoding system $old
|
|
sl@0
|
76 |
set x
|
|
sl@0
|
77 |
} {shiftjis}
|
|
sl@0
|
78 |
test encoding-3.2 {Tcl_GetEncodingName, non-null} {
|
|
sl@0
|
79 |
set old [fconfigure stdout -encoding]
|
|
sl@0
|
80 |
fconfigure stdout -encoding jis0208
|
|
sl@0
|
81 |
set x [fconfigure stdout -encoding]
|
|
sl@0
|
82 |
fconfigure stdout -encoding $old
|
|
sl@0
|
83 |
set x
|
|
sl@0
|
84 |
} {jis0208}
|
|
sl@0
|
85 |
|
|
sl@0
|
86 |
test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} {
|
|
sl@0
|
87 |
cd [makeDirectory tmp]
|
|
sl@0
|
88 |
makeDirectory [file join tmp encoding]
|
|
sl@0
|
89 |
makeFile {} [file join tmp encoding junk.enc]
|
|
sl@0
|
90 |
makeFile {} [file join tmp encoding junk2.enc]
|
|
sl@0
|
91 |
set path [testencoding path]
|
|
sl@0
|
92 |
testencoding path {}
|
|
sl@0
|
93 |
catch {unset encodings}
|
|
sl@0
|
94 |
catch {unset x}
|
|
sl@0
|
95 |
foreach encoding [encoding names] {
|
|
sl@0
|
96 |
set encodings($encoding) 1
|
|
sl@0
|
97 |
}
|
|
sl@0
|
98 |
testencoding path [list [pwd]]
|
|
sl@0
|
99 |
foreach encoding [encoding names] {
|
|
sl@0
|
100 |
if {![info exists encodings($encoding)]} {
|
|
sl@0
|
101 |
lappend x $encoding
|
|
sl@0
|
102 |
}
|
|
sl@0
|
103 |
}
|
|
sl@0
|
104 |
testencoding path $path
|
|
sl@0
|
105 |
cd [workingDirectory]
|
|
sl@0
|
106 |
removeFile [file join tmp encoding junk2.enc]
|
|
sl@0
|
107 |
removeFile [file join tmp encoding junk.enc]
|
|
sl@0
|
108 |
removeDirectory [file join tmp encoding]
|
|
sl@0
|
109 |
removeDirectory tmp
|
|
sl@0
|
110 |
lsort $x
|
|
sl@0
|
111 |
} {junk junk2}
|
|
sl@0
|
112 |
|
|
sl@0
|
113 |
test encoding-5.1 {Tcl_SetSystemEncoding} {
|
|
sl@0
|
114 |
set old [encoding system]
|
|
sl@0
|
115 |
encoding system jis0208
|
|
sl@0
|
116 |
set x [encoding convertto \u4e4e]
|
|
sl@0
|
117 |
encoding system identity
|
|
sl@0
|
118 |
encoding system $old
|
|
sl@0
|
119 |
set x
|
|
sl@0
|
120 |
} {8C}
|
|
sl@0
|
121 |
test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} {
|
|
sl@0
|
122 |
set old [encoding system]
|
|
sl@0
|
123 |
encoding system $old
|
|
sl@0
|
124 |
string compare $old [encoding system]
|
|
sl@0
|
125 |
} {0}
|
|
sl@0
|
126 |
|
|
sl@0
|
127 |
test encoding-6.1 {Tcl_CreateEncoding: new} {testencoding} {
|
|
sl@0
|
128 |
testencoding create foo {toutf 1} {fromutf 2}
|
|
sl@0
|
129 |
set x {}
|
|
sl@0
|
130 |
encoding convertfrom foo abcd
|
|
sl@0
|
131 |
encoding convertto foo abcd
|
|
sl@0
|
132 |
testencoding delete foo
|
|
sl@0
|
133 |
set x
|
|
sl@0
|
134 |
} {{toutf 1} {fromutf 2}}
|
|
sl@0
|
135 |
test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} {
|
|
sl@0
|
136 |
testencoding create foo {toutf a} {fromutf b}
|
|
sl@0
|
137 |
set x {}
|
|
sl@0
|
138 |
encoding convertfrom foo abcd
|
|
sl@0
|
139 |
encoding convertto foo abcd
|
|
sl@0
|
140 |
testencoding delete foo
|
|
sl@0
|
141 |
set x
|
|
sl@0
|
142 |
} {{toutf a} {fromutf b}}
|
|
sl@0
|
143 |
|
|
sl@0
|
144 |
test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} {
|
|
sl@0
|
145 |
encoding convertfrom jis0208 8c8c8c8c
|
|
sl@0
|
146 |
} "\u543e\u543e\u543e\u543e"
|
|
sl@0
|
147 |
test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} {
|
|
sl@0
|
148 |
set a 8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C
|
|
sl@0
|
149 |
append a $a
|
|
sl@0
|
150 |
append a $a
|
|
sl@0
|
151 |
append a $a
|
|
sl@0
|
152 |
append a $a
|
|
sl@0
|
153 |
set x [encoding convertfrom jis0208 $a]
|
|
sl@0
|
154 |
list [string length $x] [string index $x 0]
|
|
sl@0
|
155 |
} "512 \u4e4e"
|
|
sl@0
|
156 |
|
|
sl@0
|
157 |
test encoding-8.1 {Tcl_ExternalToUtf} {
|
|
sl@0
|
158 |
set f [open [file join [temporaryDirectory] dummy] w]
|
|
sl@0
|
159 |
fconfigure $f -translation binary -encoding iso8859-1
|
|
sl@0
|
160 |
puts -nonewline $f "ab\x8c\xc1g"
|
|
sl@0
|
161 |
close $f
|
|
sl@0
|
162 |
set f [open [file join [temporaryDirectory] dummy] r]
|
|
sl@0
|
163 |
fconfigure $f -translation binary -encoding shiftjis
|
|
sl@0
|
164 |
set x [read $f]
|
|
sl@0
|
165 |
close $f
|
|
sl@0
|
166 |
file delete [file join [temporaryDirectory] dummy]
|
|
sl@0
|
167 |
set x
|
|
sl@0
|
168 |
} "ab\u4e4eg"
|
|
sl@0
|
169 |
|
|
sl@0
|
170 |
test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {
|
|
sl@0
|
171 |
encoding convertto jis0208 "\u543e\u543e\u543e\u543e"
|
|
sl@0
|
172 |
} {8c8c8c8c}
|
|
sl@0
|
173 |
test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} {
|
|
sl@0
|
174 |
set a \u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e
|
|
sl@0
|
175 |
append a $a
|
|
sl@0
|
176 |
append a $a
|
|
sl@0
|
177 |
append a $a
|
|
sl@0
|
178 |
append a $a
|
|
sl@0
|
179 |
append a $a
|
|
sl@0
|
180 |
append a $a
|
|
sl@0
|
181 |
set x [encoding convertto jis0208 $a]
|
|
sl@0
|
182 |
list [string length $x] [string range $x 0 1]
|
|
sl@0
|
183 |
} "1024 8C"
|
|
sl@0
|
184 |
|
|
sl@0
|
185 |
test encoding-10.1 {Tcl_UtfToExternal} {
|
|
sl@0
|
186 |
set f [open [file join [temporaryDirectory] dummy] w]
|
|
sl@0
|
187 |
fconfigure $f -translation binary -encoding shiftjis
|
|
sl@0
|
188 |
puts -nonewline $f "ab\u4e4eg"
|
|
sl@0
|
189 |
close $f
|
|
sl@0
|
190 |
set f [open [file join [temporaryDirectory] dummy] r]
|
|
sl@0
|
191 |
fconfigure $f -translation binary -encoding iso8859-1
|
|
sl@0
|
192 |
set x [read $f]
|
|
sl@0
|
193 |
close $f
|
|
sl@0
|
194 |
file delete [file join [temporaryDirectory] dummy]
|
|
sl@0
|
195 |
set x
|
|
sl@0
|
196 |
} "ab\x8c\xc1g"
|
|
sl@0
|
197 |
|
|
sl@0
|
198 |
proc viewable {str} {
|
|
sl@0
|
199 |
set res ""
|
|
sl@0
|
200 |
foreach c [split $str {}] {
|
|
sl@0
|
201 |
if {[string is print $c] && [string is ascii $c]} {
|
|
sl@0
|
202 |
append res $c
|
|
sl@0
|
203 |
} else {
|
|
sl@0
|
204 |
append res "\\u[format %4.4x [scan $c %c]]"
|
|
sl@0
|
205 |
}
|
|
sl@0
|
206 |
}
|
|
sl@0
|
207 |
return "$str ($res)"
|
|
sl@0
|
208 |
}
|
|
sl@0
|
209 |
|
|
sl@0
|
210 |
test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} {
|
|
sl@0
|
211 |
set system [encoding system]
|
|
sl@0
|
212 |
set path [testencoding path]
|
|
sl@0
|
213 |
encoding system iso8859-1
|
|
sl@0
|
214 |
testencoding path {}
|
|
sl@0
|
215 |
set x [list [catch {encoding convertto jis0208 \u4e4e} msg] $msg]
|
|
sl@0
|
216 |
testencoding path $path
|
|
sl@0
|
217 |
encoding system $system
|
|
sl@0
|
218 |
lappend x [encoding convertto jis0208 \u4e4e]
|
|
sl@0
|
219 |
} {1 {unknown encoding "jis0208"} 8C}
|
|
sl@0
|
220 |
test encoding-11.2 {LoadEncodingFile: single-byte} {
|
|
sl@0
|
221 |
encoding convertfrom jis0201 \xa1
|
|
sl@0
|
222 |
} "\uff61"
|
|
sl@0
|
223 |
test encoding-11.3 {LoadEncodingFile: double-byte} {
|
|
sl@0
|
224 |
encoding convertfrom jis0208 8C
|
|
sl@0
|
225 |
} "\u4e4e"
|
|
sl@0
|
226 |
test encoding-11.4 {LoadEncodingFile: multi-byte} {
|
|
sl@0
|
227 |
encoding convertfrom shiftjis \x8c\xc1
|
|
sl@0
|
228 |
} "\u4e4e"
|
|
sl@0
|
229 |
test encoding-11.5 {LoadEncodingFile: escape file} {
|
|
sl@0
|
230 |
viewable [encoding convertto iso2022 \u4e4e]
|
|
sl@0
|
231 |
} [viewable "\x1b\$B8C\x1b(B"]
|
|
sl@0
|
232 |
test encoding-11.5.1 {LoadEncodingFile: escape file} {
|
|
sl@0
|
233 |
viewable [encoding convertto iso2022-jp \u4e4e]
|
|
sl@0
|
234 |
} [viewable "\x1b\$B8C\x1b(B"]
|
|
sl@0
|
235 |
test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} {
|
|
sl@0
|
236 |
set system [encoding system]
|
|
sl@0
|
237 |
set path [testencoding path]
|
|
sl@0
|
238 |
encoding system identity
|
|
sl@0
|
239 |
cd [temporaryDirectory]
|
|
sl@0
|
240 |
testencoding path tmp
|
|
sl@0
|
241 |
makeDirectory tmp
|
|
sl@0
|
242 |
makeDirectory [file join tmp encoding]
|
|
sl@0
|
243 |
set f [open [file join tmp encoding splat.enc] w]
|
|
sl@0
|
244 |
fconfigure $f -translation binary
|
|
sl@0
|
245 |
puts $f "abcdefghijklmnop"
|
|
sl@0
|
246 |
close $f
|
|
sl@0
|
247 |
set x [list [catch {encoding convertto splat \u4e4e} msg] $msg]
|
|
sl@0
|
248 |
file delete [file join [temporaryDirectory] tmp encoding splat.enc]
|
|
sl@0
|
249 |
removeDirectory [file join tmp encoding]
|
|
sl@0
|
250 |
removeDirectory tmp
|
|
sl@0
|
251 |
cd [workingDirectory]
|
|
sl@0
|
252 |
testencoding path $path
|
|
sl@0
|
253 |
encoding system $system
|
|
sl@0
|
254 |
set x
|
|
sl@0
|
255 |
} {1 {invalid encoding file "splat"}}
|
|
sl@0
|
256 |
|
|
sl@0
|
257 |
# OpenEncodingFile is fully tested by the rest of the tests in this file.
|
|
sl@0
|
258 |
|
|
sl@0
|
259 |
test encoding-12.1 {LoadTableEncoding: normal encoding} {
|
|
sl@0
|
260 |
set x [encoding convertto iso8859-3 \u120]
|
|
sl@0
|
261 |
append x [encoding convertto iso8859-3 \ud5]
|
|
sl@0
|
262 |
append x [encoding convertfrom iso8859-3 \xd5]
|
|
sl@0
|
263 |
} "\xd5?\u120"
|
|
sl@0
|
264 |
test encoding-12.2 {LoadTableEncoding: single-byte encoding} {
|
|
sl@0
|
265 |
set x [encoding convertto iso8859-3 ab\u0120g]
|
|
sl@0
|
266 |
append x [encoding convertfrom iso8859-3 ab\xd5g]
|
|
sl@0
|
267 |
} "ab\xd5gab\u120g"
|
|
sl@0
|
268 |
test encoding-12.3 {LoadTableEncoding: multi-byte encoding} {
|
|
sl@0
|
269 |
set x [encoding convertto shiftjis ab\u4e4eg]
|
|
sl@0
|
270 |
append x [encoding convertfrom shiftjis ab\x8c\xc1g]
|
|
sl@0
|
271 |
} "ab\x8c\xc1gab\u4e4eg"
|
|
sl@0
|
272 |
test encoding-12.4 {LoadTableEncoding: double-byte encoding} {
|
|
sl@0
|
273 |
set x [encoding convertto jis0208 \u4e4e\u3b1]
|
|
sl@0
|
274 |
append x [encoding convertfrom jis0208 8C&A]
|
|
sl@0
|
275 |
} "8C&A\u4e4e\u3b1"
|
|
sl@0
|
276 |
test encoding-12.5 {LoadTableEncoding: symbol encoding} {
|
|
sl@0
|
277 |
set x [encoding convertto symbol \u3b3]
|
|
sl@0
|
278 |
append x [encoding convertto symbol \u67]
|
|
sl@0
|
279 |
append x [encoding convertfrom symbol \x67]
|
|
sl@0
|
280 |
} "\x67\x67\u3b3"
|
|
sl@0
|
281 |
|
|
sl@0
|
282 |
test encoding-13.1 {LoadEscapeTable} {
|
|
sl@0
|
283 |
viewable [set x [encoding convertto iso2022 ab\u4e4e\u68d9g]]
|
|
sl@0
|
284 |
} [viewable "ab\x1b\$B8C\x1b\$\(DD%\x1b(Bg"]
|
|
sl@0
|
285 |
|
|
sl@0
|
286 |
test encoding-14.1 {BinaryProc} {
|
|
sl@0
|
287 |
encoding convertto identity \x12\x34\x56\xff\x69
|
|
sl@0
|
288 |
} "\x12\x34\x56\xc3\xbf\x69"
|
|
sl@0
|
289 |
|
|
sl@0
|
290 |
test encoding-15.1 {UtfToUtfProc} {
|
|
sl@0
|
291 |
encoding convertto utf-8 \xa3
|
|
sl@0
|
292 |
} "\xc2\xa3"
|
|
sl@0
|
293 |
|
|
sl@0
|
294 |
test encoding-15.2 {UtfToUtfProc null character output} {
|
|
sl@0
|
295 |
set x \u0000
|
|
sl@0
|
296 |
set y [encoding convertto utf-8 \u0000]
|
|
sl@0
|
297 |
set y [encoding convertfrom identity $y]
|
|
sl@0
|
298 |
binary scan $y H* z
|
|
sl@0
|
299 |
list [string bytelength $x] [string bytelength $y] $z
|
|
sl@0
|
300 |
} {2 1 00}
|
|
sl@0
|
301 |
|
|
sl@0
|
302 |
test encoding-15.3 {UtfToUtfProc null character input} {
|
|
sl@0
|
303 |
set x [encoding convertfrom identity \x00]
|
|
sl@0
|
304 |
set y [encoding convertfrom utf-8 $x]
|
|
sl@0
|
305 |
binary scan [encoding convertto identity $y] H* z
|
|
sl@0
|
306 |
list [string bytelength $x] [string bytelength $y] $z
|
|
sl@0
|
307 |
} {1 2 c080}
|
|
sl@0
|
308 |
|
|
sl@0
|
309 |
test encoding-16.1 {UnicodeToUtfProc} {
|
|
sl@0
|
310 |
set val [encoding convertfrom unicode NN]
|
|
sl@0
|
311 |
list $val [format %x [scan $val %c]]
|
|
sl@0
|
312 |
} "\u4e4e 4e4e"
|
|
sl@0
|
313 |
|
|
sl@0
|
314 |
test encoding-17.1 {UtfToUnicodeProc} {
|
|
sl@0
|
315 |
} {}
|
|
sl@0
|
316 |
|
|
sl@0
|
317 |
test encoding-18.1 {TableToUtfProc} {
|
|
sl@0
|
318 |
} {}
|
|
sl@0
|
319 |
|
|
sl@0
|
320 |
test encoding-19.1 {TableFromUtfProc} {
|
|
sl@0
|
321 |
} {}
|
|
sl@0
|
322 |
|
|
sl@0
|
323 |
test encoding-20.1 {TableFreefProc} {
|
|
sl@0
|
324 |
} {}
|
|
sl@0
|
325 |
|
|
sl@0
|
326 |
test encoding-21.1 {EscapeToUtfProc} {
|
|
sl@0
|
327 |
} {}
|
|
sl@0
|
328 |
|
|
sl@0
|
329 |
test encoding-22.1 {EscapeFromUtfProc} {
|
|
sl@0
|
330 |
} {}
|
|
sl@0
|
331 |
|
|
sl@0
|
332 |
set ::iso2022encData "\u001b\$B;d\$I\$b\$G\$O!\"%A%C%W\$49XF~;~\$K\$4EPO?\$\$\$?\$@\$\$\$?\$4=;=j\$r%-%c%C%7%e%\"%&%H\$N:]\$N\u001b(B
|
|
sl@0
|
333 |
\u001b\$B>.@Z<jAwIU@h\$H\$7\$F;HMQ\$7\$F\$*\$j\$^\$9!#62\$lF~\$j\$^\$9\$,!\"@5\$7\$\$=;=j\$r\$4EPO?\$7\$J\$*\u001b(B
|
|
sl@0
|
334 |
\u001b\$B\$*4j\$\$\$\$\$?\$7\$^\$9!#\$^\$?!\"BgJQ62=L\$G\$9\$,!\"=;=jJQ99\$N\$\"\$H!\"F|K\\8l%5!<%S%9It!J\u001b(B
|
|
sl@0
|
335 |
casino_japanese@___.com \u001b\$B!K\$^\$G\$4=;=jJQ99:Q\$NO\"Mm\$r\$\$\$?\$@\$1\$J\$\$\$G\u001b(B
|
|
sl@0
|
336 |
\u001b\$B\$7\$g\$&\$+!)\u001b(B"
|
|
sl@0
|
337 |
|
|
sl@0
|
338 |
set ::iso2022uniData [encoding convertfrom iso2022-jp $::iso2022encData]
|
|
sl@0
|
339 |
set ::iso2022uniData2 "\u79c1\u3069\u3082\u3067\u306f\u3001\u30c1\u30c3\u30d7\u3054\u8cfc\u5165\u6642\u306b\u3054\u767b\u9332\u3044\u305f\u3060\u3044\u305f\u3054\u4f4f\u6240\u3092\u30ad\u30e3\u30c3\u30b7\u30e5\u30a2\u30a6\u30c8\u306e\u969b\u306e
|
|
sl@0
|
340 |
\u5c0f\u5207\u624b\u9001\u4ed8\u5148\u3068\u3057\u3066\u4f7f\u7528\u3057\u3066\u304a\u308a\u307e\u3059\u3002\u6050\u308c\u5165\u308a\u307e\u3059\u304c\u3001\u6b63\u3057\u3044\u4f4f\u6240\u3092\u3054\u767b\u9332\u3057\u306a\u304a
|
|
sl@0
|
341 |
\u304a\u9858\u3044\u3044\u305f\u3057\u307e\u3059\u3002\u307e\u305f\u3001\u5927\u5909\u6050\u7e2e\u3067\u3059\u304c\u3001\u4f4f\u6240\u5909\u66f4\u306e\u3042\u3068\u3001\u65e5\u672c\u8a9e\u30b5\u30fc\u30d3\u30b9\u90e8\uff08
|
|
sl@0
|
342 |
\u0063\u0061\u0073\u0069\u006e\u006f\u005f\u006a\u0061\u0070\u0061\u006e\u0065\u0073\u0065\u0040\u005f\u005f\u005f\u002e\u0063\u006f\u006d\u0020\uff09\u307e\u3067\u3054\u4f4f\u6240\u5909\u66f4\u6e08\u306e\u9023\u7d61\u3092\u3044\u305f\u3060\u3051\u306a\u3044\u3067
|
|
sl@0
|
343 |
\u3057\u3087\u3046\u304b\uff1f"
|
|
sl@0
|
344 |
|
|
sl@0
|
345 |
cd [temporaryDirectory]
|
|
sl@0
|
346 |
set fid [open iso2022.txt w]
|
|
sl@0
|
347 |
fconfigure $fid -encoding binary
|
|
sl@0
|
348 |
puts -nonewline $fid $::iso2022encData
|
|
sl@0
|
349 |
close $fid
|
|
sl@0
|
350 |
|
|
sl@0
|
351 |
test encoding-23.1 {iso2022-jp escape encoding test} {
|
|
sl@0
|
352 |
string equal $::iso2022uniData $::iso2022uniData2
|
|
sl@0
|
353 |
} 1
|
|
sl@0
|
354 |
test encoding-23.2 {iso2022-jp escape encoding test} {
|
|
sl@0
|
355 |
# This checks that 'gets' isn't resetting the encoding inappropriately.
|
|
sl@0
|
356 |
# [Bug #523988]
|
|
sl@0
|
357 |
set fid [open iso2022.txt r]
|
|
sl@0
|
358 |
fconfigure $fid -encoding iso2022-jp
|
|
sl@0
|
359 |
set out ""
|
|
sl@0
|
360 |
set count 0
|
|
sl@0
|
361 |
while {[set num [gets $fid line]] >= 0} {
|
|
sl@0
|
362 |
if {$count} {
|
|
sl@0
|
363 |
incr count 1 ; # account for newline
|
|
sl@0
|
364 |
append out \n
|
|
sl@0
|
365 |
}
|
|
sl@0
|
366 |
append out $line
|
|
sl@0
|
367 |
incr count $num
|
|
sl@0
|
368 |
}
|
|
sl@0
|
369 |
close $fid
|
|
sl@0
|
370 |
if {[string compare $::iso2022uniData $out]} {
|
|
sl@0
|
371 |
return -code error "iso2022-jp read in doesn't match original"
|
|
sl@0
|
372 |
}
|
|
sl@0
|
373 |
list $count $out
|
|
sl@0
|
374 |
} [list [string length $::iso2022uniData] $::iso2022uniData]
|
|
sl@0
|
375 |
test encoding-23.3 {iso2022-jp escape encoding test} {
|
|
sl@0
|
376 |
# read $fis <size> reads size in chars, not raw bytes.
|
|
sl@0
|
377 |
set fid [open iso2022.txt r]
|
|
sl@0
|
378 |
fconfigure $fid -encoding iso2022-jp
|
|
sl@0
|
379 |
set data [read $fid 50]
|
|
sl@0
|
380 |
close $fid
|
|
sl@0
|
381 |
set data
|
|
sl@0
|
382 |
} [string range $::iso2022uniData 0 49] ; # 0 .. 49 inclusive == 50
|
|
sl@0
|
383 |
cd [workingDirectory]
|
|
sl@0
|
384 |
|
|
sl@0
|
385 |
test encoding-24.1 {EscapeFreeProc on open channels} -constraints {
|
|
sl@0
|
386 |
exec
|
|
sl@0
|
387 |
} -setup {
|
|
sl@0
|
388 |
# Bug #524674 input
|
|
sl@0
|
389 |
set file [makeFile {
|
|
sl@0
|
390 |
set f [open [file join [file dirname [info script]] iso2022.txt]]
|
|
sl@0
|
391 |
fconfigure $f -encoding iso2022-jp
|
|
sl@0
|
392 |
gets $f
|
|
sl@0
|
393 |
} iso2022.tcl]
|
|
sl@0
|
394 |
} -body {
|
|
sl@0
|
395 |
exec [interpreter] $file
|
|
sl@0
|
396 |
} -cleanup {
|
|
sl@0
|
397 |
removeFile iso2022.tcl
|
|
sl@0
|
398 |
} -result {}
|
|
sl@0
|
399 |
|
|
sl@0
|
400 |
test encoding-24.2 {EscapeFreeProc on open channels} -constraints {
|
|
sl@0
|
401 |
exec
|
|
sl@0
|
402 |
} -setup {
|
|
sl@0
|
403 |
# Bug #524674 output
|
|
sl@0
|
404 |
set file [makeFile {
|
|
sl@0
|
405 |
fconfigure stdout -encoding iso2022-jp
|
|
sl@0
|
406 |
puts ab\u4e4e\u68d9g
|
|
sl@0
|
407 |
exit
|
|
sl@0
|
408 |
} iso2022.tcl]
|
|
sl@0
|
409 |
} -body {
|
|
sl@0
|
410 |
viewable [exec [interpreter] $file]
|
|
sl@0
|
411 |
} -cleanup {
|
|
sl@0
|
412 |
removeFile iso2022.tcl
|
|
sl@0
|
413 |
} -result "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"
|
|
sl@0
|
414 |
|
|
sl@0
|
415 |
test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
|
|
sl@0
|
416 |
# Bug #219314 - if we don't free escape encodings correctly on
|
|
sl@0
|
417 |
# channel closure, we go boom
|
|
sl@0
|
418 |
set file [makeFile {
|
|
sl@0
|
419 |
encoding system iso2022-jp
|
|
sl@0
|
420 |
set a "\u4e4e\u4e5e\u4e5f"; # 3 Japanese Kanji letters
|
|
sl@0
|
421 |
puts $a
|
|
sl@0
|
422 |
} iso2022.tcl]
|
|
sl@0
|
423 |
set f [open "|[list [interpreter] $file]"]
|
|
sl@0
|
424 |
fconfigure $f -encoding iso2022-jp
|
|
sl@0
|
425 |
set count [gets $f line]
|
|
sl@0
|
426 |
close $f
|
|
sl@0
|
427 |
removeFile iso2022.tcl
|
|
sl@0
|
428 |
list $count [viewable $line]
|
|
sl@0
|
429 |
} [list 3 "\u4e4e\u4e5e\u4e5f (\\u4e4e\\u4e5e\\u4e5f)"]
|
|
sl@0
|
430 |
|
|
sl@0
|
431 |
file delete [file join [temporaryDirectory] iso2022.txt]
|
|
sl@0
|
432 |
|
|
sl@0
|
433 |
#
|
|
sl@0
|
434 |
# Begin jajp encoding round-trip conformity tests
|
|
sl@0
|
435 |
#
|
|
sl@0
|
436 |
proc foreach-jisx0208 {varName command} {
|
|
sl@0
|
437 |
upvar 1 $varName code
|
|
sl@0
|
438 |
foreach range {
|
|
sl@0
|
439 |
{2121 217E}
|
|
sl@0
|
440 |
{2221 222E}
|
|
sl@0
|
441 |
{223A 2241}
|
|
sl@0
|
442 |
{224A 2250}
|
|
sl@0
|
443 |
{225C 226A}
|
|
sl@0
|
444 |
{2272 2279}
|
|
sl@0
|
445 |
{227E 227E}
|
|
sl@0
|
446 |
{2330 2339}
|
|
sl@0
|
447 |
{2421 2473}
|
|
sl@0
|
448 |
{2521 2576}
|
|
sl@0
|
449 |
{2821 2821}
|
|
sl@0
|
450 |
{282C 282C}
|
|
sl@0
|
451 |
{2837 2837}
|
|
sl@0
|
452 |
|
|
sl@0
|
453 |
{30 21 4E 7E}
|
|
sl@0
|
454 |
{4F21 4F53}
|
|
sl@0
|
455 |
|
|
sl@0
|
456 |
{50 21 73 7E}
|
|
sl@0
|
457 |
{7421 7426}
|
|
sl@0
|
458 |
} {
|
|
sl@0
|
459 |
if {[llength $range] == 2} {
|
|
sl@0
|
460 |
# for adhoc range. simple {first last}. inclusive.
|
|
sl@0
|
461 |
set first [scan [lindex $range 0] %x]
|
|
sl@0
|
462 |
set last [scan [lindex $range 1] %x]
|
|
sl@0
|
463 |
for {set i $first} {$i <= $last} {incr i} {
|
|
sl@0
|
464 |
set code $i
|
|
sl@0
|
465 |
uplevel 1 $command
|
|
sl@0
|
466 |
}
|
|
sl@0
|
467 |
} elseif {[llength $range] == 4} {
|
|
sl@0
|
468 |
# for uniform range.
|
|
sl@0
|
469 |
set h0 [scan [lindex $range 0] %x]
|
|
sl@0
|
470 |
set l0 [scan [lindex $range 1] %x]
|
|
sl@0
|
471 |
set hend [scan [lindex $range 2] %x]
|
|
sl@0
|
472 |
set lend [scan [lindex $range 3] %x]
|
|
sl@0
|
473 |
for {set hi $h0} {$hi <= $hend} {incr hi} {
|
|
sl@0
|
474 |
for {set lo $l0} {$lo <= $lend} {incr lo} {
|
|
sl@0
|
475 |
set code [expr {$hi << 8 | ($lo & 0xff)}]
|
|
sl@0
|
476 |
uplevel 1 $command
|
|
sl@0
|
477 |
}
|
|
sl@0
|
478 |
}
|
|
sl@0
|
479 |
} else {
|
|
sl@0
|
480 |
error "really?"
|
|
sl@0
|
481 |
}
|
|
sl@0
|
482 |
}
|
|
sl@0
|
483 |
}
|
|
sl@0
|
484 |
proc gen-jisx0208-euc-jp {code} {
|
|
sl@0
|
485 |
binary format cc \
|
|
sl@0
|
486 |
[expr {($code >> 8) | 0x80}] [expr {($code & 0xff) | 0x80}]
|
|
sl@0
|
487 |
}
|
|
sl@0
|
488 |
proc gen-jisx0208-iso2022-jp {code} {
|
|
sl@0
|
489 |
binary format a3cca3 \
|
|
sl@0
|
490 |
"\x1b\$B" [expr {$code >> 8}] [expr {$code & 0xff}] "\x1b(B"
|
|
sl@0
|
491 |
}
|
|
sl@0
|
492 |
proc gen-jisx0208-cp932 {code} {
|
|
sl@0
|
493 |
set c1 [expr {($code >> 8) | 0x80}]
|
|
sl@0
|
494 |
set c2 [expr {($code & 0xff)| 0x80}]
|
|
sl@0
|
495 |
if {$c1 % 2} {
|
|
sl@0
|
496 |
set c1 [expr {($c1 >> 1) + ($c1 < 0xdf ? 0x31 : 0x71)}]
|
|
sl@0
|
497 |
incr c2 [expr {- (0x60 + ($c2 < 0xe0))}]
|
|
sl@0
|
498 |
} else {
|
|
sl@0
|
499 |
set c1 [expr {($c1 >> 1) + ($c1 < 0xdf ? 0x30 : 0x70)}]
|
|
sl@0
|
500 |
incr c2 -2
|
|
sl@0
|
501 |
}
|
|
sl@0
|
502 |
binary format cc $c1 $c2
|
|
sl@0
|
503 |
}
|
|
sl@0
|
504 |
proc channel-diff {fa fb} {
|
|
sl@0
|
505 |
set diff {}
|
|
sl@0
|
506 |
while {[gets $fa la] >= 0 && [gets $fb lb] >= 0} {
|
|
sl@0
|
507 |
if {[string compare $la $lb] == 0} continue
|
|
sl@0
|
508 |
# lappend diff $la $lb
|
|
sl@0
|
509 |
|
|
sl@0
|
510 |
# For more readable (easy to analyze) output.
|
|
sl@0
|
511 |
set code [lindex $la 0]
|
|
sl@0
|
512 |
binary scan [lindex $la 1] H* expected
|
|
sl@0
|
513 |
binary scan [lindex $lb 1] H* got
|
|
sl@0
|
514 |
lappend diff [list $code $expected $got]
|
|
sl@0
|
515 |
}
|
|
sl@0
|
516 |
set diff
|
|
sl@0
|
517 |
}
|
|
sl@0
|
518 |
|
|
sl@0
|
519 |
# Create char tables.
|
|
sl@0
|
520 |
cd [temporaryDirectory]
|
|
sl@0
|
521 |
foreach enc {cp932 euc-jp iso2022-jp} {
|
|
sl@0
|
522 |
set f [open $enc.chars w]
|
|
sl@0
|
523 |
fconfigure $f -encoding binary
|
|
sl@0
|
524 |
foreach-jisx0208 code {
|
|
sl@0
|
525 |
puts $f [format "%04X %s" $code [gen-jisx0208-$enc $code]]
|
|
sl@0
|
526 |
}
|
|
sl@0
|
527 |
close $f
|
|
sl@0
|
528 |
}
|
|
sl@0
|
529 |
# shiftjis == cp932 for jisx0208.
|
|
sl@0
|
530 |
file copy -force cp932.chars shiftjis.chars
|
|
sl@0
|
531 |
|
|
sl@0
|
532 |
set NUM 0
|
|
sl@0
|
533 |
foreach from {cp932 shiftjis euc-jp iso2022-jp} {
|
|
sl@0
|
534 |
foreach to {cp932 shiftjis euc-jp iso2022-jp} {
|
|
sl@0
|
535 |
test encoding-25.[incr NUM] "jisx0208 $from => $to" {
|
|
sl@0
|
536 |
cd [temporaryDirectory]
|
|
sl@0
|
537 |
set f [open $from.chars]
|
|
sl@0
|
538 |
fconfigure $f -encoding $from
|
|
sl@0
|
539 |
set out [open $from.$to.out w]
|
|
sl@0
|
540 |
fconfigure $out -encoding $to
|
|
sl@0
|
541 |
puts -nonewline $out [read $f]
|
|
sl@0
|
542 |
close $out
|
|
sl@0
|
543 |
close $f
|
|
sl@0
|
544 |
|
|
sl@0
|
545 |
# then compare $to.chars <=> $from.to.out as binary.
|
|
sl@0
|
546 |
set fa [open $to.chars]
|
|
sl@0
|
547 |
fconfigure $fa -encoding binary
|
|
sl@0
|
548 |
set fb [open $from.$to.out]
|
|
sl@0
|
549 |
fconfigure $fb -encoding binary
|
|
sl@0
|
550 |
set diff [channel-diff $fa $fb]
|
|
sl@0
|
551 |
close $fa
|
|
sl@0
|
552 |
close $fb
|
|
sl@0
|
553 |
|
|
sl@0
|
554 |
# Difference should be empty.
|
|
sl@0
|
555 |
set diff
|
|
sl@0
|
556 |
} {}
|
|
sl@0
|
557 |
}
|
|
sl@0
|
558 |
}
|
|
sl@0
|
559 |
|
|
sl@0
|
560 |
eval [list file delete] [glob -directory [temporaryDirectory] *.chars *.out]
|
|
sl@0
|
561 |
# ===> Cut here <===
|
|
sl@0
|
562 |
|
|
sl@0
|
563 |
# EscapeFreeProc, GetTableEncoding, unilen
|
|
sl@0
|
564 |
# are fully tested by the rest of this file
|
|
sl@0
|
565 |
|
|
sl@0
|
566 |
# cleanup
|
|
sl@0
|
567 |
::tcltest::cleanupTests
|
|
sl@0
|
568 |
return
|