tcl/tests/encoding.test

   1 # This file contains a collection of tests for tclEncoding.c
   2 # Sourcing this file into Tcl runs the tests and generates output for
   3 # errors.  No output means no errors were found.
   4 #
   5 # Copyright (c) 1997 Sun Microsystems, Inc.
   6 # Copyright (c) 1998-1999 by Scriptics Corporation.
   7 #
   8 # See the file "license.terms" for information on usage and redistribution
   9 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10 #
  11 # RCS: @(#) $Id$
  12
  13 package require tcltest 2
  14 namespace import -force ::tcltest::*
  15
  16 proc toutf {args} {
  17     global x
  18     lappend x "toutf $args"
  19 }
  20 proc fromutf {args} {
  21     global x
  22     lappend x "fromutf $args"
  23 }
  24
  25 # Some tests require the testencoding command
  26 testConstraint testencoding [llength [info commands testencoding]]
  27 testConstraint exec [llength [info commands exec]]
  28
  29 # TclInitEncodingSubsystem is tested by the rest of this file
  30 # TclFinalizeEncodingSubsystem is not currently tested
  31
  32 test encoding-1.1 {Tcl_GetEncoding: system encoding} {testencoding} {
  33     testencoding create foo toutf fromutf
  34     set old [encoding system]
  35     encoding system foo
  36     set x {}
  37     encoding convertto abcd
  38     encoding system $old
  39     testencoding delete foo
  40     set x
  41 } {{fromutf }}
  42 test encoding-1.2 {Tcl_GetEncoding: existing encoding} {testencoding} {
  43     testencoding create foo toutf fromutf
  44     set x {}
  45     encoding convertto foo abcd
  46     testencoding delete foo
  47     set x
  48 } {{fromutf }}
  49 test encoding-1.3 {Tcl_GetEncoding: load encoding} {
  50     list [encoding convertto jis0208 \u4e4e] \
  51         [encoding convertfrom jis0208 8C]
  52 } "8C \u4e4e"
  53
  54 test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} {
  55     encoding convertto jis0208 \u4e4e
  56 } {8C}
  57 test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} {testencoding} {
  58     set system [encoding system]
  59     set path [testencoding path]
  60     encoding system shiftjis            ;# incr ref count
  61     testencoding path [list [pwd]]
  62     set x [encoding convertto shiftjis \u4e4e]  ;# old one found
  63     encoding system identity
  64     lappend x [catch {encoding convertto shiftjis \u4e4e} msg] $msg
  65     encoding system identity
  66     testencoding path $path
  67     encoding system $system
  68     set x
  69 } "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"
  70
  71 test encoding-3.1 {Tcl_GetEncodingName, NULL} {
  72     set old [encoding system]
  73     encoding system shiftjis
  74     set x [encoding system]
  75     encoding system $old
  76     set x
  77 } {shiftjis}
  78 test encoding-3.2 {Tcl_GetEncodingName, non-null} {
  79     set old [fconfigure stdout -encoding]
  80     fconfigure stdout -encoding jis0208
  81     set x [fconfigure stdout -encoding]
  82     fconfigure stdout -encoding $old
  83     set x
  84 } {jis0208}
  85
  86 test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} {
  87     cd [makeDirectory tmp]
  88     makeDirectory [file join tmp encoding]
  89     makeFile {} [file join tmp encoding junk.enc]
  90     makeFile {} [file join tmp encoding junk2.enc]
  91     set path [testencoding path]
  92     testencoding path {}
  93     catch {unset encodings}
  94     catch {unset x}
  95     foreach encoding [encoding names] {
  96         set encodings($encoding) 1
  97     }
  98     testencoding path [list [pwd]]
  99     foreach encoding [encoding names] {
 100         if {![info exists encodings($encoding)]} {
 101             lappend x $encoding
 102         }
 103     }
 104     testencoding path $path
 105     cd [workingDirectory]
 106     removeFile [file join tmp encoding junk2.enc]
 107     removeFile [file join tmp encoding junk.enc]
 108     removeDirectory [file join tmp encoding]
 109     removeDirectory tmp
 110     lsort $x
 111 } {junk junk2}
 112
 113 test encoding-5.1 {Tcl_SetSystemEncoding} {
 114     set old [encoding system]
 115     encoding system jis0208
 116     set x [encoding convertto \u4e4e]
 117     encoding system identity
 118     encoding system $old
 119     set x
 120 } {8C}
 121 test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} {
 122     set old [encoding system]
 123     encoding system $old
 124     string compare $old [encoding system]
 125 } {0}
 126
 127 test encoding-6.1 {Tcl_CreateEncoding: new} {testencoding} {
 128     testencoding create foo {toutf 1} {fromutf 2}
 129     set x {}
 130     encoding convertfrom foo abcd
 131     encoding convertto foo abcd
 132     testencoding delete foo
 133     set x
 134 } {{toutf 1} {fromutf 2}}
 135 test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} {
 136     testencoding create foo {toutf a} {fromutf b}
 137     set x {}
 138     encoding convertfrom foo abcd
 139     encoding convertto foo abcd
 140     testencoding delete foo
 141     set x
 142 } {{toutf a} {fromutf b}}
 143
 144 test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} {
 145     encoding convertfrom jis0208 8c8c8c8c
 146 } "\u543e\u543e\u543e\u543e"
 147 test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} {
 148     set a 8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C
 149     append a $a
 150     append a $a
 151     append a $a
 152     append a $a
 153     set x [encoding convertfrom jis0208 $a]
 154     list [string length $x] [string index $x 0]
 155 } "512 \u4e4e"
 156
 157 test encoding-8.1 {Tcl_ExternalToUtf} {
 158     set f [open [file join [temporaryDirectory] dummy] w]
 159     fconfigure $f -translation binary -encoding iso8859-1
 160     puts -nonewline $f "ab\x8c\xc1g"
 161     close $f
 162     set f [open [file join [temporaryDirectory] dummy] r]
 163     fconfigure $f -translation binary -encoding shiftjis
 164     set x [read $f]
 165     close $f
 166     file delete [file join [temporaryDirectory] dummy]
 167     set x
 168 } "ab\u4e4eg"
 169
 170 test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {
 171     encoding convertto jis0208 "\u543e\u543e\u543e\u543e"
 172 } {8c8c8c8c}
 173 test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} {
 174     set a \u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e
 175     append a $a
 176     append a $a
 177     append a $a
 178     append a $a
 179     append a $a
 180     append a $a
 181     set x [encoding convertto jis0208 $a]
 182     list [string length $x] [string range $x 0 1]
 183 } "1024 8C"
 184
 185 test encoding-10.1 {Tcl_UtfToExternal} {
 186     set f [open [file join [temporaryDirectory] dummy] w]
 187     fconfigure $f -translation binary -encoding shiftjis
 188     puts -nonewline $f "ab\u4e4eg"
 189     close $f
 190     set f [open [file join [temporaryDirectory] dummy] r]
 191     fconfigure $f -translation binary -encoding iso8859-1
 192     set x [read $f]
 193     close $f
 194     file delete [file join [temporaryDirectory] dummy]
 195     set x
 196 } "ab\x8c\xc1g"
 197
 198 proc viewable {str} {
 199     set res ""
 200     foreach c [split $str {}] {
 201         if {[string is print $c] && [string is ascii $c]} {
 202             append res $c
 203         } else {
 204             append res "\\u[format %4.4x [scan $c %c]]"
 205         }
 206     }
 207     return "$str ($res)"
 208 }
 209
 210 test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} {
 211     set system [encoding system]
 212     set path [testencoding path]
 213     encoding system iso8859-1
 214     testencoding path {}
 215     set x [list [catch {encoding convertto jis0208 \u4e4e} msg] $msg]
 216     testencoding path $path
 217     encoding system $system
 218     lappend x [encoding convertto jis0208 \u4e4e]
 219 } {1 {unknown encoding "jis0208"} 8C}
 220 test encoding-11.2 {LoadEncodingFile: single-byte} {
 221     encoding convertfrom jis0201 \xa1
 222 } "\uff61"
 223 test encoding-11.3 {LoadEncodingFile: double-byte} {
 224     encoding convertfrom jis0208 8C
 225 } "\u4e4e"
 226 test encoding-11.4 {LoadEncodingFile: multi-byte} {
 227     encoding convertfrom shiftjis \x8c\xc1
 228 } "\u4e4e"
 229 test encoding-11.5 {LoadEncodingFile: escape file} {
 230     viewable [encoding convertto iso2022 \u4e4e]
 231 } [viewable "\x1b\$B8C\x1b(B"]
 232 test encoding-11.5.1 {LoadEncodingFile: escape file} {
 233     viewable [encoding convertto iso2022-jp \u4e4e]
 234 } [viewable "\x1b\$B8C\x1b(B"]
 235 test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} {
 236     set system [encoding system]
 237     set path [testencoding path]
 238     encoding system identity
 239     cd [temporaryDirectory]
 240     testencoding path tmp
 241     makeDirectory tmp
 242     makeDirectory [file join tmp encoding]
 243     set f [open [file join tmp encoding splat.enc] w]
 244     fconfigure $f -translation binary
 245     puts $f "abcdefghijklmnop"
 246     close $f
 247     set x [list [catch {encoding convertto splat \u4e4e} msg] $msg]
 248     file delete [file join [temporaryDirectory] tmp encoding splat.enc]
 249     removeDirectory [file join tmp encoding]
 250     removeDirectory tmp
 251     cd [workingDirectory]
 252     testencoding path $path
 253     encoding system $system
 254     set x
 255 } {1 {invalid encoding file "splat"}}
 256
 257 # OpenEncodingFile is fully tested by the rest of the tests in this file.
 258
 259 test encoding-12.1 {LoadTableEncoding: normal encoding} {
 260     set x [encoding convertto iso8859-3 \u120]
 261     append x [encoding convertto iso8859-3 \ud5]
 262     append x [encoding convertfrom iso8859-3 \xd5]
 263 } "\xd5?\u120"
 264 test encoding-12.2 {LoadTableEncoding: single-byte encoding} {
 265     set x [encoding convertto iso8859-3 ab\u0120g]
 266     append x [encoding convertfrom iso8859-3 ab\xd5g]
 267 } "ab\xd5gab\u120g"
 268 test encoding-12.3 {LoadTableEncoding: multi-byte encoding} {
 269     set x [encoding convertto shiftjis ab\u4e4eg]
 270     append x [encoding convertfrom shiftjis ab\x8c\xc1g]
 271 } "ab\x8c\xc1gab\u4e4eg"
 272 test encoding-12.4 {LoadTableEncoding: double-byte encoding} {
 273     set x [encoding convertto jis0208 \u4e4e\u3b1]
 274     append x [encoding convertfrom jis0208 8C&A]
 275 } "8C&A\u4e4e\u3b1"
 276 test encoding-12.5 {LoadTableEncoding: symbol encoding} {
 277     set x [encoding convertto symbol \u3b3]
 278     append x [encoding convertto symbol \u67]
 279     append x [encoding convertfrom symbol \x67]
 280 } "\x67\x67\u3b3"
 281
 282 test encoding-13.1 {LoadEscapeTable} {
 283     viewable [set x [encoding convertto iso2022 ab\u4e4e\u68d9g]]
 284 } [viewable "ab\x1b\$B8C\x1b\$\(DD%\x1b(Bg"]
 285
 286 test encoding-14.1 {BinaryProc} {
 287     encoding convertto identity \x12\x34\x56\xff\x69
 288 } "\x12\x34\x56\xc3\xbf\x69"
 289
 290 test encoding-15.1 {UtfToUtfProc} {
 291     encoding convertto utf-8 \xa3
 292 } "\xc2\xa3"
 293
 294 test encoding-16.1 {UnicodeToUtfProc} {
 295     encoding convertfrom unicode NN
 296 } "\u4e4e"
 297
 298 test encoding-17.1 {UtfToUnicodeProc} {
 299 } {}
 300
 301 test encoding-18.1 {TableToUtfProc} {
 302 } {}
 303
 304 test encoding-19.1 {TableFromUtfProc} {
 305 } {}
 306
 307 test encoding-20.1 {TableFreefProc} {
 308 } {}
 309
 310 test encoding-21.1 {EscapeToUtfProc} {
 311 } {}
 312
 313 test encoding-22.1 {EscapeFromUtfProc} {
 314 } {}
 315
 316 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
 317 \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
 318 \u001b\$B\$*4j\$\$\$\$\$?\$7\$^\$9!#\$^\$?!\"BgJQ62=L\$G\$9\$,!\"=;=jJQ99\$N\$\"\$H!\"F|K\\8l%5!<%S%9It!J\u001b(B
 319 casino_japanese@___.com \u001b\$B!K\$^\$G\$4=;=jJQ99:Q\$NO\"Mm\$r\$\$\$?\$@\$1\$J\$\$\$G\u001b(B
 320 \u001b\$B\$7\$g\$&\$+!)\u001b(B"
 321
 322 set ::iso2022uniData [encoding convertfrom iso2022-jp $::iso2022encData]
 323 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
 324 \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
 325 \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
 326 \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
 327 \u3057\u3087\u3046\u304b\uff1f"
 328
 329 cd [temporaryDirectory]
 330 set fid [open iso2022.txt w]
 331 fconfigure $fid -encoding binary
 332 puts -nonewline $fid $::iso2022encData
 333 close $fid
 334
 335 test encoding-23.2 {iso2022-jp escape encoding test} {
 336     string equal $::iso2022uniData $::iso2022uniData2
 337 } 1
 338 test encoding-23.2 {iso2022-jp escape encoding test} {
 339     # This checks that 'gets' isn't resetting the encoding inappropriately.
 340     # [Bug #523988]
 341     set fid [open iso2022.txt r]
 342     fconfigure $fid -encoding iso2022-jp
 343     set out ""
 344     set count 0
 345     while {[set num [gets $fid line]] >= 0} {
 346         if {$count} {
 347             incr count 1 ; # account for newline
 348             append out \n
 349         }
 350         append out $line
 351         incr count $num
 352     }
 353     close $fid
 354     if {[string compare $::iso2022uniData $out]} {
 355         return -code error "iso2022-jp read in doesn't match original"
 356     }
 357     list $count $out
 358 } [list [string length $::iso2022uniData] $::iso2022uniData]
 359 test encoding-23.3 {iso2022-jp escape encoding test} {
 360     # read $fis <size> reads size in chars, not raw bytes.
 361     set fid [open iso2022.txt r]
 362     fconfigure $fid -encoding iso2022-jp
 363     set data [read $fid 50]
 364     close $fid
 365     set data
 366 } [string range $::iso2022uniData 0 49] ; # 0 .. 49 inclusive == 50
 367 cd [workingDirectory]
 368
 369 test encoding-24.1 {EscapeFreeProc on open channels} -constraints {
 370         exec
 371 } -setup {
 372     # Bug #524674 input
 373     set file [makeFile {
 374         set f [open [file join [file dirname [info script]] iso2022.txt]]
 375         fconfigure $f -encoding iso2022-jp
 376         gets $f
 377     } iso2022.tcl]
 378 } -body {
 379     exec [interpreter] $file
 380 } -cleanup {
 381     removeFile iso2022.tcl
 382 } -result {}
 383
 384 test encoding-24.2 {EscapeFreeProc on open channels} -constraints {
 385         exec
 386 } -setup {
 387     # Bug #524674 output
 388     set file [makeFile {
 389         fconfigure stdout -encoding iso2022-jp
 390         puts ab\u4e4e\u68d9g
 391         exit
 392     } iso2022.tcl]
 393 } -body {
 394     viewable [exec [interpreter] $file]
 395 } -cleanup {
 396     removeFile iso2022.tcl
 397 } -result "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"
 398
 399 test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
 400     # Bug #219314 - if we don't free escape encodings correctly on
 401     # channel closure, we go boom
 402     set file [makeFile {
 403         encoding system iso2022-jp
 404         set a "\u4e4e\u4e5e\u4e5f"; # 3 Japanese Kanji letters
 405         puts $a
 406     } iso2022.tcl]
 407     set f [open "|[list [interpreter] $file]"]
 408     fconfigure $f -encoding iso2022-jp
 409     set count [gets $f line]
 410     close $f
 411     removeFile iso2022.tcl
 412     list $count [viewable $line]
 413 } [list 3 "\u4e4e\u4e5e\u4e5f (\\u4e4e\\u4e5e\\u4e5f)"]
 414
 415 file delete [file join [temporaryDirectory] iso2022.txt]
 416
 417 # EscapeFreeProc, GetTableEncoding, unilen
 418 # are fully tested by the rest of this file
 419
 420 # cleanup
 421 ::tcltest::cleanupTests
 422 return