Tcl Source Code

Check-in [746b31b209]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:General cleanup of tests to promote intelligibility and to try to ensure that what is tested is just that which was the subject of the test.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 746b31b209f6f76bffce6d447f82acea31316966
User & Date: dkf 2011-08-01 10:07:23
Context
2011-08-01
17:15
* generic/tclProc.c (TclProcCompileProc): fix for leak of resolveInfo when recompiling procs, [Bug 3... check-in: 5a334ac208 user: mig tags: trunk
10:07
General cleanup of tests to promote intelligibility and to try to ensure that what is tested is just... check-in: 746b31b209 user: dkf tags: trunk
09:34
Added some examples of how some of the standard global variables can be used, following prompting by... check-in: 02393482fb user: dkf tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/encoding.test.

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
91
92
93
94
95
96
97
98
99
100
101

102
103
104


105
106
107
108
109
110


111
112
113
114
115
116
117
118
119
120
121

122
123

124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
# This file contains a collection of tests for tclEncoding.c
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2

namespace eval ::tcl::test::encoding {
    variable x

namespace import -force ::tcltest::*

proc toutf {args} {
    variable x
    lappend x "toutf $args"
}
proc fromutf {args} {
    variable x
    lappend x "fromutf $args"
}

proc runtests {} {

    variable x

# Some tests require the testencoding command
testConstraint testencoding [llength [info commands testencoding]]
testConstraint exec [llength [info commands exec]]


# TclInitEncodingSubsystem is tested by the rest of this file
# TclFinalizeEncodingSubsystem is not currently tested

test encoding-1.1 {Tcl_GetEncoding: system encoding} {testencoding} {
    testencoding create foo [namespace origin toutf] [namespace origin fromutf]
    set old [encoding system]


    encoding system foo
    set x {}
    encoding convertto abcd


    encoding system $old
    testencoding delete foo
    set x
} {{fromutf }}
test encoding-1.2 {Tcl_GetEncoding: existing encoding} {testencoding} {
    testencoding create foo [namespace origin toutf] [namespace origin fromutf]
    set x {}
    encoding convertto foo abcd
    testencoding delete foo
    set x
} {{fromutf }}
test encoding-1.3 {Tcl_GetEncoding: load encoding} {
    list [encoding convertto jis0208 \u4e4e] \
	[encoding convertfrom jis0208 8C]
} "8C \u4e4e"

test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} {
    encoding convertto jis0208 \u4e4e
} {8C}
test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} {testencoding} {
    set system [encoding system]
    set path [encoding dirs]

    encoding system shiftjis		;# incr ref count
    encoding dirs [list [pwd]]
    set x [encoding convertto shiftjis \u4e4e]	;# old one found   
    encoding system identity
    llength shiftjis		;# Shimmer away any cache of Tcl_Encoding
    lappend x [catch {encoding convertto shiftjis \u4e4e} msg] $msg

    encoding system identity
    encoding dirs $path
    encoding system $system
    set x
} "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"

test encoding-3.1 {Tcl_GetEncodingName, NULL} {
    set old [encoding system]

    encoding system shiftjis
    set x [encoding system]

    encoding system $old
    set x
} {shiftjis}
test encoding-3.2 {Tcl_GetEncodingName, non-null} {
    set old [fconfigure stdout -encoding]

    fconfigure stdout -encoding jis0208
    set x [fconfigure stdout -encoding]

    fconfigure stdout -encoding $old
    set x
} {jis0208}

test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} {
    cd [makeDirectory tmp]
    makeDirectory [file join tmp encoding]
    makeFile {} [file join tmp encoding junk.enc]
    makeFile {} [file join tmp encoding junk2.enc]
    set path [encoding dirs]
    encoding dirs {}
    catch {unset encodings}
    catch {unset x}

    foreach encoding [encoding names] {
	set encodings($encoding) 1
    }


    encoding dirs [list [file join [pwd] encoding]]
    foreach encoding [encoding names] {
	if {![info exists encodings($encoding)]} {
	    lappend x $encoding
	}
    }


    encoding dirs $path
    cd [workingDirectory]
    removeFile [file join tmp encoding junk2.enc]
    removeFile [file join tmp encoding junk.enc]
    removeDirectory [file join tmp encoding]
    removeDirectory tmp
    lsort $x
} {junk junk2}

