summaryrefslogtreecommitdiffstats
path: root/tests/encoding.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/encoding.test')
-rw-r--r--tests/encoding.test197
1 files changed, 101 insertions, 96 deletions
diff --git a/tests/encoding.test b/tests/encoding.test
index aa50360..0374e2d 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,6 +15,11 @@ 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"
@@ -25,32 +30,34 @@ proc 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} {testencoding} {
- testencoding create foo [namespace origin toutf] [namespace origin fromutf]
+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
- set x
-} {{fromutf }}
+} -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
- set x
+ return $x
} {{fromutf }}
test encoding-1.3 {Tcl_GetEncoding: load encoding} {
list [encoding convertto jis0208 \u4e4e] \
@@ -60,71 +67,77 @@ 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} {testencoding} {
+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
+ 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
- set x
-} "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"
+} -result "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"
-test encoding-3.1 {Tcl_GetEncodingName, NULL} {
+test encoding-3.1 {Tcl_GetEncodingName, NULL} -setup {
set old [encoding system]
+} -body {
encoding system shiftjis
- set x [encoding system]
+ encoding system
+} -cleanup {
encoding system $old
- set x
-} {shiftjis}
-test encoding-3.2 {Tcl_GetEncodingName, non-null} {
+} -result {shiftjis}
+test encoding-3.2 {Tcl_GetEncodingName, non-null} -setup {
set old [fconfigure stdout -encoding]
+} -body {
fconfigure stdout -encoding jis0208
- set x [fconfigure stdout -encoding]
+ fconfigure stdout -encoding
+} -cleanup {
fconfigure stdout -encoding $old
- set x
-} {jis0208}
+} -result {jis0208}
-test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} {
+test encoding-4.1 {Tcl_GetEncodingNames} -constraints {testencoding} -setup {
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
- lsort $x
-} {junk junk2}
+} -result {junk junk2}
-test encoding-5.1 {Tcl_SetSystemEncoding} {
+test encoding-5.1 {Tcl_SetSystemEncoding} -setup {
set old [encoding system]
+} -body {
encoding system jis0208
- set x [encoding convertto \u4e4e]
+ encoding convertto \u4e4e
+} -cleanup {
encoding system identity
encoding system $old
- set x
-} {8C}
+} -result {8C}
test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} {
set old [encoding system]
encoding system $old
@@ -138,7 +151,7 @@ test encoding-6.1 {Tcl_CreateEncoding: new} {testencoding} {
encoding convertfrom foo abcd
encoding convertto foo abcd
testencoding delete foo
- set x
+ return $x
} {{toutf 1} {fromutf 2}}
test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} {
testencoding create foo [namespace code {toutf a}] \
@@ -147,7 +160,7 @@ test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} {
encoding convertfrom foo abcd
encoding convertto foo abcd
testencoding delete foo
- set x
+ return $x
} {{toutf a} {fromutf b}}
test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} {
@@ -173,7 +186,7 @@ test encoding-8.1 {Tcl_ExternalToUtf} {
set x [read $f]
close $f
file delete [file join [temporaryDirectory] dummy]
- set x
+ return $x
} "ab\u4e4eg"
test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {
@@ -201,7 +214,7 @@ test encoding-10.1 {Tcl_UtfToExternal} {
set x [read $f]
close $f
file delete [file join [temporaryDirectory] dummy]
- set x
+ return $x
} "ab\x8c\xc1g"
proc viewable {str} {
@@ -221,7 +234,7 @@ test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} {
set path [encoding dirs]
encoding system iso8859-1
encoding dirs {}
- llength jis0208
+ llength jis0208 ;# Shimmer any cached Tcl_Encoding in shared literal
set x [list [catch {encoding convertto jis0208 \u4e4e} msg] $msg]
encoding dirs $path
encoding system $system
@@ -242,10 +255,11 @@ 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} {testencoding} {
+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
@@ -254,15 +268,15 @@ test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} {
fconfigure $f -translation binary
puts $f "abcdefghijklmnop"
close $f
- set x [list [catch {encoding convertto splat \u4e4e} msg] $msg]
+ 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
- set x
-} {1 {invalid encoding file "splat"}}
+} -result {invalid encoding file "splat"}
# OpenEncodingFile is fully tested by the rest of the tests in this file.
@@ -300,7 +314,6 @@ 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]
@@ -308,7 +321,6 @@ 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]
@@ -388,44 +400,41 @@ test encoding-23.3 {iso2022-jp escape encoding test} {
fconfigure $fid -encoding iso2022-jp
set data [read $fid 50]
close $fid
- set data
+ return $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 {
+# 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
- } iso2022.tcl]
-} -body {
- exec [interpreter] $file
-} -cleanup {
- removeFile iso2022.tcl
-} -result {}
-
-test encoding-24.2 {EscapeFreeProc on open channels} -constraints {
- exec
-} -setup {
+ }
+} {}
+test encoding-24.2 {EscapeFreeProc on open channels} {exec} {
# Bug #524674 output
- set file [makeFile {
+ viewable [runInSubprocess {
encoding system cp1252; # Bug #2891556 crash revelator
fconfigure stdout -encoding iso2022-jp
puts ab\u4e4e\u68d9g
+ set env(TCL_FINALIZE_ON_EXIT) 1
exit
- } 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)"
-
+ }]
+} "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
@@ -469,18 +478,14 @@ proc foreach-jisx0208 {varName command} {
} {
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]
+ 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.
- 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]
+ 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)}]
@@ -524,7 +529,7 @@ proc channel-diff {fa fb} {
binary scan [lindex $lb 1] H* got
lappend diff [list $code $expected $got]
}
- set diff
+ return $diff
}
# Create char tables.
@@ -543,8 +548,9 @@ 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" {
+ 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]
@@ -552,40 +558,35 @@ 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]
- fconfigure $fa -encoding binary
- set fb [open $from.$to.tcltestout]
- fconfigure $fb -encoding binary
- set diff [channel-diff $fa $fb]
+ 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
-
- # Difference should be empty.
- set diff
- } {}
+ } -result {}
}
}
-testConstraint testgetdefenc [llength [info commands testgetdefenc]]
-
test encoding-26.0 {Tcl_GetDefaultEncodingDir} -constraints {
- testgetdefenc
+ testgetdefenc
} -setup {
- set origDir [testgetdefenc]
- testsetdefenc slappy
+ set origDir [testgetdefenc]
+ testsetdefenc slappy
} -body {
- testgetdefenc
+ testgetdefenc
} -cleanup {
- testsetdefenc $origDir
+ 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 ? ?
@@ -603,3 +604,7 @@ runtests
namespace delete ::tcl::test::encoding
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End: