diff options
Diffstat (limited to 'tests/encoding.test')
| -rw-r--r-- | tests/encoding.test | 244 |
1 files changed, 104 insertions, 140 deletions
diff --git a/tests/encoding.test b/tests/encoding.test index be1f4d5..aa50360 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -1,12 +1,12 @@ # 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. +# 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. +# 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 @@ -15,11 +15,6 @@ namespace eval ::tcl::test::encoding { namespace import -force ::tcltest::* -catch { - ::tcltest::loadTestedCommands - package require -exact Tcltest [info patchlevel] -} - proc toutf {args} { variable x lappend x "toutf $args" @@ -30,35 +25,32 @@ proc fromutf {args} { } proc runtests {} { + variable x # Some tests require the testencoding command testConstraint testencoding [llength [info commands testencoding]] -testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}] testConstraint exec [llength [info commands exec]] -testConstraint testgetencpath [llength [info commands testgetencpath]] - + # 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 { +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 - return $x -} -cleanup { encoding system $old testencoding delete foo -} -result {{fromutf }} + 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 - return $x + set x } {{fromutf }} test encoding-1.3 {Tcl_GetEncoding: load encoding} { list [encoding convertto jis0208 \u4e4e] \ @@ -68,77 +60,71 @@ test encoding-1.3 {Tcl_GetEncoding: load encoding} { test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} { encoding convertto jis0208 \u4e4e } {8C} -test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} -setup { +test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} {testencoding} { 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 + set x [encoding convertto shiftjis \u4e4e] ;# old one found encoding system identity - llength shiftjis ;# Shimmer away any cache of Tcl_Encoding + llength shiftjis 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\"}" + set x +} "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}" -test encoding-3.1 {Tcl_GetEncodingName, NULL} -setup { +test encoding-3.1 {Tcl_GetEncodingName, NULL} { set old [encoding system] -} -body { encoding system shiftjis - encoding system -} -cleanup { + set x [encoding system] encoding system $old -} -result {shiftjis} -test encoding-3.2 {Tcl_GetEncodingName, non-null} -setup { + set x +} {shiftjis} +test encoding-3.2 {Tcl_GetEncodingName, non-null} { set old [fconfigure stdout -encoding] -} -body { fconfigure stdout -encoding jis0208 - fconfigure stdout -encoding -} -cleanup { + set x [fconfigure stdout -encoding] fconfigure stdout -encoding $old -} -result {jis0208} + set x +} {jis0208} -test encoding-4.1 {Tcl_GetEncodingNames} -constraints {testencoding} -setup { +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} -} -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} + lsort $x +} {junk junk2} -test encoding-5.1 {Tcl_SetSystemEncoding} -setup { +test encoding-5.1 {Tcl_SetSystemEncoding} { set old [encoding system] -} -body { encoding system jis0208 - encoding convertto \u4e4e -} -cleanup { + set x [encoding convertto \u4e4e] encoding system identity encoding system $old -} -result {8C} + set x +} {8C} test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} { set old [encoding system] encoding system $old @@ -152,7 +138,7 @@ test encoding-6.1 {Tcl_CreateEncoding: new} {testencoding} { encoding convertfrom foo abcd encoding convertto foo abcd testencoding delete foo - return $x + set x } {{toutf 1} {fromutf 2}} test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} { testencoding create foo [namespace code {toutf a}] \ @@ -161,7 +147,7 @@ test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} { encoding convertfrom foo abcd encoding convertto foo abcd testencoding delete foo - return $x + set x } {{toutf a} {fromutf b}} test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} { @@ -183,11 +169,11 @@ test encoding-8.1 {Tcl_ExternalToUtf} { puts -nonewline $f "ab\x8c\xc1g" close $f set f [open [file join [temporaryDirectory] dummy] r] - fconfigure $f -translation binary -encoding shiftjis + fconfigure $f -translation binary -encoding shiftjis set x [read $f] close $f file delete [file join [temporaryDirectory] dummy] - return $x + set x } "ab\u4e4eg" test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} { @@ -215,7 +201,7 @@ test encoding-10.1 {Tcl_UtfToExternal} { set x [read $f] close $f file delete [file join [temporaryDirectory] dummy] - return $x + set x } "ab\x8c\xc1g" proc viewable {str} { @@ -235,7 +221,7 @@ test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} { set path [encoding dirs] encoding system iso8859-1 encoding dirs {} - llength jis0208 ;# Shimmer any cached Tcl_Encoding in shared literal + llength jis0208 set x [list [catch {encoding convertto jis0208 \u4e4e} msg] $msg] encoding dirs $path encoding system $system @@ -256,28 +242,27 @@ test encoding-11.5 {LoadEncodingFile: escape file} { 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 { +test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} { 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 + fconfigure $f -translation binary puts $f "abcdefghijklmnop" close $f - encoding convertto splat \u4e4e -} -returnCodes error -cleanup { + 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 -} -result {invalid encoding file "splat"} + set x +} {1 {invalid encoding file "splat"}} # OpenEncodingFile is fully tested by the rest of the tests in this file. @@ -287,11 +272,11 @@ test encoding-12.1 {LoadTableEncoding: normal encoding} { append x [encoding convertfrom iso8859-3 \xd5] } "\xd5?\u120" test encoding-12.2 {LoadTableEncoding: single-byte encoding} { - set x [encoding convertto iso8859-3 ab\u0120g] + set x [encoding convertto iso8859-3 ab\u0120g] append x [encoding convertfrom iso8859-3 ab\xd5g] } "ab\xd5gab\u120g" test encoding-12.3 {LoadTableEncoding: multi-byte encoding} { - set x [encoding convertto shiftjis ab\u4e4eg] + set x [encoding convertto shiftjis ab\u4e4eg] append x [encoding convertfrom shiftjis ab\x8c\xc1g] } "ab\x8c\xc1gab\u4e4eg" test encoding-12.4 {LoadTableEncoding: double-byte encoding} { @@ -315,6 +300,7 @@ test encoding-14.1 {BinaryProc} { 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] @@ -322,6 +308,7 @@ test encoding-15.2 {UtfToUtfProc null character output} { 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] @@ -333,14 +320,9 @@ test encoding-16.1 {UnicodeToUtfProc} { set val [encoding convertfrom unicode NN] list $val [format %x [scan $val %c]] } "\u4e4e 4e4e" -test encoding-16.2 {UnicodeToUtfProc} -constraints fullutf -body { - set val [encoding convertfrom unicode "\xd8\xd8\xdc\xdc"] - list $val [format %x [scan $val %c]] -} -result "\U460dc 460dc" -test encoding-17.1 {UtfToUnicodeProc} -constraints fullutf -body { - encoding convertto unicode "\U460dc" -} -result "\xd8\xd8\xdc\xdc" +test encoding-17.1 {UtfToUnicodeProc} { +} {} test encoding-18.1 {TableToUtfProc} { } {} @@ -406,41 +388,44 @@ test encoding-23.3 {iso2022-jp escape encoding test} { fconfigure $fid -encoding iso2022-jp set data [read $fid 50] close $fid - return $data + set 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 { +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 - } -} {} -test encoding-24.2 {EscapeFreeProc on open channels} {exec} { + } 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 - viewable [runInSubprocess { + set file [makeFile { encoding system cp1252; # Bug #2891556 crash revelator fconfigure stdout -encoding iso2022-jp puts ab\u4e4e\u68d9g - set env(TCL_FINALIZE_ON_EXIT) 1 exit - }] -} "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)" + } 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 + # 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 @@ -454,31 +439,6 @@ test encoding-24.3 {EscapeFreeProc on open channels} {stdio} { list $count [viewable $line] } [list 3 "\u4e4e\u4e5e\u4e5f (\\u4e4e\\u4e5e\\u4e5f)"] -test encoding-24.4 {Parse valid or invalid utf-8} { - string length [encoding convertfrom utf-8 "\xc0\x80"] -} 1 -test encoding-24.5 {Parse valid or invalid utf-8} { - string length [encoding convertfrom utf-8 "\xc0\x81"] -} 2 -test encoding-24.6 {Parse valid or invalid utf-8} { - string length [encoding convertfrom utf-8 "\xc1\xbf"] -} 2 -test encoding-24.7 {Parse valid or invalid utf-8} { - string length [encoding convertfrom utf-8 "\xc2\x80"] -} 1 -test encoding-24.8 {Parse valid or invalid utf-8} { - string length [encoding convertfrom utf-8 "\xe0\x80\x80"] -} 3 -test encoding-24.9 {Parse valid or invalid utf-8} { - string length [encoding convertfrom utf-8 "\xe0\x9f\xbf"] -} 3 -test encoding-24.10 {Parse valid or invalid utf-8} { - string length [encoding convertfrom utf-8 "\xe0\xa0\x80"] -} 1 -test encoding-24.11 {Parse valid or invalid utf-8} { - string length [encoding convertfrom utf-8 "\xef\xbf\xbf"] -} 1 - file delete [file join [temporaryDirectory] iso2022.txt] # @@ -509,14 +469,18 @@ proc foreach-jisx0208 {varName command} { } { if {[llength $range] == 2} { # for adhoc range. simple {first last}. inclusive. - scan $range %x%x first last + 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. - scan $range %x%x%x%x h0 l0 hend lend + 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)}] @@ -560,7 +524,7 @@ proc channel-diff {fa fb} { binary scan [lindex $lb 1] H* got lappend diff [list $code $expected $got] } - return $diff + set diff } # Create char tables. @@ -579,9 +543,8 @@ 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 { + test encoding-25.[incr NUM] "jisx0208 $from => $to" { cd [temporaryDirectory] - } -body { set f [open $from.chars] fconfigure $f -encoding $from set out [open $from.$to.tcltestout w] @@ -589,35 +552,40 @@ foreach from {cp932 shiftjis euc-jp iso2022-jp} { 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 { + 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 - } -result {} + + # Difference should be empty. + set diff + } {} } } -test encoding-26.0 {Tcl_GetEncodingSearchPath} -constraints { - testgetencpath +testConstraint testgetdefenc [llength [info commands testgetdefenc]] + +test encoding-26.0 {Tcl_GetDefaultEncodingDir} -constraints { + testgetdefenc } -setup { - set origPath [testgetencpath] - testsetencpath slappy + set origDir [testgetdefenc] + testsetdefenc slappy } -body { - testgetencpath + testgetdefenc } -cleanup { - testsetencpath $origPath + 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. - +# EscapeFreeProc, GetTableEncoding, unilen +# are fully tested by the rest of this file test encoding-27.1 {encoding dirs basic behavior} -returnCodes error -body { encoding dirs ? ? @@ -635,7 +603,3 @@ runtests namespace delete ::tcl::test::encoding ::tcltest::cleanupTests return - -# Local Variables: -# mode: tcl -# End: |