test encoding-5.1 {Tcl_SetSystemEncoding} {
    set old [encoding system]

    encoding system jis0208
    set x [encoding convertto \u4e4e]

    encoding system identity
    encoding system $old
    set x
} {8C}
test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} {
    set old [encoding system]
    encoding system $old
    string compare $old [encoding system]
} {0}

test encoding-6.1 {Tcl_CreateEncoding: new} {testencoding} {
    testencoding create foo [namespace code {toutf 1}] \
	[namespace code {fromutf 2}]
    set x {}
    encoding convertfrom foo abcd
    encoding convertto foo abcd
    testencoding delete foo
    set x
} {{toutf 1} {fromutf 2}}
test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} {
    testencoding create foo [namespace code {toutf a}] \
	[namespace code {fromutf b}]
    set x {}
    encoding convertfrom foo abcd
    encoding convertto foo abcd
    testencoding delete foo
    set x
} {{toutf a} {fromutf b}}

test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} {
    encoding convertfrom jis0208 8c8c8c8c
} "\u543e\u543e\u543e\u543e"
test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} {
    set a 8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C

|
|




|
|


















<





>
|



|
<

>
>



>
>


<
|





|









|


>






>



<
|

|

>

|
>

<
|
|

>

|
>

<
|

|


<
<




>



>
>






>
>






<
|

|

>

|
>


<
|













|








|







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
91
92
93
94
95

96
97
98
99
100


101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124

125
126
127
128
129
130
131
132
133
134

135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
# This file contains a collection of tests for tclEncoding.c
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2

namespace eval ::tcl::test::encoding {
    variable x

namespace import -force ::tcltest::*

proc toutf {args} {
    variable x
    lappend x "toutf $args"
}
proc fromutf {args} {
    variable x
    lappend x "fromutf $args"
}

proc runtests {} {

    variable x

# Some tests require the testencoding command
testConstraint testencoding [llength [info commands testencoding]]
testConstraint exec [llength [info commands exec]]
testConstraint testgetdefenc [llength [info commands testgetdefenc]]

# TclInitEncodingSubsystem is tested by the rest of this file
# TclFinalizeEncodingSubsystem is not currently tested

test encoding-1.1 {Tcl_GetEncoding: system encoding} -setup {

    set old [encoding system]
} -constraints {testencoding} -body {
    testencoding create foo [namespace origin toutf] [namespace origin fromutf]
    encoding system foo
    set x {}
    encoding convertto abcd
    return $x
} -cleanup {
    encoding system $old
    testencoding delete foo

} -result {{fromutf }}
test encoding-1.2 {Tcl_GetEncoding: existing encoding} {testencoding} {
    testencoding create foo [namespace origin toutf] [namespace origin fromutf]
    set x {}
    encoding convertto foo abcd
    testencoding delete foo
    return $x
} {{fromutf }}
test encoding-1.3 {Tcl_GetEncoding: load encoding} {
    list [encoding convertto jis0208 \u4e4e] \
	[encoding convertfrom jis0208 8C]
} "8C \u4e4e"

test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} {
    encoding convertto jis0208 \u4e4e
} {8C}
test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} -setup {
    set system [encoding system]
    set path [encoding dirs]
} -constraints {testencoding} -body {
    encoding system shiftjis		;# incr ref count
    encoding dirs [list [pwd]]
    set x [encoding convertto shiftjis \u4e4e]	;# old one found   
    encoding system identity
    llength shiftjis		;# Shimmer away any cache of Tcl_Encoding
    lappend x [catch {encoding convertto shiftjis \u4e4e} msg] $msg
} -cleanup {
    encoding system identity
    encoding dirs $path
    encoding system $system

} -result "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"

test encoding-3.1 {Tcl_GetEncodingName, NULL} -setup {
    set old [encoding system]
} -body {
    encoding system shiftjis
    encoding system
} -cleanup {
    encoding system $old

} -result {shiftjis}
test encoding-3.2 {Tcl_GetEncodingName, non-null} -setup {
    set old [fconfigure stdout -encoding]
} -body {
    fconfigure stdout -encoding jis0208
    fconfigure stdout -encoding
} -cleanup {
    fconfigure stdout -encoding $old

} -result {jis0208}

test encoding-4.1 {Tcl_GetEncodingNames} -constraints {testencoding} -setup {
    cd [makeDirectory tmp]
    makeDirectory [file join tmp encoding]


    set path [encoding dirs]
    encoding dirs {}
    catch {unset encodings}
    catch {unset x}
} -body {
    foreach encoding [encoding names] {
	set encodings($encoding) 1
    }
    makeFile {} [file join tmp encoding junk.enc]
    makeFile {} [file join tmp encoding junk2.enc]
    encoding dirs [list [file join [pwd] encoding]]
    foreach encoding [encoding names] {
	if {![info exists encodings($encoding)]} {
	    lappend x $encoding
	}
    }
    lsort $x
} -cleanup {
    encoding dirs $path
    cd [workingDirectory]
    removeFile [file join tmp encoding junk2.enc]
    removeFile [file join tmp encoding junk.enc]
    removeDirectory [file join tmp encoding]
    removeDirectory tmp

} -result {junk junk2}

test encoding-5.1 {Tcl_SetSystemEncoding} -setup {
    set old [encoding system]
} -body {
    encoding system jis0208
    encoding convertto \u4e4e
} -cleanup {
    encoding system identity
    encoding system $old

} -result {8C}
test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} {
    set old [encoding system]
    encoding system $old
    string compare $old [encoding system]
} {0}

test encoding-6.1 {Tcl_CreateEncoding: new} {testencoding} {
    testencoding create foo [namespace code {toutf 1}] \
	[namespace code {fromutf 2}]
    set x {}
    encoding convertfrom foo abcd
    encoding convertto foo abcd
    testencoding delete foo
    return $x
} {{toutf 1} {fromutf 2}}
test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} {
    testencoding create foo [namespace code {toutf a}] \
	[namespace code {fromutf b}]
    set x {}
    encoding convertfrom foo abcd
    encoding convertto foo abcd
    testencoding delete foo
    return $x
} {{toutf a} {fromutf b}}

test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} {
    encoding convertfrom jis0208 8c8c8c8c
} "\u543e\u543e\u543e\u543e"
test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} {
    set a 8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
    puts -nonewline $f "ab\x8c\xc1g"
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary -encoding shiftjis    
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    set x
} "ab\u4e4eg"

test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {
    encoding convertto jis0208 "\u543e\u543e\u543e\u543e"
} {8c8c8c8c}
test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} {
    set a \u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e







|







177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
    puts -nonewline $f "ab\x8c\xc1g"
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary -encoding shiftjis    
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x
} "ab\u4e4eg"

test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {
    encoding convertto jis0208 "\u543e\u543e\u543e\u543e"
} {8c8c8c8c}
test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} {
    set a \u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
    puts -nonewline $f "ab\u4e4eg"
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary -encoding iso8859-1
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    set x
} "ab\x8c\xc1g"

proc viewable {str} {
    set res ""
    foreach c [split $str {}] {
	if {[string is print $c] && [string is ascii $c]} {
	    append res $c







|







205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
    puts -nonewline $f "ab\u4e4eg"
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary -encoding iso8859-1
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x
} "ab\x8c\xc1g"

proc viewable {str} {
    set res ""
    foreach c [split $str {}] {
	if {[string is print $c] && [string is ascii $c]} {
	    append res $c
238
239
240
241
242
243
244
245
246
247
248

249
250
251
252
253
254
255
256
257

258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
} "\u4e4e"
test encoding-11.5 {LoadEncodingFile: escape file} {
    viewable [encoding convertto iso2022 \u4e4e]
} [viewable "\x1b\$B8C\x1b(B"]
test encoding-11.5.1 {LoadEncodingFile: escape file} {
    viewable [encoding convertto iso2022-jp \u4e4e]
} [viewable "\x1b\$B8C\x1b(B"]
test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} {
    set system [encoding system]
    set path [encoding dirs]
    encoding system identity

    cd [temporaryDirectory]
    encoding dirs [file join tmp encoding]
    makeDirectory tmp
    makeDirectory [file join tmp encoding]
    set f [open [file join tmp encoding splat.enc] w]
    fconfigure $f -translation binary 
    puts $f "abcdefghijklmnop"
    close $f
    set x [list [catch {encoding convertto splat \u4e4e} msg] $msg]

    file delete [file join [temporaryDirectory] tmp encoding splat.enc]
    removeDirectory [file join tmp encoding]
    removeDirectory tmp
    cd [workingDirectory]
    encoding dirs $path
    encoding system $system
    set x
} {1 {invalid encoding file "splat"}}

# OpenEncodingFile is fully tested by the rest of the tests in this file.

test encoding-12.1 {LoadTableEncoding: normal encoding} {
    set x [encoding convertto iso8859-3 \u120]
    append x [encoding convertto iso8859-3 \ud5]
    append x [encoding convertfrom iso8859-3 \xd5]







|



>








|
>






<
|







246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273

274
275
276
277
278
279
280
281
} "\u4e4e"
test encoding-11.5 {LoadEncodingFile: escape file} {
    viewable [encoding convertto iso2022 \u4e4e]
} [viewable "\x1b\$B8C\x1b(B"]
test encoding-11.5.1 {LoadEncodingFile: escape file} {
    viewable [encoding convertto iso2022-jp \u4e4e]
} [viewable "\x1b\$B8C\x1b(B"]
test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding} -setup {
    set system [encoding system]
    set path [encoding dirs]
    encoding system identity
} -body {
    cd [temporaryDirectory]
    encoding dirs [file join tmp encoding]
    makeDirectory tmp
    makeDirectory [file join tmp encoding]
    set f [open [file join tmp encoding splat.enc] w]
    fconfigure $f -translation binary 
    puts $f "abcdefghijklmnop"
    close $f
    encoding convertto splat \u4e4e
} -returnCodes error -cleanup {
    file delete [file join [temporaryDirectory] tmp encoding splat.enc]
    removeDirectory [file join tmp encoding]
    removeDirectory tmp
    cd [workingDirectory]
    encoding dirs $path
    encoding system $system

} -result {invalid encoding file "splat"}

# OpenEncodingFile is fully tested by the rest of the tests in this file.

test encoding-12.1 {LoadTableEncoding: normal encoding} {
    set x [encoding convertto iso8859-3 \u120]
    append x [encoding convertto iso8859-3 \ud5]
    append x [encoding convertfrom iso8859-3 \xd5]
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
test encoding-14.1 {BinaryProc} {
    encoding convertto identity \x12\x34\x56\xff\x69
} "\x12\x34\x56\xc3\xbf\x69"

test encoding-15.1 {UtfToUtfProc} {
    encoding convertto utf-8 \xa3
} "\xc2\xa3"

test encoding-15.2 {UtfToUtfProc null character output} {
    set x \u0000
    set y [encoding convertto utf-8 \u0000]
    set y [encoding convertfrom identity $y]
    binary scan $y H* z
    list [string bytelength $x] [string bytelength $y] $z
} {2 1 00}

test encoding-15.3 {UtfToUtfProc null character input} {
    set x [encoding convertfrom identity \x00]
    set y [encoding convertfrom utf-8 $x]
    binary scan [encoding convertto identity $y] H* z
    list [string bytelength $x] [string bytelength $y] $z
} {1 2 c080}








<







<







305
306
307
308
309
310
311

312
313
314
315
316
317
318

319
320
321
322
323
324
325
test encoding-14.1 {BinaryProc} {
    encoding convertto identity \x12\x34\x56\xff\x69
} "\x12\x34\x56\xc3\xbf\x69"

test encoding-15.1 {UtfToUtfProc} {
    encoding convertto utf-8 \xa3
} "\xc2\xa3"

test encoding-15.2 {UtfToUtfProc null character output} {
    set x \u0000
    set y [encoding convertto utf-8 \u0000]
    set y [encoding convertfrom identity $y]
    binary scan $y H* z
    list [string bytelength $x] [string bytelength $y] $z
} {2 1 00}

test encoding-15.3 {UtfToUtfProc null character input} {
    set x [encoding convertfrom identity \x00]
    set y [encoding convertfrom utf-8 $x]
    binary scan [encoding convertto identity $y] H* z
    list [string bytelength $x] [string bytelength $y] $z
} {1 2 c080}

384
385
386
387
388
389
390
391
392
393
394











395
396
397
398
399
400
401
402
403
404
405
406
407
408
409

410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
} [list [string length $iso2022uniData] $iso2022uniData]
test encoding-23.3 {iso2022-jp escape encoding test} {
    # read $fis <size> reads size in chars, not raw bytes.
    set fid [open iso2022.txt r]
    fconfigure $fid -encoding iso2022-jp
    set data [read $fid 50]
    close $fid
    set data
} [string range $iso2022uniData 0 49] ; # 0 .. 49 inclusive == 50
cd [workingDirectory]












test encoding-24.1 {EscapeFreeProc on open channels} -constraints {
	exec
} -setup {
    # Bug #524674 input
    set file [makeFile {
	set f [open [file join [file dirname [info script]] iso2022.txt]]
	fconfigure $f -encoding iso2022-jp
	gets $f
    } iso2022.tcl]
} -body {
    exec [interpreter] $file
} -cleanup {
    removeFile iso2022.tcl
} -result {}


test encoding-24.2 {EscapeFreeProc on open channels} -constraints {
	exec
} -setup {
    # Bug #524674 output
    set file [makeFile {
	encoding system cp1252;	# Bug #2891556 crash revelator
	fconfigure stdout -encoding iso2022-jp
	puts ab\u4e4e\u68d9g
	testfinexit
    } iso2022.tcl]
} -body {
    viewable [exec [interpreter] $file]
} -cleanup {
    removeFile iso2022.tcl
} -result "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"

test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
    # Bug #219314 - if we don't free escape encodings correctly on
    # channel closure, we go boom
    set file [makeFile {
	encoding system iso2022-jp
	set a "\u4e4e\u4e5e\u4e5f"; # 3 Japanese Kanji letters
	puts $a
    } iso2022.tcl]
    set f [open "|[list [interpreter] $file]"]
    fconfigure $f -encoding iso2022-jp







|



>
>
>
>
>
>
>
>
>
>
>
|
|
<
<
<



<
<
<
<
<
<
|
>
|
<
<

|




<
|
<
<
<
|
<

|
|







391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414



415
416
417






418
419
420


421
422
423
424
425
426

427



428

429
430
431
432
433
434
435
436
437
438
} [list [string length $iso2022uniData] $iso2022uniData]
test encoding-23.3 {iso2022-jp escape encoding test} {
    # read $fis <size> reads size in chars, not raw bytes.
    set fid [open iso2022.txt r]
    fconfigure $fid -encoding iso2022-jp
    set data [read $fid 50]
    close $fid
    return $data
} [string range $iso2022uniData 0 49] ; # 0 .. 49 inclusive == 50
cd [workingDirectory]

# Code to make the next few tests more intelligible; the code being tested
# should be in the body of the test!
proc runInSubprocess {contents {filename iso2022.tcl}} {
    set theFile [makeFile $contents $filename]
    try {
	exec [interpreter] $theFile
    } finally {
	removeFile $theFile
    }
}

test encoding-24.1 {EscapeFreeProc on open channels} exec {
    runInSubprocess {



	set f [open [file join [file dirname [info script]] iso2022.txt]]
	fconfigure $f -encoding iso2022-jp
	gets $f






    }
} {}
test encoding-24.2 {EscapeFreeProc on open channels} exec {


    # Bug #524674 output
    viewable [runInSubprocess {
	encoding system cp1252;	# Bug #2891556 crash revelator
	fconfigure stdout -encoding iso2022-jp
	puts ab\u4e4e\u68d9g
	testfinexit

    }]



} "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"

test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
    # Bug #219314 - if we don't free escape encodings correctly on channel
    # closure, we go boom
    set file [makeFile {
	encoding system iso2022-jp
	set a "\u4e4e\u4e5e\u4e5f"; # 3 Japanese Kanji letters
	puts $a
    } iso2022.tcl]
    set f [open "|[list [interpreter] $file]"]
    fconfigure $f -encoding iso2022-jp
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
	{4F21 4F53}

	{50 21 73 7E}
	{7421 7426}
    } {
	if {[llength $range] == 2} {
	    # for adhoc range. simple {first last}. inclusive.
	    set first [scan [lindex $range 0] %x]
	    set last [scan [lindex $range 1] %x]
	    for {set i $first} {$i <= $last} {incr i} {
		set code $i
		uplevel 1 $command
	    }
	} elseif {[llength $range] == 4} {
	    # for uniform range.
	    set h0 [scan [lindex $range 0] %x]
	    set l0 [scan [lindex $range 1] %x]
	    set hend [scan [lindex $range 2] %x]
	    set lend [scan [lindex $range 3] %x]
	    for {set hi $h0} {$hi <= $hend} {incr hi} {
		for {set lo $l0} {$lo <= $lend} {incr lo} {
		    set code [expr {$hi << 8 | ($lo & 0xff)}]
		    uplevel 1 $command
		}
	    }
	} else {







<
|






|
<
<
<







468
469
470
471
472
473
474

475
476
477
478
479
480
481
482



483
484
485
486
487
488
489
	{4F21 4F53}

	{50 21 73 7E}
	{7421 7426}
    } {
	if {[llength $range] == 2} {
	    # for adhoc range. simple {first last}. inclusive.

	    scan $range %x%x first last
	    for {set i $first} {$i <= $last} {incr i} {
		set code $i
		uplevel 1 $command
	    }
	} elseif {[llength $range] == 4} {
	    # for uniform range.
	    scan $range %x%x%x%x h0 l0 hend lend



	    for {set hi $h0} {$hi <= $hend} {incr hi} {
		for {set lo $l0} {$lo <= $lend} {incr lo} {
		    set code [expr {$hi << 8 | ($lo & 0xff)}]
		    uplevel 1 $command
		}
	    }
	} else {
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547

548
549
550
551
552
553
554
555
556
557
558
559
560
561


562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588

589
590
591
592
593
594
595
596
597





	# For more readable (easy to analyze) output.
	set code [lindex $la 0]
	binary scan [lindex $la 1] H* expected
	binary scan [lindex $lb 1] H* got
	lappend diff [list $code $expected $got]
    }
    set diff
}

# Create char tables.
cd [temporaryDirectory]
foreach enc {cp932 euc-jp iso2022-jp} {
    set f [open $enc.chars w]
    fconfigure $f -encoding binary
    foreach-jisx0208 code {
	puts $f [format "%04X %s" $code [gen-jisx0208-$enc $code]]
    }
    close $f
}
# shiftjis == cp932 for jisx0208.
file copy -force cp932.chars shiftjis.chars

set NUM 0
foreach from {cp932 shiftjis euc-jp iso2022-jp} {
    foreach to {cp932 shiftjis euc-jp iso2022-jp} {
	test encoding-25.[incr NUM] "jisx0208 $from => $to" {
	    cd [temporaryDirectory]

	    set f [open $from.chars]
	    fconfigure $f -encoding $from
	    set out [open $from.$to.tcltestout w]
	    fconfigure $out -encoding $to
	    puts -nonewline $out [read $f]
	    close $out
	    close $f
	    
	    # then compare $to.chars <=> $from.to.tcltestout as binary.
	    set fa [open $to.chars]
	    fconfigure $fa -encoding binary
	    set fb [open $from.$to.tcltestout]
	    fconfigure $fb -encoding binary
	    set diff [channel-diff $fa $fb]


	    close $fa
	    close $fb
	    
	    # Difference should be empty.
	    set diff
	} {}
    }
}

testConstraint testgetdefenc [llength [info commands testgetdefenc]]

test encoding-26.0 {Tcl_GetDefaultEncodingDir} -constraints {
    testgetdefenc 
} -setup {
     set origDir [testgetdefenc]
     testsetdefenc slappy
} -body {
     testgetdefenc
} -cleanup {
     testsetdefenc $origDir
} -result slappy

file delete {*}[glob -directory [temporaryDirectory] *.chars *.tcltestout]
# ===> Cut here <===

# EscapeFreeProc, GetTableEncoding, unilen
# are fully tested by the rest of this file

}
runtests

}

# cleanup
namespace delete ::tcl::test::encoding
::tcltest::cleanupTests
return











|


















|

>







<

|
<
|
<
|
>
>


|
<
<
<



<
<

|

|
|

|

|





|
|
>









>
>
>
>
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554

555
556

557

558
559
560
561
562
563



564
565
566


567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596

	# For more readable (easy to analyze) output.
	set code [lindex $la 0]
	binary scan [lindex $la 1] H* expected
	binary scan [lindex $lb 1] H* got
	lappend diff [list $code $expected $got]
    }
    return $diff
}

# Create char tables.
cd [temporaryDirectory]
foreach enc {cp932 euc-jp iso2022-jp} {
    set f [open $enc.chars w]
    fconfigure $f -encoding binary
    foreach-jisx0208 code {
	puts $f [format "%04X %s" $code [gen-jisx0208-$enc $code]]
    }
    close $f
}
# shiftjis == cp932 for jisx0208.
file copy -force cp932.chars shiftjis.chars

set NUM 0
foreach from {cp932 shiftjis euc-jp iso2022-jp} {
    foreach to {cp932 shiftjis euc-jp iso2022-jp} {
	test encoding-25.[incr NUM] "jisx0208 $from => $to" -setup {
	    cd [temporaryDirectory]
	} -body {
	    set f [open $from.chars]
	    fconfigure $f -encoding $from
	    set out [open $from.$to.tcltestout w]
	    fconfigure $out -encoding $to
	    puts -nonewline $out [read $f]
	    close $out
	    close $f

	    # then compare $to.chars <=> $from.to.tcltestout as binary.
	    set fa [open $to.chars rb]

	    set fb [open $from.$to.tcltestout rb]

	    channel-diff $fa $fb
	    # Difference should be empty.
	} -cleanup {
	    close $fa
	    close $fb
	} -result {}



    }
}



test encoding-26.0 {Tcl_GetDefaultEncodingDir} -constraints {
    testgetdefenc
} -setup {
    set origDir [testgetdefenc]
    testsetdefenc slappy
} -body {
    testgetdefenc
} -cleanup {
    testsetdefenc $origDir
} -result slappy

file delete {*}[glob -directory [temporaryDirectory] *.chars *.tcltestout]
# ===> Cut here <===

# EscapeFreeProc, GetTableEncoding, unilen are fully tested by the rest of
# this file.

}
runtests

}

# cleanup
namespace delete ::tcl::test::encoding
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End: